5 use base qw( FS::cust_main::Billing FS::cust_main::Billing_Realtime
6 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
9 use vars qw( @EXPORT_OK $DEBUG $me $conf
11 $import $ignore_expired_card
12 $skip_fuzzyfiles @fuzzyfields
15 use vars qw( $realtime_bop_decline_quiet ); #ugh
18 use Scalar::Util qw( blessed );
19 use List::Util qw( min );
20 use Time::Local qw(timelocal);
21 use Storable qw(thaw);
25 use Digest::MD5 qw(md5_base64);
28 use File::Temp qw( tempfile );
29 use String::Approx qw(amatch);
30 use Business::CreditCard 0.28;
32 use FS::UID qw( getotaker dbh driver_name );
33 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
34 use FS::Misc qw( generate_email send_email generate_ps do_print );
35 use FS::Msgcat qw(gettext);
42 use FS::cust_pay_pending;
43 use FS::cust_pay_void;
44 use FS::cust_pay_batch;
47 use FS::part_referral;
48 use FS::cust_main_county;
49 use FS::cust_location;
51 use FS::cust_main_exemption;
52 use FS::cust_tax_adjustment;
53 use FS::cust_tax_location;
55 use FS::cust_main_invoice;
57 use FS::prepay_credit;
61 use FS::part_event_condition;
65 use FS::payment_gateway;
66 use FS::agent_payment_gateway;
70 @EXPORT_OK = qw( smart_search );
72 $realtime_bop_decline_quiet = 0; #move to Billing_Realtime
74 # 1 is mostly method/subroutine entry and options
75 # 2 traces progress of some operations
76 # 3 is even more information including possibly sensitive data
78 $me = '[FS::cust_main]';
81 $ignore_expired_card = 0;
84 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
86 @encrypted_fields = ('payinfo', 'paycvv');
87 sub nohistory_fields { ('payinfo', 'paycvv'); }
89 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
91 #ask FS::UID to run this stuff for us later
92 #$FS::UID::callback{'FS::cust_main'} = sub {
93 install_callback FS::UID sub {
95 #yes, need it for stuff below (prolly should be cached)
100 my ( $hashref, $cache ) = @_;
101 if ( exists $hashref->{'pkgnum'} ) {
102 #@{ $self->{'_pkgnum'} } = ();
103 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
104 $self->{'_pkgnum'} = $subcache;
105 #push @{ $self->{'_pkgnum'} },
106 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
112 FS::cust_main - Object methods for cust_main records
118 $record = new FS::cust_main \%hash;
119 $record = new FS::cust_main { 'column' => 'value' };
121 $error = $record->insert;
123 $error = $new_record->replace($old_record);
125 $error = $record->delete;
127 $error = $record->check;
129 @cust_pkg = $record->all_pkgs;
131 @cust_pkg = $record->ncancelled_pkgs;
133 @cust_pkg = $record->suspended_pkgs;
135 $error = $record->bill;
136 $error = $record->bill %options;
137 $error = $record->bill 'time' => $time;
139 $error = $record->collect;
140 $error = $record->collect %options;
141 $error = $record->collect 'invoice_time' => $time,
146 An FS::cust_main object represents a customer. FS::cust_main inherits from
147 FS::Record. The following fields are currently supported:
153 Primary key (assigned automatically for new customers)
157 Agent (see L<FS::agent>)
161 Advertising source (see L<FS::part_referral>)
173 Cocial security number (optional)
189 (optional, see L<FS::cust_main_county>)
193 (see L<FS::cust_main_county>)
199 (see L<FS::cust_main_county>)
235 (optional, see L<FS::cust_main_county>)
239 (see L<FS::cust_main_county>)
245 (see L<FS::cust_main_county>)
261 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
265 Payment Information (See L<FS::payinfo_Mixin> for data format)
269 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
273 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
277 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
281 Start date month (maestro/solo cards only)
285 Start date year (maestro/solo cards only)
289 Issue number (maestro/solo cards only)
293 Name on card or billing name
297 IP address from which payment information was received
301 Tax exempt, empty or `Y'
305 Order taker (see L<FS::access_user>)
311 =item referral_custnum
313 Referring customer number
317 Enable individual CDR spooling, empty or `Y'
321 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
325 Discourage individual CDR printing, empty or `Y'
335 Creates a new customer. To add the customer to the database, see L<"insert">.
337 Note that this stores the hash reference, not a distinct copy of the hash it
338 points to. You can ask the object for a copy with the I<hash> method.
342 sub table { 'cust_main'; }
344 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
346 Adds this customer to the database. If there is an error, returns the error,
347 otherwise returns false.
349 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
350 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
351 are inserted atomicly, or the transaction is rolled back. Passing an empty
352 hash reference is equivalent to not supplying this parameter. There should be
353 a better explanation of this, but until then, here's an example:
356 tie %hash, 'Tie::RefHash'; #this part is important
358 $cust_pkg => [ $svc_acct ],
361 $cust_main->insert( \%hash );
363 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
364 be set as the invoicing list (see L<"invoicing_list">). Errors return as
365 expected and rollback the entire transaction; it is not necessary to call
366 check_invoicing_list first. The invoicing_list is set after the records in the
367 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
368 invoicing_list destination to the newly-created svc_acct. Here's an example:
370 $cust_main->insert( {}, [ $email, 'POST' ] );
372 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
374 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
375 on the supplied jobnum (they will not run until the specific job completes).
376 This can be used to defer provisioning until some action completes (such
377 as running the customer's credit card successfully).
379 The I<noexport> option is deprecated. If I<noexport> is set true, no
380 provisioning jobs (exports) are scheduled. (You can schedule them later with
381 the B<reexport> method.)
383 The I<tax_exemption> option can be set to an arrayref of tax names.
384 FS::cust_main_exemption records will be created and inserted.
390 my $cust_pkgs = @_ ? shift : {};
391 my $invoicing_list = @_ ? shift : '';
393 warn "$me insert called with options ".
394 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
397 local $SIG{HUP} = 'IGNORE';
398 local $SIG{INT} = 'IGNORE';
399 local $SIG{QUIT} = 'IGNORE';
400 local $SIG{TERM} = 'IGNORE';
401 local $SIG{TSTP} = 'IGNORE';
402 local $SIG{PIPE} = 'IGNORE';
404 my $oldAutoCommit = $FS::UID::AutoCommit;
405 local $FS::UID::AutoCommit = 0;
408 my $prepay_identifier = '';
409 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
411 if ( $self->payby eq 'PREPAY' ) {
413 $self->payby('BILL');
414 $prepay_identifier = $self->payinfo;
417 warn " looking up prepaid card $prepay_identifier\n"
420 my $error = $self->get_prepay( $prepay_identifier,
421 'amount_ref' => \$amount,
422 'seconds_ref' => \$seconds,
423 'upbytes_ref' => \$upbytes,
424 'downbytes_ref' => \$downbytes,
425 'totalbytes_ref' => \$totalbytes,
428 $dbh->rollback if $oldAutoCommit;
429 #return "error applying prepaid card (transaction rolled back): $error";
433 $payby = 'PREP' if $amount;
435 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
438 $self->payby('BILL');
439 $amount = $self->paid;
443 warn " inserting $self\n"
446 $self->signupdate(time) unless $self->signupdate;
448 $self->auto_agent_custid()
449 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
451 my $error = $self->SUPER::insert;
453 $dbh->rollback if $oldAutoCommit;
454 #return "inserting cust_main record (transaction rolled back): $error";
458 warn " setting invoicing list\n"
461 if ( $invoicing_list ) {
462 $error = $self->check_invoicing_list( $invoicing_list );
464 $dbh->rollback if $oldAutoCommit;
465 #return "checking invoicing_list (transaction rolled back): $error";
468 $self->invoicing_list( $invoicing_list );
471 warn " setting customer tags\n"
474 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
475 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
476 'custnum' => $self->custnum };
477 my $error = $cust_tag->insert;
479 $dbh->rollback if $oldAutoCommit;
484 if ( $invoicing_list ) {
485 $error = $self->check_invoicing_list( $invoicing_list );
487 $dbh->rollback if $oldAutoCommit;
488 #return "checking invoicing_list (transaction rolled back): $error";
491 $self->invoicing_list( $invoicing_list );
495 warn " setting cust_main_exemption\n"
498 my $tax_exemption = delete $options{'tax_exemption'};
499 if ( $tax_exemption ) {
500 foreach my $taxname ( @$tax_exemption ) {
501 my $cust_main_exemption = new FS::cust_main_exemption {
502 'custnum' => $self->custnum,
503 'taxname' => $taxname,
505 my $error = $cust_main_exemption->insert;
507 $dbh->rollback if $oldAutoCommit;
508 return "inserting cust_main_exemption (transaction rolled back): $error";
513 if ( $conf->config('cust_main-skeleton_tables')
514 && $conf->config('cust_main-skeleton_custnum') ) {
516 warn " inserting skeleton records\n"
519 my $error = $self->start_copy_skel;
521 $dbh->rollback if $oldAutoCommit;
527 warn " ordering packages\n"
530 $error = $self->order_pkgs( $cust_pkgs,
532 'seconds_ref' => \$seconds,
533 'upbytes_ref' => \$upbytes,
534 'downbytes_ref' => \$downbytes,
535 'totalbytes_ref' => \$totalbytes,
538 $dbh->rollback if $oldAutoCommit;
543 $dbh->rollback if $oldAutoCommit;
544 return "No svc_acct record to apply pre-paid time";
546 if ( $upbytes || $downbytes || $totalbytes ) {
547 $dbh->rollback if $oldAutoCommit;
548 return "No svc_acct record to apply pre-paid data";
552 warn " inserting initial $payby payment of $amount\n"
554 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
556 $dbh->rollback if $oldAutoCommit;
557 return "inserting payment (transaction rolled back): $error";
561 unless ( $import || $skip_fuzzyfiles ) {
562 warn " queueing fuzzyfiles update\n"
564 $error = $self->queue_fuzzyfiles_update;
566 $dbh->rollback if $oldAutoCommit;
567 return "updating fuzzy search cache: $error";
572 warn " exporting\n" if $DEBUG > 1;
574 my $export_args = $options{'export_args'} || [];
577 map qsearch( 'part_export', {exportnum=>$_} ),
578 $conf->config('cust_main-exports'); #, $agentnum
580 foreach my $part_export ( @part_export ) {
581 my $error = $part_export->export_insert($self, @$export_args);
583 $dbh->rollback if $oldAutoCommit;
584 return "exporting to ". $part_export->exporttype.
585 " (transaction rolled back): $error";
589 #foreach my $depend_jobnum ( @$depend_jobnums ) {
590 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
592 # foreach my $jobnum ( @jobnums ) {
593 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
594 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
596 # my $error = $queue->depend_insert($depend_jobnum);
598 # $dbh->rollback if $oldAutoCommit;
599 # return "error queuing job dependancy: $error";
606 #if ( exists $options{'jobnums'} ) {
607 # push @{ $options{'jobnums'} }, @jobnums;
610 warn " insert complete; committing transaction\n"
613 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
618 use File::CounterFile;
619 sub auto_agent_custid {
622 my $format = $conf->config('cust_main-auto_agent_custid');
624 if ( $format eq '1YMMXXXXXXXX' ) {
626 my $counter = new File::CounterFile 'cust_main.agent_custid';
629 my $ym = 100000000000 + time2str('%y%m00000000', time);
630 if ( $ym > $counter->value ) {
631 $counter->{'value'} = $agent_custid = $ym;
632 $counter->{'updated'} = 1;
634 $agent_custid = $counter->inc;
640 die "Unknown cust_main-auto_agent_custid format: $format";
643 $self->agent_custid($agent_custid);
647 sub start_copy_skel {
650 #'mg_user_preference' => {},
651 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
652 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
653 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
654 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
655 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
658 _copy_skel( 'cust_main', #tablename
659 $conf->config('cust_main-skeleton_custnum'), #sourceid
660 $self->custnum, #destid
661 @tables, #child tables
665 #recursive subroutine, not a method
667 my( $table, $sourceid, $destid, %child_tables ) = @_;
670 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
671 ( $table, $primary_key ) = ( $1, $2 );
673 my $dbdef_table = dbdef->table($table);
674 $primary_key = $dbdef_table->primary_key
675 or return "$table has no primary key".
676 " (or do you need to run dbdef-create?)";
679 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
680 join (', ', keys %child_tables). "\n"
683 foreach my $child_table_def ( keys %child_tables ) {
687 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
688 ( $child_table, $child_pkey ) = ( $1, $2 );
690 $child_table = $child_table_def;
692 $child_pkey = dbdef->table($child_table)->primary_key;
693 # or return "$table has no primary key".
694 # " (or do you need to run dbdef-create?)\n";
698 if ( keys %{ $child_tables{$child_table_def} } ) {
700 return "$child_table has no primary key".
701 " (run dbdef-create or try specifying it?)\n"
704 #false laziness w/Record::insert and only works on Pg
705 #refactor the proper last-inserted-id stuff out of Record::insert if this
706 # ever gets use for anything besides a quick kludge for one customer
707 my $default = dbdef->table($child_table)->column($child_pkey)->default;
708 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
709 or return "can't parse $child_table.$child_pkey default value ".
710 " for sequence name: $default";
715 my @sel_columns = grep { $_ ne $primary_key }
716 dbdef->table($child_table)->columns;
717 my $sel_columns = join(', ', @sel_columns );
719 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
720 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
721 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
723 my $sel_st = "SELECT $sel_columns FROM $child_table".
724 " WHERE $primary_key = $sourceid";
727 my $sel_sth = dbh->prepare( $sel_st )
728 or return dbh->errstr;
730 $sel_sth->execute or return $sel_sth->errstr;
732 while ( my $row = $sel_sth->fetchrow_hashref ) {
734 warn " selected row: ".
735 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
739 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
740 my $ins_sth =dbh->prepare($statement)
741 or return dbh->errstr;
742 my @param = ( $destid, map $row->{$_}, @ins_columns );
743 warn " $statement: [ ". join(', ', @param). " ]\n"
745 $ins_sth->execute( @param )
746 or return $ins_sth->errstr;
748 #next unless keys %{ $child_tables{$child_table} };
749 next unless $sequence;
751 #another section of that laziness
752 my $seq_sql = "SELECT currval('$sequence')";
753 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
754 $seq_sth->execute or return $seq_sth->errstr;
755 my $insertid = $seq_sth->fetchrow_arrayref->[0];
757 # don't drink soap! recurse! recurse! okay!
759 _copy_skel( $child_table_def,
760 $row->{$child_pkey}, #sourceid
762 %{ $child_tables{$child_table_def} },
764 return $error if $error;
774 =item order_pkg HASHREF | OPTION => VALUE ...
776 Orders a single package.
778 Options may be passed as a list of key/value pairs or as a hash reference.
789 Optional FS::cust_location object
793 Optional arryaref of FS::svc_* service objects.
797 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
798 jobs will have a dependancy on the supplied job (they will not run until the
799 specific job completes). This can be used to defer provisioning until some
800 action completes (such as running the customer's credit card successfully).
804 Optional subject for a ticket created and attached to this customer
808 Optional queue name for ticket additions
816 my $opt = ref($_[0]) ? shift : { @_ };
818 warn "$me order_pkg called with options ".
819 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
822 my $cust_pkg = $opt->{'cust_pkg'};
823 my $svcs = $opt->{'svcs'} || [];
825 my %svc_options = ();
826 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
827 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
829 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
830 qw( ticket_subject ticket_queue );
832 local $SIG{HUP} = 'IGNORE';
833 local $SIG{INT} = 'IGNORE';
834 local $SIG{QUIT} = 'IGNORE';
835 local $SIG{TERM} = 'IGNORE';
836 local $SIG{TSTP} = 'IGNORE';
837 local $SIG{PIPE} = 'IGNORE';
839 my $oldAutoCommit = $FS::UID::AutoCommit;
840 local $FS::UID::AutoCommit = 0;
843 if ( $opt->{'cust_location'} &&
844 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
845 my $error = $opt->{'cust_location'}->insert;
847 $dbh->rollback if $oldAutoCommit;
848 return "inserting cust_location (transaction rolled back): $error";
850 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
853 $cust_pkg->custnum( $self->custnum );
855 my $error = $cust_pkg->insert( %insert_params );
857 $dbh->rollback if $oldAutoCommit;
858 return "inserting cust_pkg (transaction rolled back): $error";
861 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
862 if ( $svc_something->svcnum ) {
863 my $old_cust_svc = $svc_something->cust_svc;
864 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
865 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
866 $error = $new_cust_svc->replace($old_cust_svc);
868 $svc_something->pkgnum( $cust_pkg->pkgnum );
869 if ( $svc_something->isa('FS::svc_acct') ) {
870 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
871 qw( seconds upbytes downbytes totalbytes ) ) {
872 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
873 ${ $opt->{$_.'_ref'} } = 0;
876 $error = $svc_something->insert(%svc_options);
879 $dbh->rollback if $oldAutoCommit;
880 return "inserting svc_ (transaction rolled back): $error";
884 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
889 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
890 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
892 Like the insert method on an existing record, this method orders multiple
893 packages and included services atomicaly. Pass a Tie::RefHash data structure
894 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
895 There should be a better explanation of this, but until then, here's an
899 tie %hash, 'Tie::RefHash'; #this part is important
901 $cust_pkg => [ $svc_acct ],
904 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
906 Services can be new, in which case they are inserted, or existing unaudited
907 services, in which case they are linked to the newly-created package.
909 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
910 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
912 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
913 on the supplied jobnum (they will not run until the specific job completes).
914 This can be used to defer provisioning until some action completes (such
915 as running the customer's credit card successfully).
917 The I<noexport> option is deprecated. If I<noexport> is set true, no
918 provisioning jobs (exports) are scheduled. (You can schedule them later with
919 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
920 on the cust_main object is not recommended, as existing services will also be
923 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
924 provided, the scalars (provided by references) will be incremented by the
925 values of the prepaid card.`
931 my $cust_pkgs = shift;
932 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
934 $seconds_ref ||= $options{'seconds_ref'};
936 warn "$me order_pkgs called with options ".
937 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
940 local $SIG{HUP} = 'IGNORE';
941 local $SIG{INT} = 'IGNORE';
942 local $SIG{QUIT} = 'IGNORE';
943 local $SIG{TERM} = 'IGNORE';
944 local $SIG{TSTP} = 'IGNORE';
945 local $SIG{PIPE} = 'IGNORE';
947 my $oldAutoCommit = $FS::UID::AutoCommit;
948 local $FS::UID::AutoCommit = 0;
951 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
953 foreach my $cust_pkg ( keys %$cust_pkgs ) {
955 my $error = $self->order_pkg(
956 'cust_pkg' => $cust_pkg,
957 'svcs' => $cust_pkgs->{$cust_pkg},
958 'seconds_ref' => $seconds_ref,
959 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
964 $dbh->rollback if $oldAutoCommit;
970 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
974 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
976 Recharges this (existing) customer with the specified prepaid card (see
977 L<FS::prepay_credit>), specified either by I<identifier> or as an
978 FS::prepay_credit object. If there is an error, returns the error, otherwise
981 Optionally, five scalar references can be passed as well. They will have their
982 values filled in with the amount, number of seconds, and number of upload,
983 download, and total bytes applied by this prepaid card.
987 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
988 #the only place that uses these args
989 sub recharge_prepay {
990 my( $self, $prepay_credit, $amountref, $secondsref,
991 $upbytesref, $downbytesref, $totalbytesref ) = @_;
993 local $SIG{HUP} = 'IGNORE';
994 local $SIG{INT} = 'IGNORE';
995 local $SIG{QUIT} = 'IGNORE';
996 local $SIG{TERM} = 'IGNORE';
997 local $SIG{TSTP} = 'IGNORE';
998 local $SIG{PIPE} = 'IGNORE';
1000 my $oldAutoCommit = $FS::UID::AutoCommit;
1001 local $FS::UID::AutoCommit = 0;
1004 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
1006 my $error = $self->get_prepay( $prepay_credit,
1007 'amount_ref' => \$amount,
1008 'seconds_ref' => \$seconds,
1009 'upbytes_ref' => \$upbytes,
1010 'downbytes_ref' => \$downbytes,
1011 'totalbytes_ref' => \$totalbytes,
1013 || $self->increment_seconds($seconds)
1014 || $self->increment_upbytes($upbytes)
1015 || $self->increment_downbytes($downbytes)
1016 || $self->increment_totalbytes($totalbytes)
1017 || $self->insert_cust_pay_prepay( $amount,
1019 ? $prepay_credit->identifier
1024 $dbh->rollback if $oldAutoCommit;
1028 if ( defined($amountref) ) { $$amountref = $amount; }
1029 if ( defined($secondsref) ) { $$secondsref = $seconds; }
1030 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
1031 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
1032 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
1034 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1039 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
1041 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
1042 specified either by I<identifier> or as an FS::prepay_credit object.
1044 Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>. The scalars (provided by references) will be
1045 incremented by the values of the prepaid card.
1047 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
1048 check or set this customer's I<agentnum>.
1050 If there is an error, returns the error, otherwise returns false.
1056 my( $self, $prepay_credit, %opt ) = @_;
1058 local $SIG{HUP} = 'IGNORE';
1059 local $SIG{INT} = 'IGNORE';
1060 local $SIG{QUIT} = 'IGNORE';
1061 local $SIG{TERM} = 'IGNORE';
1062 local $SIG{TSTP} = 'IGNORE';
1063 local $SIG{PIPE} = 'IGNORE';
1065 my $oldAutoCommit = $FS::UID::AutoCommit;
1066 local $FS::UID::AutoCommit = 0;
1069 unless ( ref($prepay_credit) ) {
1071 my $identifier = $prepay_credit;
1073 $prepay_credit = qsearchs(
1075 { 'identifier' => $prepay_credit },
1080 unless ( $prepay_credit ) {
1081 $dbh->rollback if $oldAutoCommit;
1082 return "Invalid prepaid card: ". $identifier;
1087 if ( $prepay_credit->agentnum ) {
1088 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1089 $dbh->rollback if $oldAutoCommit;
1090 return "prepaid card not valid for agent ". $self->agentnum;
1092 $self->agentnum($prepay_credit->agentnum);
1095 my $error = $prepay_credit->delete;
1097 $dbh->rollback if $oldAutoCommit;
1098 return "removing prepay_credit (transaction rolled back): $error";
1101 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1102 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1104 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1109 =item increment_upbytes SECONDS
1111 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1112 the specified number of upbytes. If there is an error, returns the error,
1113 otherwise returns false.
1117 sub increment_upbytes {
1118 _increment_column( shift, 'upbytes', @_);
1121 =item increment_downbytes SECONDS
1123 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1124 the specified number of downbytes. If there is an error, returns the error,
1125 otherwise returns false.
1129 sub increment_downbytes {
1130 _increment_column( shift, 'downbytes', @_);
1133 =item increment_totalbytes SECONDS
1135 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1136 the specified number of totalbytes. If there is an error, returns the error,
1137 otherwise returns false.
1141 sub increment_totalbytes {
1142 _increment_column( shift, 'totalbytes', @_);
1145 =item increment_seconds SECONDS
1147 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1148 the specified number of seconds. If there is an error, returns the error,
1149 otherwise returns false.
1153 sub increment_seconds {
1154 _increment_column( shift, 'seconds', @_);
1157 =item _increment_column AMOUNT
1159 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1160 the specified number of seconds or bytes. If there is an error, returns
1161 the error, otherwise returns false.
1165 sub _increment_column {
1166 my( $self, $column, $amount ) = @_;
1167 warn "$me increment_column called: $column, $amount\n"
1170 return '' unless $amount;
1172 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1173 $self->ncancelled_pkgs;
1175 if ( ! @cust_pkg ) {
1176 return 'No packages with primary or single services found'.
1177 ' to apply pre-paid time';
1178 } elsif ( scalar(@cust_pkg) > 1 ) {
1179 #maybe have a way to specify the package/account?
1180 return 'Multiple packages found to apply pre-paid time';
1183 my $cust_pkg = $cust_pkg[0];
1184 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1188 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1190 if ( ! @cust_svc ) {
1191 return 'No account found to apply pre-paid time';
1192 } elsif ( scalar(@cust_svc) > 1 ) {
1193 return 'Multiple accounts found to apply pre-paid time';
1196 my $svc_acct = $cust_svc[0]->svc_x;
1197 warn " found service svcnum ". $svc_acct->pkgnum.
1198 ' ('. $svc_acct->email. ")\n"
1201 $column = "increment_$column";
1202 $svc_acct->$column($amount);
1206 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1208 Inserts a prepayment in the specified amount for this customer. An optional
1209 second argument can specify the prepayment identifier for tracking purposes.
1210 If there is an error, returns the error, otherwise returns false.
1214 sub insert_cust_pay_prepay {
1215 shift->insert_cust_pay('PREP', @_);
1218 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1220 Inserts a cash payment in the specified amount for this customer. An optional
1221 second argument can specify the payment identifier for tracking purposes.
1222 If there is an error, returns the error, otherwise returns false.
1226 sub insert_cust_pay_cash {
1227 shift->insert_cust_pay('CASH', @_);
1230 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1232 Inserts a Western Union payment in the specified amount for this customer. An
1233 optional second argument can specify the prepayment identifier for tracking
1234 purposes. If there is an error, returns the error, otherwise returns false.
1238 sub insert_cust_pay_west {
1239 shift->insert_cust_pay('WEST', @_);
1242 sub insert_cust_pay {
1243 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1244 my $payinfo = scalar(@_) ? shift : '';
1246 my $cust_pay = new FS::cust_pay {
1247 'custnum' => $self->custnum,
1248 'paid' => sprintf('%.2f', $amount),
1249 #'_date' => #date the prepaid card was purchased???
1251 'payinfo' => $payinfo,
1259 This method is deprecated. See the I<depend_jobnum> option to the insert and
1260 order_pkgs methods for a better way to defer provisioning.
1262 Re-schedules all exports by calling the B<reexport> method of all associated
1263 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1264 otherwise returns false.
1271 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1272 "use the depend_jobnum option to insert or order_pkgs to delay export";
1274 local $SIG{HUP} = 'IGNORE';
1275 local $SIG{INT} = 'IGNORE';
1276 local $SIG{QUIT} = 'IGNORE';
1277 local $SIG{TERM} = 'IGNORE';
1278 local $SIG{TSTP} = 'IGNORE';
1279 local $SIG{PIPE} = 'IGNORE';
1281 my $oldAutoCommit = $FS::UID::AutoCommit;
1282 local $FS::UID::AutoCommit = 0;
1285 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1286 my $error = $cust_pkg->reexport;
1288 $dbh->rollback if $oldAutoCommit;
1293 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1298 =item delete [ OPTION => VALUE ... ]
1300 This deletes the customer. If there is an error, returns the error, otherwise
1303 This will completely remove all traces of the customer record. This is not
1304 what you want when a customer cancels service; for that, cancel all of the
1305 customer's packages (see L</cancel>).
1307 If the customer has any uncancelled packages, you need to pass a new (valid)
1308 customer number for those packages to be transferred to, as the "new_customer"
1309 option. Cancelled packages will be deleted. Did I mention that this is NOT
1310 what you want when a customer cancels service and that you really should be
1311 looking at L<FS::cust_pkg/cancel>?
1313 You can't delete a customer with invoices (see L<FS::cust_bill>),
1314 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1315 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1316 set the "delete_financials" option to a true value.
1321 my( $self, %opt ) = @_;
1323 local $SIG{HUP} = 'IGNORE';
1324 local $SIG{INT} = 'IGNORE';
1325 local $SIG{QUIT} = 'IGNORE';
1326 local $SIG{TERM} = 'IGNORE';
1327 local $SIG{TSTP} = 'IGNORE';
1328 local $SIG{PIPE} = 'IGNORE';
1330 my $oldAutoCommit = $FS::UID::AutoCommit;
1331 local $FS::UID::AutoCommit = 0;
1334 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1335 $dbh->rollback if $oldAutoCommit;
1336 return "Can't delete a master agent customer";
1339 #use FS::access_user
1340 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1341 $dbh->rollback if $oldAutoCommit;
1342 return "Can't delete a master employee customer";
1345 tie my %financial_tables, 'Tie::IxHash',
1346 'cust_bill' => 'invoices',
1347 'cust_statement' => 'statements',
1348 'cust_credit' => 'credits',
1349 'cust_pay' => 'payments',
1350 'cust_refund' => 'refunds',
1353 foreach my $table ( keys %financial_tables ) {
1355 my @records = $self->$table();
1357 if ( @records && ! $opt{'delete_financials'} ) {
1358 $dbh->rollback if $oldAutoCommit;
1359 return "Can't delete a customer with ". $financial_tables{$table};
1362 foreach my $record ( @records ) {
1363 my $error = $record->delete;
1365 $dbh->rollback if $oldAutoCommit;
1366 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1372 my @cust_pkg = $self->ncancelled_pkgs;
1374 my $new_custnum = $opt{'new_custnum'};
1375 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1376 $dbh->rollback if $oldAutoCommit;
1377 return "Invalid new customer number: $new_custnum";
1379 foreach my $cust_pkg ( @cust_pkg ) {
1380 my %hash = $cust_pkg->hash;
1381 $hash{'custnum'} = $new_custnum;
1382 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1383 my $error = $new_cust_pkg->replace($cust_pkg,
1384 options => { $cust_pkg->options },
1387 $dbh->rollback if $oldAutoCommit;
1392 my @cancelled_cust_pkg = $self->all_pkgs;
1393 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1394 my $error = $cust_pkg->delete;
1396 $dbh->rollback if $oldAutoCommit;
1401 #cust_tax_adjustment in financials?
1402 #cust_pay_pending? ouch
1404 foreach my $table (qw(
1405 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1406 cust_location cust_main_note cust_tax_adjustment
1407 cust_pay_void cust_pay_batch queue cust_tax_exempt
1409 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1410 my $error = $record->delete;
1412 $dbh->rollback if $oldAutoCommit;
1418 my $sth = $dbh->prepare(
1419 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1421 my $errstr = $dbh->errstr;
1422 $dbh->rollback if $oldAutoCommit;
1425 $sth->execute($self->custnum) or do {
1426 my $errstr = $sth->errstr;
1427 $dbh->rollback if $oldAutoCommit;
1433 my $ticket_dbh = '';
1434 if ($conf->config('ticket_system') eq 'RT_Internal') {
1436 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1437 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1438 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1439 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1442 if ( $ticket_dbh ) {
1444 my $ticket_sth = $ticket_dbh->prepare(
1445 'DELETE FROM Links WHERE Target = ?'
1447 my $errstr = $ticket_dbh->errstr;
1448 $dbh->rollback if $oldAutoCommit;
1451 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1453 my $errstr = $ticket_sth->errstr;
1454 $dbh->rollback if $oldAutoCommit;
1458 #check and see if the customer is the only link on the ticket, and
1459 #if so, set the ticket to deleted status in RT?
1460 #maybe someday, for now this will at least fix tickets not displaying
1464 #delete the customer record
1466 my $error = $self->SUPER::delete;
1468 $dbh->rollback if $oldAutoCommit;
1472 # cust_main exports!
1474 #my $export_args = $options{'export_args'} || [];
1477 map qsearch( 'part_export', {exportnum=>$_} ),
1478 $conf->config('cust_main-exports'); #, $agentnum
1480 foreach my $part_export ( @part_export ) {
1481 my $error = $part_export->export_delete( $self ); #, @$export_args);
1483 $dbh->rollback if $oldAutoCommit;
1484 return "exporting to ". $part_export->exporttype.
1485 " (transaction rolled back): $error";
1489 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1494 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1497 Replaces the OLD_RECORD with this one in the database. If there is an error,
1498 returns the error, otherwise returns false.
1500 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1501 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1502 expected and rollback the entire transaction; it is not necessary to call
1503 check_invoicing_list first. Here's an example:
1505 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1507 Currently available options are: I<tax_exemption>.
1509 The I<tax_exemption> option can be set to an arrayref of tax names.
1510 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1517 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1519 : $self->replace_old;
1523 warn "$me replace called\n"
1526 my $curuser = $FS::CurrentUser::CurrentUser;
1527 if ( $self->payby eq 'COMP'
1528 && $self->payby ne $old->payby
1529 && ! $curuser->access_right('Complimentary customer')
1532 return "You are not permitted to create complimentary accounts.";
1535 local($ignore_expired_card) = 1
1536 if $old->payby =~ /^(CARD|DCRD)$/
1537 && $self->payby =~ /^(CARD|DCRD)$/
1538 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1540 local $SIG{HUP} = 'IGNORE';
1541 local $SIG{INT} = 'IGNORE';
1542 local $SIG{QUIT} = 'IGNORE';
1543 local $SIG{TERM} = 'IGNORE';
1544 local $SIG{TSTP} = 'IGNORE';
1545 local $SIG{PIPE} = 'IGNORE';
1547 my $oldAutoCommit = $FS::UID::AutoCommit;
1548 local $FS::UID::AutoCommit = 0;
1551 my $error = $self->SUPER::replace($old);
1554 $dbh->rollback if $oldAutoCommit;
1558 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1559 my $invoicing_list = shift @param;
1560 $error = $self->check_invoicing_list( $invoicing_list );
1562 $dbh->rollback if $oldAutoCommit;
1565 $self->invoicing_list( $invoicing_list );
1568 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1570 #this could be more efficient than deleting and re-inserting, if it matters
1571 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1572 my $error = $cust_tag->delete;
1574 $dbh->rollback if $oldAutoCommit;
1578 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1579 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1580 'custnum' => $self->custnum };
1581 my $error = $cust_tag->insert;
1583 $dbh->rollback if $oldAutoCommit;
1590 my %options = @param;
1592 my $tax_exemption = delete $options{'tax_exemption'};
1593 if ( $tax_exemption ) {
1595 my %cust_main_exemption =
1596 map { $_->taxname => $_ }
1597 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1599 foreach my $taxname ( @$tax_exemption ) {
1601 next if delete $cust_main_exemption{$taxname};
1603 my $cust_main_exemption = new FS::cust_main_exemption {
1604 'custnum' => $self->custnum,
1605 'taxname' => $taxname,
1607 my $error = $cust_main_exemption->insert;
1609 $dbh->rollback if $oldAutoCommit;
1610 return "inserting cust_main_exemption (transaction rolled back): $error";
1614 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1615 my $error = $cust_main_exemption->delete;
1617 $dbh->rollback if $oldAutoCommit;
1618 return "deleting cust_main_exemption (transaction rolled back): $error";
1624 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1625 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1626 && $self->get('payinfo') !~ /^99\d{14}$/
1628 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1633 # card/check/lec info has changed, want to retry realtime_ invoice events
1634 my $error = $self->retry_realtime;
1636 $dbh->rollback if $oldAutoCommit;
1641 unless ( $import || $skip_fuzzyfiles ) {
1642 $error = $self->queue_fuzzyfiles_update;
1644 $dbh->rollback if $oldAutoCommit;
1645 return "updating fuzzy search cache: $error";
1649 # cust_main exports!
1651 my $export_args = $options{'export_args'} || [];
1654 map qsearch( 'part_export', {exportnum=>$_} ),
1655 $conf->config('cust_main-exports'); #, $agentnum
1657 foreach my $part_export ( @part_export ) {
1658 my $error = $part_export->export_replace( $self, $old, @$export_args);
1660 $dbh->rollback if $oldAutoCommit;
1661 return "exporting to ". $part_export->exporttype.
1662 " (transaction rolled back): $error";
1666 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1671 =item queue_fuzzyfiles_update
1673 Used by insert & replace to update the fuzzy search cache
1677 sub queue_fuzzyfiles_update {
1680 local $SIG{HUP} = 'IGNORE';
1681 local $SIG{INT} = 'IGNORE';
1682 local $SIG{QUIT} = 'IGNORE';
1683 local $SIG{TERM} = 'IGNORE';
1684 local $SIG{TSTP} = 'IGNORE';
1685 local $SIG{PIPE} = 'IGNORE';
1687 my $oldAutoCommit = $FS::UID::AutoCommit;
1688 local $FS::UID::AutoCommit = 0;
1691 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1692 my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1694 $dbh->rollback if $oldAutoCommit;
1695 return "queueing job (transaction rolled back): $error";
1698 if ( $self->ship_last ) {
1699 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1700 $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1702 $dbh->rollback if $oldAutoCommit;
1703 return "queueing job (transaction rolled back): $error";
1707 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1714 Checks all fields to make sure this is a valid customer record. If there is
1715 an error, returns the error, otherwise returns false. Called by the insert
1716 and replace methods.
1723 warn "$me check BEFORE: \n". $self->_dump
1727 $self->ut_numbern('custnum')
1728 || $self->ut_number('agentnum')
1729 || $self->ut_textn('agent_custid')
1730 || $self->ut_number('refnum')
1731 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1732 || $self->ut_textn('custbatch')
1733 || $self->ut_name('last')
1734 || $self->ut_name('first')
1735 || $self->ut_snumbern('birthdate')
1736 || $self->ut_snumbern('signupdate')
1737 || $self->ut_textn('company')
1738 || $self->ut_text('address1')
1739 || $self->ut_textn('address2')
1740 || $self->ut_text('city')
1741 || $self->ut_textn('county')
1742 || $self->ut_textn('state')
1743 || $self->ut_country('country')
1744 || $self->ut_anything('comments')
1745 || $self->ut_numbern('referral_custnum')
1746 || $self->ut_textn('stateid')
1747 || $self->ut_textn('stateid_state')
1748 || $self->ut_textn('invoice_terms')
1749 || $self->ut_alphan('geocode')
1750 || $self->ut_floatn('cdr_termination_percentage')
1753 #barf. need message catalogs. i18n. etc.
1754 $error .= "Please select an advertising source."
1755 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1756 return $error if $error;
1758 return "Unknown agent"
1759 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1761 return "Unknown refnum"
1762 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1764 return "Unknown referring custnum: ". $self->referral_custnum
1765 unless ! $self->referral_custnum
1766 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1768 if ( $self->censustract ne '' ) {
1769 $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1770 or return "Illegal census tract: ". $self->censustract;
1772 $self->censustract("$1.$2");
1775 if ( $self->ss eq '' ) {
1780 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1781 or return "Illegal social security number: ". $self->ss;
1782 $self->ss("$1-$2-$3");
1786 # bad idea to disable, causes billing to fail because of no tax rates later
1787 # except we don't fail any more
1788 unless ( $import ) {
1789 unless ( qsearch('cust_main_county', {
1790 'country' => $self->country,
1793 return "Unknown state/county/country: ".
1794 $self->state. "/". $self->county. "/". $self->country
1795 unless qsearch('cust_main_county',{
1796 'state' => $self->state,
1797 'county' => $self->county,
1798 'country' => $self->country,
1804 $self->ut_phonen('daytime', $self->country)
1805 || $self->ut_phonen('night', $self->country)
1806 || $self->ut_phonen('fax', $self->country)
1807 || $self->ut_zip('zip', $self->country)
1809 return $error if $error;
1811 if ( $conf->exists('cust_main-require_phone')
1812 && ! length($self->daytime) && ! length($self->night)
1815 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1817 : FS::Msgcat::_gettext('daytime');
1818 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1820 : FS::Msgcat::_gettext('night');
1822 return "$daytime_label or $night_label is required"
1826 if ( $self->has_ship_address
1827 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1828 $self->addr_fields )
1832 $self->ut_name('ship_last')
1833 || $self->ut_name('ship_first')
1834 || $self->ut_textn('ship_company')
1835 || $self->ut_text('ship_address1')
1836 || $self->ut_textn('ship_address2')
1837 || $self->ut_text('ship_city')
1838 || $self->ut_textn('ship_county')
1839 || $self->ut_textn('ship_state')
1840 || $self->ut_country('ship_country')
1842 return $error if $error;
1844 #false laziness with above
1845 unless ( qsearchs('cust_main_county', {
1846 'country' => $self->ship_country,
1849 return "Unknown ship_state/ship_county/ship_country: ".
1850 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1851 unless qsearch('cust_main_county',{
1852 'state' => $self->ship_state,
1853 'county' => $self->ship_county,
1854 'country' => $self->ship_country,
1860 $self->ut_phonen('ship_daytime', $self->ship_country)
1861 || $self->ut_phonen('ship_night', $self->ship_country)
1862 || $self->ut_phonen('ship_fax', $self->ship_country)
1863 || $self->ut_zip('ship_zip', $self->ship_country)
1865 return $error if $error;
1867 return "Unit # is required."
1868 if $self->ship_address2 =~ /^\s*$/
1869 && $conf->exists('cust_main-require_address2');
1871 } else { # ship_ info eq billing info, so don't store dup info in database
1873 $self->setfield("ship_$_", '')
1874 foreach $self->addr_fields;
1876 return "Unit # is required."
1877 if $self->address2 =~ /^\s*$/
1878 && $conf->exists('cust_main-require_address2');
1882 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1883 # or return "Illegal payby: ". $self->payby;
1885 FS::payby->can_payby($self->table, $self->payby)
1886 or return "Illegal payby: ". $self->payby;
1888 $error = $self->ut_numbern('paystart_month')
1889 || $self->ut_numbern('paystart_year')
1890 || $self->ut_numbern('payissue')
1891 || $self->ut_textn('paytype')
1893 return $error if $error;
1895 if ( $self->payip eq '' ) {
1898 $error = $self->ut_ip('payip');
1899 return $error if $error;
1902 # If it is encrypted and the private key is not availaible then we can't
1903 # check the credit card.
1904 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1906 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1908 my $payinfo = $self->payinfo;
1909 $payinfo =~ s/\D//g;
1910 $payinfo =~ /^(\d{13,16})$/
1911 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1913 $self->payinfo($payinfo);
1915 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1917 return gettext('unknown_card_type')
1918 if $self->payinfo !~ /^99\d{14}$/ #token
1919 && cardtype($self->payinfo) eq "Unknown";
1921 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1923 return 'Banned credit card: banned on '.
1924 time2str('%a %h %o at %r', $ban->_date).
1925 ' by '. $ban->otaker.
1926 ' (ban# '. $ban->bannum. ')';
1929 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1930 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1931 $self->paycvv =~ /^(\d{4})$/
1932 or return "CVV2 (CID) for American Express cards is four digits.";
1935 $self->paycvv =~ /^(\d{3})$/
1936 or return "CVV2 (CVC2/CID) is three digits.";
1943 my $cardtype = cardtype($payinfo);
1944 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1946 return "Start date or issue number is required for $cardtype cards"
1947 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1949 return "Start month must be between 1 and 12"
1950 if $self->paystart_month
1951 and $self->paystart_month < 1 || $self->paystart_month > 12;
1953 return "Start year must be 1990 or later"
1954 if $self->paystart_year
1955 and $self->paystart_year < 1990;
1957 return "Issue number must be beween 1 and 99"
1959 and $self->payissue < 1 || $self->payissue > 99;
1962 $self->paystart_month('');
1963 $self->paystart_year('');
1964 $self->payissue('');
1967 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1969 my $payinfo = $self->payinfo;
1970 $payinfo =~ s/[^\d\@]//g;
1971 if ( $conf->exists('echeck-nonus') ) {
1972 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1973 $payinfo = "$1\@$2";
1975 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1976 $payinfo = "$1\@$2";
1978 $self->payinfo($payinfo);
1981 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1983 return 'Banned ACH account: banned on '.
1984 time2str('%a %h %o at %r', $ban->_date).
1985 ' by '. $ban->otaker.
1986 ' (ban# '. $ban->bannum. ')';
1989 } elsif ( $self->payby eq 'LECB' ) {
1991 my $payinfo = $self->payinfo;
1992 $payinfo =~ s/\D//g;
1993 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1995 $self->payinfo($payinfo);
1998 } elsif ( $self->payby eq 'BILL' ) {
2000 $error = $self->ut_textn('payinfo');
2001 return "Illegal P.O. number: ". $self->payinfo if $error;
2004 } elsif ( $self->payby eq 'COMP' ) {
2006 my $curuser = $FS::CurrentUser::CurrentUser;
2007 if ( ! $self->custnum
2008 && ! $curuser->access_right('Complimentary customer')
2011 return "You are not permitted to create complimentary accounts."
2014 $error = $self->ut_textn('payinfo');
2015 return "Illegal comp account issuer: ". $self->payinfo if $error;
2018 } elsif ( $self->payby eq 'PREPAY' ) {
2020 my $payinfo = $self->payinfo;
2021 $payinfo =~ s/\W//g; #anything else would just confuse things
2022 $self->payinfo($payinfo);
2023 $error = $self->ut_alpha('payinfo');
2024 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2025 return "Unknown prepayment identifier"
2026 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2031 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2032 return "Expiration date required"
2033 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2037 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2038 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2039 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2040 ( $m, $y ) = ( $2, "19$1" );
2041 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2042 ( $m, $y ) = ( $3, "20$2" );
2044 return "Illegal expiration date: ". $self->paydate;
2046 $self->paydate("$y-$m-01");
2047 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2048 return gettext('expired_card')
2050 && !$ignore_expired_card
2051 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2054 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2055 ( ! $conf->exists('require_cardname')
2056 || $self->payby !~ /^(CARD|DCRD)$/ )
2058 $self->payname( $self->first. " ". $self->getfield('last') );
2060 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2061 or return gettext('illegal_name'). " payname: ". $self->payname;
2065 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2066 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2070 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2072 warn "$me check AFTER: \n". $self->_dump
2075 $self->SUPER::check;
2080 Returns a list of fields which have ship_ duplicates.
2085 qw( last first company
2086 address1 address2 city county state zip country
2091 =item has_ship_address
2093 Returns true if this customer record has a separate shipping address.
2097 sub has_ship_address {
2099 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2104 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2105 city, county, state, zip, country. The shipping address is used if present.
2109 #geocode? dependent on tax-ship_address config, not available in cust_location
2110 #mostly. not yet then.
2114 my $prefix = $self->has_ship_address ? 'ship_' : '';
2116 map { $_ => $self->get($prefix.$_) }
2117 qw( address1 address2 city county state zip country geocode );
2118 #fields that cust_location has
2121 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2123 Returns all packages (see L<FS::cust_pkg>) for this customer.
2129 my $extra_qsearch = ref($_[0]) ? shift : {};
2131 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
2134 if ( $self->{'_pkgnum'} ) {
2135 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
2137 @cust_pkg = $self->_cust_pkg($extra_qsearch);
2140 sort sort_packages @cust_pkg;
2145 Synonym for B<all_pkgs>.
2150 shift->all_pkgs(@_);
2155 Returns all locations (see L<FS::cust_location>) for this customer.
2161 qsearch('cust_location', { 'custnum' => $self->custnum } );
2164 =item location_label [ OPTION => VALUE ... ]
2166 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
2174 used to separate the address elements (defaults to ', ')
2176 =item escape_function
2178 a callback used for escaping the text of the address elements
2184 # false laziness with FS::cust_location::line
2186 sub location_label {
2190 my $separator = $opt{join_string} || ', ';
2191 my $escape = $opt{escape_function} || sub{ shift };
2193 my $cydefault = FS::conf->new->config('countrydefault') || 'US';
2194 my $prefix = length($self->ship_last) ? 'ship_' : '';
2197 foreach (qw ( address1 address2 ) ) {
2198 my $method = "$prefix$_";
2199 $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
2204 foreach (qw ( city county state zip ) ) {
2205 my $method = "$prefix$_";
2206 if ( $self->$method ) {
2207 $line .= ' (' if $method eq 'county';
2208 $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
2209 $line .= ' )' if $method eq 'county';
2213 $line .= $separator. &$escape(code2country($self->country))
2214 if $self->country ne $cydefault;
2219 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2221 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
2225 sub ncancelled_pkgs {
2227 my $extra_qsearch = ref($_[0]) ? shift : {};
2229 return $self->num_ncancelled_pkgs unless wantarray;
2232 if ( $self->{'_pkgnum'} ) {
2234 warn "$me ncancelled_pkgs: returning cached objects"
2237 @cust_pkg = grep { ! $_->getfield('cancel') }
2238 values %{ $self->{'_pkgnum'}->cache };
2242 warn "$me ncancelled_pkgs: searching for packages with custnum ".
2243 $self->custnum. "\n"
2246 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2248 @cust_pkg = $self->_cust_pkg($extra_qsearch);
2252 sort sort_packages @cust_pkg;
2258 my $extra_qsearch = ref($_[0]) ? shift : {};
2260 $extra_qsearch->{'select'} ||= '*';
2261 $extra_qsearch->{'select'} .=
2262 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2266 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2271 'table' => 'cust_pkg',
2272 'hashref' => { 'custnum' => $self->custnum },
2277 # This should be generalized to use config options to determine order.
2280 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
2281 return $locationsort if $locationsort;
2283 if ( $a->get('cancel') xor $b->get('cancel') ) {
2284 return -1 if $b->get('cancel');
2285 return 1 if $a->get('cancel');
2286 #shouldn't get here...
2289 my $a_num_cust_svc = $a->num_cust_svc;
2290 my $b_num_cust_svc = $b->num_cust_svc;
2291 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
2292 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
2293 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
2294 my @a_cust_svc = $a->cust_svc;
2295 my @b_cust_svc = $b->cust_svc;
2296 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2297 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2298 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
2299 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2304 =item suspended_pkgs
2306 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2310 sub suspended_pkgs {
2312 grep { $_->susp } $self->ncancelled_pkgs;
2315 =item unflagged_suspended_pkgs
2317 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2318 customer (thouse packages without the `manual_flag' set).
2322 sub unflagged_suspended_pkgs {
2324 return $self->suspended_pkgs
2325 unless dbdef->table('cust_pkg')->column('manual_flag');
2326 grep { ! $_->manual_flag } $self->suspended_pkgs;
2329 =item unsuspended_pkgs
2331 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2336 sub unsuspended_pkgs {
2338 grep { ! $_->susp } $self->ncancelled_pkgs;
2341 =item next_bill_date
2343 Returns the next date this customer will be billed, as a UNIX timestamp, or
2344 undef if no active package has a next bill date.
2348 sub next_bill_date {
2350 min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2353 =item num_cancelled_pkgs
2355 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2360 sub num_cancelled_pkgs {
2361 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2364 sub num_ncancelled_pkgs {
2365 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2369 my( $self ) = shift;
2370 my $sql = scalar(@_) ? shift : '';
2371 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2372 my $sth = dbh->prepare(
2373 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2374 ) or die dbh->errstr;
2375 $sth->execute($self->custnum) or die $sth->errstr;
2376 $sth->fetchrow_arrayref->[0];
2381 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2382 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2383 on success or a list of errors.
2389 grep { $_->unsuspend } $self->suspended_pkgs;
2394 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2396 Returns a list: an empty list on success or a list of errors.
2402 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2405 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2407 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2408 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2409 of a list of pkgparts; the hashref has the following keys:
2413 =item pkgparts - listref of pkgparts
2415 =item (other options are passed to the suspend method)
2420 Returns a list: an empty list on success or a list of errors.
2424 sub suspend_if_pkgpart {
2426 my (@pkgparts, %opt);
2427 if (ref($_[0]) eq 'HASH'){
2428 @pkgparts = @{$_[0]{pkgparts}};
2433 grep { $_->suspend(%opt) }
2434 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2435 $self->unsuspended_pkgs;
2438 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2440 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2441 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2442 instead of a list of pkgparts; the hashref has the following keys:
2446 =item pkgparts - listref of pkgparts
2448 =item (other options are passed to the suspend method)
2452 Returns a list: an empty list on success or a list of errors.
2456 sub suspend_unless_pkgpart {
2458 my (@pkgparts, %opt);
2459 if (ref($_[0]) eq 'HASH'){
2460 @pkgparts = @{$_[0]{pkgparts}};
2465 grep { $_->suspend(%opt) }
2466 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2467 $self->unsuspended_pkgs;
2470 =item cancel [ OPTION => VALUE ... ]
2472 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2474 Available options are:
2478 =item quiet - can be set true to supress email cancellation notices.
2480 =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.
2482 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2484 =item nobill - can be set true to skip billing if it might otherwise be done.
2488 Always returns a list: an empty list on success or a list of errors.
2492 # nb that dates are not specified as valid options to this method
2495 my( $self, %opt ) = @_;
2497 warn "$me cancel called on customer ". $self->custnum. " with options ".
2498 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2501 return ( 'access denied' )
2502 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2504 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2506 #should try decryption (we might have the private key)
2507 # and if not maybe queue a job for the server that does?
2508 return ( "Can't (yet) ban encrypted credit cards" )
2509 if $self->is_encrypted($self->payinfo);
2511 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2512 my $error = $ban->insert;
2513 return ( $error ) if $error;
2517 my @pkgs = $self->ncancelled_pkgs;
2519 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2521 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2522 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2526 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2527 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2530 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2533 sub _banned_pay_hashref {
2544 'payby' => $payby2ban{$self->payby},
2545 'payinfo' => md5_base64($self->payinfo),
2546 #don't ever *search* on reason! #'reason' =>
2552 Returns all notes (see L<FS::cust_main_note>) for this customer.
2559 qsearch( 'cust_main_note',
2560 { 'custnum' => $self->custnum },
2562 'ORDER BY _DATE DESC'
2568 Returns the agent (see L<FS::agent>) for this customer.
2574 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2579 Returns the agent name (see L<FS::agent>) for this customer.
2585 $self->agent->agent;
2590 Returns any tags associated with this customer, as FS::cust_tag objects,
2591 or an empty list if there are no tags.
2597 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2602 Returns any tags associated with this customer, as FS::part_tag objects,
2603 or an empty list if there are no tags.
2609 map $_->part_tag, $self->cust_tag;
2615 Returns the customer class, as an FS::cust_class object, or the empty string
2616 if there is no customer class.
2622 if ( $self->classnum ) {
2623 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2631 Returns the customer category name, or the empty string if there is no customer
2638 my $cust_class = $self->cust_class;
2640 ? $cust_class->categoryname
2646 Returns the customer class name, or the empty string if there is no customer
2653 my $cust_class = $self->cust_class;
2655 ? $cust_class->classname
2659 =item BILLING METHODS
2661 Documentation on billing methods has been moved to
2662 L<FS::cust_main::Billing>.
2664 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
2666 Runs billing events; see L<FS::part_event> and the billing events web
2669 If there is an error, returns the error, otherwise returns false.
2671 Options are passed as name-value pairs.
2673 Currently available options are:
2679 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.
2683 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2687 "collect" (the default) or "pre-bill"
2691 set true to surpress email card/ACH decline notices.
2695 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)
2701 # allows for one time override of normal customer billing method
2705 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2708 my( $self, %options ) = @_;
2709 my $time = $options{'time'} || time;
2712 local $SIG{HUP} = 'IGNORE';
2713 local $SIG{INT} = 'IGNORE';
2714 local $SIG{QUIT} = 'IGNORE';
2715 local $SIG{TERM} = 'IGNORE';
2716 local $SIG{TSTP} = 'IGNORE';
2717 local $SIG{PIPE} = 'IGNORE';
2719 my $oldAutoCommit = $FS::UID::AutoCommit;
2720 local $FS::UID::AutoCommit = 0;
2723 $self->select_for_update; #mutex
2726 my $balance = $self->balance;
2727 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
2730 # if ( exists($options{'retry_card'}) ) {
2731 # carp 'retry_card option passed to collect is deprecated; use retry';
2732 # $options{'retry'} ||= $options{'retry_card'};
2734 # if ( exists($options{'retry'}) && $options{'retry'} ) {
2735 # my $error = $self->retry_realtime;
2737 # $dbh->rollback if $oldAutoCommit;
2742 # false laziness w/pay_batch::import_results
2744 my $due_cust_event = $self->due_cust_event(
2745 'debug' => ( $options{'debug'} || 0 ),
2747 'check_freq' => $options{'check_freq'},
2748 'stage' => ( $options{'stage'} || 'collect' ),
2750 unless( ref($due_cust_event) ) {
2751 $dbh->rollback if $oldAutoCommit;
2752 return $due_cust_event;
2755 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2756 #never want to roll back an event just because it or a different one
2758 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
2760 foreach my $cust_event ( @$due_cust_event ) {
2764 #re-eval event conditions (a previous event could have changed things)
2765 unless ( $cust_event->test_conditions( 'time' => $time ) ) {
2766 #don't leave stray "new/locked" records around
2767 my $error = $cust_event->delete;
2768 return $error if $error;
2773 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2774 warn " running cust_event ". $cust_event->eventnum. "\n"
2777 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2778 if ( my $error = $cust_event->do_event() ) {
2779 #XXX wtf is this? figure out a proper dealio with return value
2791 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2793 Inserts database records for and returns an ordered listref of new events due
2794 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
2795 events are due, an empty listref is returned. If there is an error, returns a
2796 scalar error message.
2798 To actually run the events, call each event's test_condition method, and if
2799 still true, call the event's do_event method.
2801 Options are passed as a hashref or as a list of name-value pairs. Available
2808 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.
2812 "collect" (the default) or "pre-bill"
2816 "Current time" for the events.
2820 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)
2824 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2828 Explicitly pass the objects to be tested (typically used with eventtable).
2832 Set to true to return the objects, but not actually insert them into the
2839 sub due_cust_event {
2841 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2844 #my $DEBUG = $opt{'debug'}
2845 local($DEBUG) = $opt{'debug'}
2846 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2848 warn "$me due_cust_event called with options ".
2849 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2852 $opt{'time'} ||= time;
2854 local $SIG{HUP} = 'IGNORE';
2855 local $SIG{INT} = 'IGNORE';
2856 local $SIG{QUIT} = 'IGNORE';
2857 local $SIG{TERM} = 'IGNORE';
2858 local $SIG{TSTP} = 'IGNORE';
2859 local $SIG{PIPE} = 'IGNORE';
2861 my $oldAutoCommit = $FS::UID::AutoCommit;
2862 local $FS::UID::AutoCommit = 0;
2865 $self->select_for_update #mutex
2866 unless $opt{testonly};
2869 # find possible events (initial search)
2872 my @cust_event = ();
2874 my @eventtable = $opt{'eventtable'}
2875 ? ( $opt{'eventtable'} )
2876 : FS::part_event->eventtables_runorder;
2878 foreach my $eventtable ( @eventtable ) {
2881 if ( $opt{'objects'} ) {
2883 @objects = @{ $opt{'objects'} };
2887 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2888 @objects = ( $eventtable eq 'cust_main' )
2890 : ( $self->$eventtable() );
2894 my @e_cust_event = ();
2896 my $cross = "CROSS JOIN $eventtable";
2897 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2898 unless $eventtable eq 'cust_main';
2900 foreach my $object ( @objects ) {
2902 #this first search uses the condition_sql magic for optimization.
2903 #the more possible events we can eliminate in this step the better
2905 my $cross_where = '';
2906 my $pkey = $object->primary_key;
2907 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2909 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2911 FS::part_event_condition->where_conditions_sql( $eventtable,
2912 'time'=>$opt{'time'}
2914 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2916 $extra_sql = "AND $extra_sql" if $extra_sql;
2918 #here is the agent virtualization
2919 $extra_sql .= " AND ( part_event.agentnum IS NULL
2920 OR part_event.agentnum = ". $self->agentnum. ' )';
2922 $extra_sql .= " $order";
2924 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2925 if $opt{'debug'} > 2;
2926 my @part_event = qsearch( {
2927 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2928 'select' => 'part_event.*',
2929 'table' => 'part_event',
2930 'addl_from' => "$cross $join",
2931 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2932 'eventtable' => $eventtable,
2935 'extra_sql' => "AND $cross_where $extra_sql",
2939 my $pkey = $object->primary_key;
2940 warn " ". scalar(@part_event).
2941 " possible events found for $eventtable ". $object->$pkey(). "\n";
2944 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2948 warn " ". scalar(@e_cust_event).
2949 " subtotal possible cust events found for $eventtable\n"
2952 push @cust_event, @e_cust_event;
2956 warn " ". scalar(@cust_event).
2957 " total possible cust events found in initial search\n"
2965 $opt{stage} ||= 'collect';
2967 grep { my $stage = $_->part_event->event_stage;
2968 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2978 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
2979 'stats_hashref' => \%unsat ),
2982 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2985 warn " invalid conditions not eliminated with condition_sql:\n".
2986 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2987 if keys %unsat && $DEBUG; # > 1;
2993 unless( $opt{testonly} ) {
2994 foreach my $cust_event ( @cust_event ) {
2996 my $error = $cust_event->insert();
2998 $dbh->rollback if $oldAutoCommit;
3005 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3011 warn " returning events: ". Dumper(@cust_event). "\n"
3018 =item retry_realtime
3020 Schedules realtime / batch credit card / electronic check / LEC billing
3021 events for for retry. Useful if card information has changed or manual
3022 retry is desired. The 'collect' method must be called to actually retry
3025 Implementation details: For either this customer, or for each of this
3026 customer's open invoices, changes the status of the first "done" (with
3027 statustext error) realtime processing event to "failed".
3031 sub retry_realtime {
3034 local $SIG{HUP} = 'IGNORE';
3035 local $SIG{INT} = 'IGNORE';
3036 local $SIG{QUIT} = 'IGNORE';
3037 local $SIG{TERM} = 'IGNORE';
3038 local $SIG{TSTP} = 'IGNORE';
3039 local $SIG{PIPE} = 'IGNORE';
3041 my $oldAutoCommit = $FS::UID::AutoCommit;
3042 local $FS::UID::AutoCommit = 0;
3045 #a little false laziness w/due_cust_event (not too bad, really)
3047 my $join = FS::part_event_condition->join_conditions_sql;
3048 my $order = FS::part_event_condition->order_conditions_sql;
3051 . join ( ' OR ' , map {
3052 "( part_event.eventtable = " . dbh->quote($_)
3053 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3054 } FS::part_event->eventtables)
3057 #here is the agent virtualization
3058 my $agent_virt = " ( part_event.agentnum IS NULL
3059 OR part_event.agentnum = ". $self->agentnum. ' )';
3061 #XXX this shouldn't be hardcoded, actions should declare it...
3062 my @realtime_events = qw(
3063 cust_bill_realtime_card
3064 cust_bill_realtime_check
3065 cust_bill_realtime_lec
3069 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3074 my @cust_event = qsearchs({
3075 'table' => 'cust_event',
3076 'select' => 'cust_event.*',
3077 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3078 'hashref' => { 'status' => 'done' },
3079 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3080 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3083 my %seen_invnum = ();
3084 foreach my $cust_event (@cust_event) {
3086 #max one for the customer, one for each open invoice
3087 my $cust_X = $cust_event->cust_X;
3088 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3092 or $cust_event->part_event->eventtable eq 'cust_bill'
3095 my $error = $cust_event->retry;
3097 $dbh->rollback if $oldAutoCommit;
3098 return "error scheduling event for retry: $error";
3103 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3111 =item REALTIME BILLING METHODS
3113 Documentation on realtime billing methods has been moved to
3114 L<FS::cust_main::Billing_Realtime>.
3118 Removes the I<paycvv> field from the database directly.
3120 If there is an error, returns the error, otherwise returns false.
3126 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3127 or return dbh->errstr;
3128 $sth->execute($self->custnum)
3129 or return $sth->errstr;
3134 =item batch_card OPTION => VALUE...
3136 Adds a payment for this invoice to the pending credit card batch (see
3137 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
3138 runs the payment using a realtime gateway.
3143 my ($self, %options) = @_;
3146 if (exists($options{amount})) {
3147 $amount = $options{amount};
3149 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
3151 return '' unless $amount > 0;
3153 my $invnum = delete $options{invnum};
3154 my $payby = $options{invnum} || $self->payby; #dubious
3156 if ($options{'realtime'}) {
3157 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
3163 my $oldAutoCommit = $FS::UID::AutoCommit;
3164 local $FS::UID::AutoCommit = 0;
3167 #this needs to handle mysql as well as Pg, like svc_acct.pm
3168 #(make it into a common function if folks need to do batching with mysql)
3169 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
3170 or return "Cannot lock pay_batch: " . $dbh->errstr;
3174 'payby' => FS::payby->payby2payment($payby),
3177 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
3179 unless ( $pay_batch ) {
3180 $pay_batch = new FS::pay_batch \%pay_batch;
3181 my $error = $pay_batch->insert;
3183 $dbh->rollback if $oldAutoCommit;
3184 die "error creating new batch: $error\n";
3188 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
3189 'batchnum' => $pay_batch->batchnum,
3190 'custnum' => $self->custnum,
3193 foreach (qw( address1 address2 city state zip country payby payinfo paydate
3195 $options{$_} = '' unless exists($options{$_});
3198 my $cust_pay_batch = new FS::cust_pay_batch ( {
3199 'batchnum' => $pay_batch->batchnum,
3200 'invnum' => $invnum || 0, # is there a better value?
3201 # this field should be
3203 # cust_bill_pay_batch now
3204 'custnum' => $self->custnum,
3205 'last' => $self->getfield('last'),
3206 'first' => $self->getfield('first'),
3207 'address1' => $options{address1} || $self->address1,
3208 'address2' => $options{address2} || $self->address2,
3209 'city' => $options{city} || $self->city,
3210 'state' => $options{state} || $self->state,
3211 'zip' => $options{zip} || $self->zip,
3212 'country' => $options{country} || $self->country,
3213 'payby' => $options{payby} || $self->payby,
3214 'payinfo' => $options{payinfo} || $self->payinfo,
3215 'exp' => $options{paydate} || $self->paydate,
3216 'payname' => $options{payname} || $self->payname,
3217 'amount' => $amount, # consolidating
3220 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
3221 if $old_cust_pay_batch;
3224 if ($old_cust_pay_batch) {
3225 $error = $cust_pay_batch->replace($old_cust_pay_batch)
3227 $error = $cust_pay_batch->insert;
3231 $dbh->rollback if $oldAutoCommit;
3235 my $unapplied = $self->total_unapplied_credits
3236 + $self->total_unapplied_payments
3237 + $self->in_transit_payments;
3238 foreach my $cust_bill ($self->open_cust_bill) {
3239 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
3240 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
3241 'invnum' => $cust_bill->invnum,
3242 'paybatchnum' => $cust_pay_batch->paybatchnum,
3243 'amount' => $cust_bill->owed,
3246 if ($unapplied >= $cust_bill_pay_batch->amount){
3247 $unapplied -= $cust_bill_pay_batch->amount;
3250 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
3251 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
3253 $error = $cust_bill_pay_batch->insert;
3255 $dbh->rollback if $oldAutoCommit;
3260 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3266 Returns the total owed for this customer on all invoices
3267 (see L<FS::cust_bill/owed>).
3273 $self->total_owed_date(2145859200); #12/31/2037
3276 =item total_owed_date TIME
3278 Returns the total owed for this customer on all invoices with date earlier than
3279 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
3280 see L<Time::Local> and L<Date::Parse> for conversion functions.
3284 sub total_owed_date {
3288 my $custnum = $self->custnum;
3290 my $owed_sql = FS::cust_bill->owed_sql;
3293 SELECT SUM($owed_sql) FROM cust_bill
3294 WHERE custnum = $custnum
3298 sprintf( "%.2f", $self->scalar_sql($sql) );
3302 =item total_owed_pkgnum PKGNUM
3304 Returns the total owed on all invoices for this customer's specific package
3305 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
3309 sub total_owed_pkgnum {
3310 my( $self, $pkgnum ) = @_;
3311 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
3314 =item total_owed_date_pkgnum TIME PKGNUM
3316 Returns the total owed for this customer's specific package when using
3317 experimental package balances on all invoices with date earlier than
3318 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
3319 see L<Time::Local> and L<Date::Parse> for conversion functions.
3323 sub total_owed_date_pkgnum {
3324 my( $self, $time, $pkgnum ) = @_;
3327 foreach my $cust_bill (
3328 grep { $_->_date <= $time }
3329 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3331 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
3333 sprintf( "%.2f", $total_bill );
3339 Returns the total amount of all payments.
3346 $total += $_->paid foreach $self->cust_pay;
3347 sprintf( "%.2f", $total );
3350 =item total_unapplied_credits
3352 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3353 customer. See L<FS::cust_credit/credited>.
3355 =item total_credited
3357 Old name for total_unapplied_credits. Don't use.
3361 sub total_credited {
3362 #carp "total_credited deprecated, use total_unapplied_credits";
3363 shift->total_unapplied_credits(@_);
3366 sub total_unapplied_credits {
3369 my $custnum = $self->custnum;
3371 my $unapplied_sql = FS::cust_credit->unapplied_sql;
3374 SELECT SUM($unapplied_sql) FROM cust_credit
3375 WHERE custnum = $custnum
3378 sprintf( "%.2f", $self->scalar_sql($sql) );
3382 =item total_unapplied_credits_pkgnum PKGNUM
3384 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3385 customer. See L<FS::cust_credit/credited>.
3389 sub total_unapplied_credits_pkgnum {
3390 my( $self, $pkgnum ) = @_;
3391 my $total_credit = 0;
3392 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
3393 sprintf( "%.2f", $total_credit );
3397 =item total_unapplied_payments
3399 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3400 See L<FS::cust_pay/unapplied>.
3404 sub total_unapplied_payments {
3407 my $custnum = $self->custnum;
3409 my $unapplied_sql = FS::cust_pay->unapplied_sql;
3412 SELECT SUM($unapplied_sql) FROM cust_pay
3413 WHERE custnum = $custnum
3416 sprintf( "%.2f", $self->scalar_sql($sql) );
3420 =item total_unapplied_payments_pkgnum PKGNUM
3422 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
3423 specific package when using experimental package balances. See
3424 L<FS::cust_pay/unapplied>.
3428 sub total_unapplied_payments_pkgnum {
3429 my( $self, $pkgnum ) = @_;
3430 my $total_unapplied = 0;
3431 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
3432 sprintf( "%.2f", $total_unapplied );
3436 =item total_unapplied_refunds
3438 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
3439 customer. See L<FS::cust_refund/unapplied>.
3443 sub total_unapplied_refunds {
3445 my $custnum = $self->custnum;
3447 my $unapplied_sql = FS::cust_refund->unapplied_sql;
3450 SELECT SUM($unapplied_sql) FROM cust_refund
3451 WHERE custnum = $custnum
3454 sprintf( "%.2f", $self->scalar_sql($sql) );
3460 Returns the balance for this customer (total_owed plus total_unrefunded, minus
3461 total_unapplied_credits minus total_unapplied_payments).
3467 $self->balance_date_range;
3470 =item balance_date TIME
3472 Returns the balance for this customer, only considering invoices with date
3473 earlier than TIME (total_owed_date minus total_credited minus
3474 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3475 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3482 $self->balance_date_range(shift);
3485 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3487 Returns the balance for this customer, optionally considering invoices with
3488 date earlier than START_TIME, and not later than END_TIME
3489 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
3491 Times are specified as SQL fragments or numeric
3492 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
3493 L<Date::Parse> for conversion functions. The empty string can be passed
3494 to disable that time constraint completely.
3496 Available options are:
3500 =item unapplied_date
3502 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)
3508 sub balance_date_range {
3510 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
3511 ') FROM cust_main WHERE custnum='. $self->custnum;
3512 sprintf( '%.2f', $self->scalar_sql($sql) );
3515 =item balance_pkgnum PKGNUM
3517 Returns the balance for this customer's specific package when using
3518 experimental package balances (total_owed plus total_unrefunded, minus
3519 total_unapplied_credits minus total_unapplied_payments)
3523 sub balance_pkgnum {
3524 my( $self, $pkgnum ) = @_;
3527 $self->total_owed_pkgnum($pkgnum)
3528 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
3529 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
3530 - $self->total_unapplied_credits_pkgnum($pkgnum)
3531 - $self->total_unapplied_payments_pkgnum($pkgnum)
3535 =item in_transit_payments
3537 Returns the total of requests for payments for this customer pending in
3538 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
3542 sub in_transit_payments {
3544 my $in_transit_payments = 0;
3545 foreach my $pay_batch ( qsearch('pay_batch', {
3548 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3549 'batchnum' => $pay_batch->batchnum,
3550 'custnum' => $self->custnum,
3552 $in_transit_payments += $cust_pay_batch->amount;
3555 sprintf( "%.2f", $in_transit_payments );
3560 Returns a hash of useful information for making a payment.
3570 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3571 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3572 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3576 For credit card transactions:
3588 For electronic check transactions:
3603 $return{balance} = $self->balance;
3605 $return{payname} = $self->payname
3606 || ( $self->first. ' '. $self->get('last') );
3608 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
3610 $return{payby} = $self->payby;
3611 $return{stateid_state} = $self->stateid_state;
3613 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3614 $return{card_type} = cardtype($self->payinfo);
3615 $return{payinfo} = $self->paymask;
3617 @return{'month', 'year'} = $self->paydate_monthyear;
3621 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3622 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3623 $return{payinfo1} = $payinfo1;
3624 $return{payinfo2} = $payinfo2;
3625 $return{paytype} = $self->paytype;
3626 $return{paystate} = $self->paystate;
3630 #doubleclick protection
3632 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3638 =item paydate_monthyear
3640 Returns a two-element list consisting of the month and year of this customer's
3641 paydate (credit card expiration date for CARD customers)
3645 sub paydate_monthyear {
3647 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3649 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3656 =item tax_exemption TAXNAME
3661 my( $self, $taxname ) = @_;
3663 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3664 'taxname' => $taxname,
3669 =item cust_main_exemption
3673 sub cust_main_exemption {
3675 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3678 =item invoicing_list [ ARRAYREF ]
3680 If an arguement is given, sets these email addresses as invoice recipients
3681 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3682 (except as warnings), so use check_invoicing_list first.
3684 Returns a list of email addresses (with svcnum entries expanded).
3686 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3687 check it without disturbing anything by passing nothing.
3689 This interface may change in the future.
3693 sub invoicing_list {
3694 my( $self, $arrayref ) = @_;
3697 my @cust_main_invoice;
3698 if ( $self->custnum ) {
3699 @cust_main_invoice =
3700 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3702 @cust_main_invoice = ();
3704 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3705 #warn $cust_main_invoice->destnum;
3706 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3707 #warn $cust_main_invoice->destnum;
3708 my $error = $cust_main_invoice->delete;
3709 warn $error if $error;
3712 if ( $self->custnum ) {
3713 @cust_main_invoice =
3714 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3716 @cust_main_invoice = ();
3718 my %seen = map { $_->address => 1 } @cust_main_invoice;
3719 foreach my $address ( @{$arrayref} ) {
3720 next if exists $seen{$address} && $seen{$address};
3721 $seen{$address} = 1;
3722 my $cust_main_invoice = new FS::cust_main_invoice ( {
3723 'custnum' => $self->custnum,
3726 my $error = $cust_main_invoice->insert;
3727 warn $error if $error;
3731 if ( $self->custnum ) {
3733 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3740 =item check_invoicing_list ARRAYREF
3742 Checks these arguements as valid input for the invoicing_list method. If there
3743 is an error, returns the error, otherwise returns false.
3747 sub check_invoicing_list {
3748 my( $self, $arrayref ) = @_;
3750 foreach my $address ( @$arrayref ) {
3752 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3753 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3756 my $cust_main_invoice = new FS::cust_main_invoice ( {
3757 'custnum' => $self->custnum,
3760 my $error = $self->custnum
3761 ? $cust_main_invoice->check
3762 : $cust_main_invoice->checkdest
3764 return $error if $error;
3768 return "Email address required"
3769 if $conf->exists('cust_main-require_invoicing_list_email')
3770 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3775 =item set_default_invoicing_list
3777 Sets the invoicing list to all accounts associated with this customer,
3778 overwriting any previous invoicing list.
3782 sub set_default_invoicing_list {
3784 $self->invoicing_list($self->all_emails);
3789 Returns the email addresses of all accounts provisioned for this customer.
3796 foreach my $cust_pkg ( $self->all_pkgs ) {
3797 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3799 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3800 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3802 $list{$_}=1 foreach map { $_->email } @svc_acct;
3807 =item invoicing_list_addpost
3809 Adds postal invoicing to this customer. If this customer is already configured
3810 to receive postal invoices, does nothing.
3814 sub invoicing_list_addpost {
3816 return if grep { $_ eq 'POST' } $self->invoicing_list;
3817 my @invoicing_list = $self->invoicing_list;
3818 push @invoicing_list, 'POST';
3819 $self->invoicing_list(\@invoicing_list);
3822 =item invoicing_list_emailonly
3824 Returns the list of email invoice recipients (invoicing_list without non-email
3825 destinations such as POST and FAX).
3829 sub invoicing_list_emailonly {
3831 warn "$me invoicing_list_emailonly called"
3833 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3836 =item invoicing_list_emailonly_scalar
3838 Returns the list of email invoice recipients (invoicing_list without non-email
3839 destinations such as POST and FAX) as a comma-separated scalar.
3843 sub invoicing_list_emailonly_scalar {
3845 warn "$me invoicing_list_emailonly_scalar called"
3847 join(', ', $self->invoicing_list_emailonly);
3850 =item referral_custnum_cust_main
3852 Returns the customer who referred this customer (or the empty string, if
3853 this customer was not referred).
3855 Note the difference with referral_cust_main method: This method,
3856 referral_custnum_cust_main returns the single customer (if any) who referred
3857 this customer, while referral_cust_main returns an array of customers referred
3862 sub referral_custnum_cust_main {
3864 return '' unless $self->referral_custnum;
3865 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3868 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3870 Returns an array of customers referred by this customer (referral_custnum set
3871 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3872 customers referred by customers referred by this customer and so on, inclusive.
3873 The default behavior is DEPTH 1 (no recursion).
3875 Note the difference with referral_custnum_cust_main method: This method,
3876 referral_cust_main, returns an array of customers referred BY this customer,
3877 while referral_custnum_cust_main returns the single customer (if any) who
3878 referred this customer.
3882 sub referral_cust_main {
3884 my $depth = @_ ? shift : 1;
3885 my $exclude = @_ ? shift : {};
3888 map { $exclude->{$_->custnum}++; $_; }
3889 grep { ! $exclude->{ $_->custnum } }
3890 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3894 map { $_->referral_cust_main($depth-1, $exclude) }
3901 =item referral_cust_main_ncancelled
3903 Same as referral_cust_main, except only returns customers with uncancelled
3908 sub referral_cust_main_ncancelled {
3910 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3913 =item referral_cust_pkg [ DEPTH ]
3915 Like referral_cust_main, except returns a flat list of all unsuspended (and
3916 uncancelled) packages for each customer. The number of items in this list may
3917 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3921 sub referral_cust_pkg {
3923 my $depth = @_ ? shift : 1;
3925 map { $_->unsuspended_pkgs }
3926 grep { $_->unsuspended_pkgs }
3927 $self->referral_cust_main($depth);
3930 =item referring_cust_main
3932 Returns the single cust_main record for the customer who referred this customer
3933 (referral_custnum), or false.
3937 sub referring_cust_main {
3939 return '' unless $self->referral_custnum;
3940 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3943 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3945 Applies a credit to this customer. If there is an error, returns the error,
3946 otherwise returns false.
3948 REASON can be a text string, an FS::reason object, or a scalar reference to
3949 a reasonnum. If a text string, it will be automatically inserted as a new
3950 reason, and a 'reason_type' option must be passed to indicate the
3951 FS::reason_type for the new reason.
3953 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3955 Any other options are passed to FS::cust_credit::insert.
3960 my( $self, $amount, $reason, %options ) = @_;
3962 my $cust_credit = new FS::cust_credit {
3963 'custnum' => $self->custnum,
3964 'amount' => $amount,
3967 if ( ref($reason) ) {
3969 if ( ref($reason) eq 'SCALAR' ) {
3970 $cust_credit->reasonnum( $$reason );
3972 $cust_credit->reasonnum( $reason->reasonnum );
3976 $cust_credit->set('reason', $reason)
3979 for (qw( addlinfo eventnum )) {
3980 $cust_credit->$_( delete $options{$_} )
3981 if exists($options{$_});
3984 $cust_credit->insert(%options);
3988 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3990 Creates a one-time charge for this customer. If there is an error, returns
3991 the error, otherwise returns false.
3993 New-style, with a hashref of options:
3995 my $error = $cust_main->charge(
3999 'start_date' => str2time('7/4/2009'),
4000 'pkg' => 'Description',
4001 'comment' => 'Comment',
4002 'additional' => [], #extra invoice detail
4003 'classnum' => 1, #pkg_class
4005 'setuptax' => '', # or 'Y' for tax exempt
4008 'taxclass' => 'Tax class',
4011 'taxproduct' => 2, #part_pkg_taxproduct
4012 'override' => {}, #XXX describe
4014 #will be filled in with the new object
4015 'cust_pkg_ref' => \$cust_pkg,
4017 #generate an invoice immediately
4019 'invoice_terms' => '', #with these terms
4025 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
4031 my ( $amount, $quantity, $start_date, $classnum );
4032 my ( $pkg, $comment, $additional );
4033 my ( $setuptax, $taxclass ); #internal taxes
4034 my ( $taxproduct, $override ); #vendor (CCH) taxes
4036 my $cust_pkg_ref = '';
4037 my ( $bill_now, $invoice_terms ) = ( 0, '' );
4038 if ( ref( $_[0] ) ) {
4039 $amount = $_[0]->{amount};
4040 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
4041 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
4042 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
4043 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4044 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
4045 : '$'. sprintf("%.2f",$amount);
4046 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
4047 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4048 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
4049 $additional = $_[0]->{additional} || [];
4050 $taxproduct = $_[0]->{taxproductnum};
4051 $override = { '' => $_[0]->{tax_override} };
4052 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
4053 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
4054 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
4059 $pkg = @_ ? shift : 'One-time charge';
4060 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
4062 $taxclass = @_ ? shift : '';
4066 local $SIG{HUP} = 'IGNORE';
4067 local $SIG{INT} = 'IGNORE';
4068 local $SIG{QUIT} = 'IGNORE';
4069 local $SIG{TERM} = 'IGNORE';
4070 local $SIG{TSTP} = 'IGNORE';
4071 local $SIG{PIPE} = 'IGNORE';
4073 my $oldAutoCommit = $FS::UID::AutoCommit;
4074 local $FS::UID::AutoCommit = 0;
4077 my $part_pkg = new FS::part_pkg ( {
4079 'comment' => $comment,
4083 'classnum' => ( $classnum ? $classnum : '' ),
4084 'setuptax' => $setuptax,
4085 'taxclass' => $taxclass,
4086 'taxproductnum' => $taxproduct,
4089 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4090 ( 0 .. @$additional - 1 )
4092 'additional_count' => scalar(@$additional),
4093 'setup_fee' => $amount,
4096 my $error = $part_pkg->insert( options => \%options,
4097 tax_overrides => $override,
4100 $dbh->rollback if $oldAutoCommit;
4104 my $pkgpart = $part_pkg->pkgpart;
4105 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4106 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4107 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4108 $error = $type_pkgs->insert;
4110 $dbh->rollback if $oldAutoCommit;
4115 my $cust_pkg = new FS::cust_pkg ( {
4116 'custnum' => $self->custnum,
4117 'pkgpart' => $pkgpart,
4118 'quantity' => $quantity,
4119 'start_date' => $start_date,
4120 'no_auto' => $no_auto,
4123 $error = $cust_pkg->insert;
4125 $dbh->rollback if $oldAutoCommit;
4127 } elsif ( $cust_pkg_ref ) {
4128 ${$cust_pkg_ref} = $cust_pkg;
4132 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
4133 'pkg_list' => [ $cust_pkg ],
4136 $dbh->rollback if $oldAutoCommit;
4141 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4146 #=item charge_postal_fee
4148 #Applies a one time charge this customer. If there is an error,
4149 #returns the error, returns the cust_pkg charge object or false
4150 #if there was no charge.
4154 # This should be a customer event. For that to work requires that bill
4155 # also be a customer event.
4157 sub charge_postal_fee {
4160 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
4161 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
4163 my $cust_pkg = new FS::cust_pkg ( {
4164 'custnum' => $self->custnum,
4165 'pkgpart' => $pkgpart,
4169 my $error = $cust_pkg->insert;
4170 $error ? $error : $cust_pkg;
4175 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4181 map { $_ } #return $self->num_cust_bill unless wantarray;
4182 sort { $a->_date <=> $b->_date }
4183 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4186 =item open_cust_bill
4188 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4193 sub open_cust_bill {
4197 'table' => 'cust_bill',
4198 'hashref' => { 'custnum' => $self->custnum, },
4199 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
4200 'order_by' => 'ORDER BY _date ASC',
4205 =item cust_statements
4207 Returns all the statements (see L<FS::cust_statement>) for this customer.
4211 sub cust_statement {
4213 map { $_ } #return $self->num_cust_statement unless wantarray;
4214 sort { $a->_date <=> $b->_date }
4215 qsearch('cust_statement', { 'custnum' => $self->custnum, } )
4220 Returns all the credits (see L<FS::cust_credit>) for this customer.
4226 map { $_ } #return $self->num_cust_credit unless wantarray;
4227 sort { $a->_date <=> $b->_date }
4228 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4231 =item cust_credit_pkgnum
4233 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
4234 package when using experimental package balances.
4238 sub cust_credit_pkgnum {
4239 my( $self, $pkgnum ) = @_;
4240 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
4241 sort { $a->_date <=> $b->_date }
4242 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
4243 'pkgnum' => $pkgnum,
4250 Returns all the payments (see L<FS::cust_pay>) for this customer.
4256 return $self->num_cust_pay unless wantarray;
4257 sort { $a->_date <=> $b->_date }
4258 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
4263 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
4264 called automatically when the cust_pay method is used in a scalar context.
4270 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
4271 my $sth = dbh->prepare($sql) or die dbh->errstr;
4272 $sth->execute($self->custnum) or die $sth->errstr;
4273 $sth->fetchrow_arrayref->[0];
4276 =item cust_pay_pkgnum
4278 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4279 package when using experimental package balances.
4283 sub cust_pay_pkgnum {
4284 my( $self, $pkgnum ) = @_;
4285 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4286 sort { $a->_date <=> $b->_date }
4287 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4288 'pkgnum' => $pkgnum,
4295 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4301 map { $_ } #return $self->num_cust_pay_void unless wantarray;
4302 sort { $a->_date <=> $b->_date }
4303 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4306 =item cust_pay_batch
4308 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
4312 sub cust_pay_batch {
4314 map { $_ } #return $self->num_cust_pay_batch unless wantarray;
4315 sort { $a->paybatchnum <=> $b->paybatchnum }
4316 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
4319 =item cust_pay_pending
4321 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4322 (without status "done").
4326 sub cust_pay_pending {
4328 return $self->num_cust_pay_pending unless wantarray;
4329 sort { $a->_date <=> $b->_date }
4330 qsearch( 'cust_pay_pending', {
4331 'custnum' => $self->custnum,
4332 'status' => { op=>'!=', value=>'done' },
4337 =item cust_pay_pending_attempt
4339 Returns all payment attempts / declined payments for this customer, as pending
4340 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4341 a corresponding payment (see L<FS::cust_pay>).
4345 sub cust_pay_pending_attempt {
4347 return $self->num_cust_pay_pending_attempt unless wantarray;
4348 sort { $a->_date <=> $b->_date }
4349 qsearch( 'cust_pay_pending', {
4350 'custnum' => $self->custnum,
4357 =item num_cust_pay_pending
4359 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4360 customer (without status "done"). Also called automatically when the
4361 cust_pay_pending method is used in a scalar context.
4365 sub num_cust_pay_pending {
4368 " SELECT COUNT(*) FROM cust_pay_pending ".
4369 " WHERE custnum = ? AND status != 'done' ",
4374 =item num_cust_pay_pending_attempt
4376 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4377 customer, with status "done" but without a corresp. Also called automatically when the
4378 cust_pay_pending method is used in a scalar context.
4382 sub num_cust_pay_pending_attempt {
4385 " SELECT COUNT(*) FROM cust_pay_pending ".
4386 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4393 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4399 map { $_ } #return $self->num_cust_refund unless wantarray;
4400 sort { $a->_date <=> $b->_date }
4401 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4404 =item display_custnum
4406 Returns the displayed customer number for this customer: agent_custid if
4407 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4411 sub display_custnum {
4413 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4414 return $self->agent_custid;
4416 return $self->custnum;
4422 Returns a name string for this customer, either "Company (Last, First)" or
4429 my $name = $self->contact;
4430 $name = $self->company. " ($name)" if $self->company;
4436 Returns a name string for this (service/shipping) contact, either
4437 "Company (Last, First)" or "Last, First".
4443 if ( $self->get('ship_last') ) {
4444 my $name = $self->ship_contact;
4445 $name = $self->ship_company. " ($name)" if $self->ship_company;
4454 Returns a name string for this customer, either "Company" or "First Last".
4460 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4463 =item ship_name_short
4465 Returns a name string for this (service/shipping) contact, either "Company"
4470 sub ship_name_short {
4472 if ( $self->get('ship_last') ) {
4473 $self->ship_company !~ /^\s*$/
4474 ? $self->ship_company
4475 : $self->ship_contact_firstlast;
4477 $self->name_company_or_firstlast;
4483 Returns this customer's full (billing) contact name only, "Last, First"
4489 $self->get('last'). ', '. $self->first;
4494 Returns this customer's full (shipping) contact name only, "Last, First"
4500 $self->get('ship_last')
4501 ? $self->get('ship_last'). ', '. $self->ship_first
4505 =item contact_firstlast
4507 Returns this customers full (billing) contact name only, "First Last".
4511 sub contact_firstlast {
4513 $self->first. ' '. $self->get('last');
4516 =item ship_contact_firstlast
4518 Returns this customer's full (shipping) contact name only, "First Last".
4522 sub ship_contact_firstlast {
4524 $self->get('ship_last')
4525 ? $self->first. ' '. $self->get('ship_last')
4526 : $self->contact_firstlast;
4531 Returns this customer's full country name
4537 code2country($self->country);
4540 =item geocode DATA_VENDOR
4542 Returns a value for the customer location as encoded by DATA_VENDOR.
4543 Currently this only makes sense for "CCH" as DATA_VENDOR.
4548 my ($self, $data_vendor) = (shift, shift); #always cch for now
4550 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
4551 return $geocode if $geocode;
4553 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
4557 my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
4558 if $self->country eq 'US';
4562 #CCH specific location stuff
4563 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
4565 my @cust_tax_location =
4567 'table' => 'cust_tax_location',
4568 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
4569 'extra_sql' => $extra_sql,
4570 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
4573 $geocode = $cust_tax_location[0]->geocode
4574 if scalar(@cust_tax_location);
4583 Returns a status string for this customer, currently:
4587 =item prospect - No packages have ever been ordered
4589 =item ordered - Recurring packages all are new (not yet billed).
4591 =item active - One or more recurring packages is active
4593 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4595 =item suspended - All non-cancelled recurring packages are suspended
4597 =item cancelled - All recurring packages are cancelled
4603 sub status { shift->cust_status(@_); }
4607 # prospect ordered active inactive suspended cancelled
4608 for my $status ( FS::cust_main->statuses() ) {
4609 my $method = $status.'_sql';
4610 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4611 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4612 $sth->execute( ($self->custnum) x $numnum )
4613 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4614 return $status if $sth->fetchrow_arrayref->[0];
4618 =item ucfirst_cust_status
4620 =item ucfirst_status
4622 Returns the status with the first character capitalized.
4626 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4628 sub ucfirst_cust_status {
4630 ucfirst($self->cust_status);
4635 Returns a hex triplet color string for this customer's status.
4639 use vars qw(%statuscolor);
4640 tie %statuscolor, 'Tie::IxHash',
4641 'prospect' => '7e0079', #'000000', #black? naw, purple
4642 'active' => '00CC00', #green
4643 'ordered' => '009999', #teal? cyan?
4644 'inactive' => '0000CC', #blue
4645 'suspended' => 'FF9900', #yellow
4646 'cancelled' => 'FF0000', #red
4649 sub statuscolor { shift->cust_statuscolor(@_); }
4651 sub cust_statuscolor {
4653 $statuscolor{$self->cust_status};
4658 Returns an array of hashes representing the customer's RT tickets.
4665 my $num = $conf->config('cust_main-max_tickets') || 10;
4668 if ( $conf->config('ticket_system') ) {
4669 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4671 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4675 foreach my $priority (
4676 $conf->config('ticket_system-custom_priority_field-values'), ''
4678 last if scalar(@tickets) >= $num;
4680 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4681 $num - scalar(@tickets),
4691 # Return services representing svc_accts in customer support packages
4692 sub support_services {
4694 my %packages = map { $_ => 1 } $conf->config('support_packages');
4696 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4697 grep { $_->part_svc->svcdb eq 'svc_acct' }
4698 map { $_->cust_svc }
4699 grep { exists $packages{ $_->pkgpart } }
4700 $self->ncancelled_pkgs;
4704 # Return a list of latitude/longitude for one of the services (if any)
4705 sub service_coordinates {
4709 grep { $_->latitude && $_->longitude }
4711 map { $_->cust_svc }
4712 $self->ncancelled_pkgs;
4714 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4719 =head1 CLASS METHODS
4725 Class method that returns the list of possible status strings for customers
4726 (see L<the status method|/status>). For example:
4728 @statuses = FS::cust_main->statuses();
4733 #my $self = shift; #could be class...
4739 Returns an SQL expression identifying prospective cust_main records (customers
4740 with no packages ever ordered)
4744 use vars qw($select_count_pkgs);
4745 $select_count_pkgs =
4746 "SELECT COUNT(*) FROM cust_pkg
4747 WHERE cust_pkg.custnum = cust_main.custnum";
4749 sub select_count_pkgs_sql {
4754 " 0 = ( $select_count_pkgs ) ";
4759 Returns an SQL expression identifying ordered cust_main records (customers with
4760 recurring packages not yet setup).
4765 FS::cust_main->none_active_sql.
4766 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
4771 Returns an SQL expression identifying active cust_main records (customers with
4772 active recurring packages).
4777 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4780 =item none_active_sql
4782 Returns an SQL expression identifying cust_main records with no active
4783 recurring packages. This includes customers of status prospect, ordered,
4784 inactive, and suspended.
4788 sub none_active_sql {
4789 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4794 Returns an SQL expression identifying inactive cust_main records (customers with
4795 no active recurring packages, but otherwise unsuspended/uncancelled).
4800 FS::cust_main->none_active_sql.
4801 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4807 Returns an SQL expression identifying suspended cust_main records.
4812 sub suspended_sql { susp_sql(@_); }
4814 FS::cust_main->none_active_sql.
4815 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4821 Returns an SQL expression identifying cancelled cust_main records.
4825 sub cancelled_sql { cancel_sql(@_); }
4828 my $recurring_sql = FS::cust_pkg->recurring_sql;
4829 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
4832 0 < ( $select_count_pkgs )
4833 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
4834 AND 0 = ( $select_count_pkgs AND $recurring_sql
4835 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4837 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4843 =item uncancelled_sql
4845 Returns an SQL expression identifying un-cancelled cust_main records.
4849 sub uncancelled_sql { uncancel_sql(@_); }
4850 sub uncancel_sql { "
4851 ( 0 < ( $select_count_pkgs
4852 AND ( cust_pkg.cancel IS NULL
4853 OR cust_pkg.cancel = 0
4856 OR 0 = ( $select_count_pkgs )
4862 Returns an SQL fragment to retreive the balance.
4867 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4868 WHERE cust_bill.custnum = cust_main.custnum )
4869 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4870 WHERE cust_pay.custnum = cust_main.custnum )
4871 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4872 WHERE cust_credit.custnum = cust_main.custnum )
4873 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4874 WHERE cust_refund.custnum = cust_main.custnum )
4877 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4879 Returns an SQL fragment to retreive the balance for this customer, optionally
4880 considering invoices with date earlier than START_TIME, and not
4881 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4882 total_unapplied_payments).
4884 Times are specified as SQL fragments or numeric
4885 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4886 L<Date::Parse> for conversion functions. The empty string can be passed
4887 to disable that time constraint completely.
4889 Available options are:
4893 =item unapplied_date
4895 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)
4900 set to true to remove all customer comparison clauses, for totals
4905 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4910 JOIN clause (typically used with the total option)
4914 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4915 time will be ignored. Note that START_TIME and END_TIME only limit the date
4916 range for invoices and I<unapplied> payments, credits, and refunds.
4922 sub balance_date_sql {
4923 my( $class, $start, $end, %opt ) = @_;
4925 my $cutoff = $opt{'cutoff'};
4927 my $owed = FS::cust_bill->owed_sql($cutoff);
4928 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4929 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4930 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4932 my $j = $opt{'join'} || '';
4934 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4935 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4936 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4937 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4939 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4940 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4941 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4942 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4947 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4949 Returns an SQL fragment to retreive the total unapplied payments for this
4950 customer, only considering invoices with date earlier than START_TIME, and
4951 optionally not later than END_TIME.
4953 Times are specified as SQL fragments or numeric
4954 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4955 L<Date::Parse> for conversion functions. The empty string can be passed
4956 to disable that time constraint completely.
4958 Available options are:
4962 sub unapplied_payments_date_sql {
4963 my( $class, $start, $end, %opt ) = @_;
4965 my $cutoff = $opt{'cutoff'};
4967 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4969 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4970 'unapplied_date'=>1 );
4972 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4975 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4977 Helper method for balance_date_sql; name (and usage) subject to change
4978 (suggestions welcome).
4980 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4981 cust_refund, cust_credit or cust_pay).
4983 If TABLE is "cust_bill" or the unapplied_date option is true, only
4984 considers records with date earlier than START_TIME, and optionally not
4985 later than END_TIME .
4989 sub _money_table_where {
4990 my( $class, $table, $start, $end, %opt ) = @_;
4993 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4994 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4995 push @where, "$table._date <= $start" if defined($start) && length($start);
4996 push @where, "$table._date > $end" if defined($end) && length($end);
4998 push @where, @{$opt{'where'}} if $opt{'where'};
4999 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5005 =item search HASHREF
5009 Returns a qsearch hash expression to search for parameters specified in
5010 HASHREF. Valid parameters are
5018 =item cancelled_pkgs
5024 listref of start date, end date
5034 =item current_balance
5036 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5040 =item flattened_pkgs
5049 my ($class, $params) = @_;
5060 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5062 "cust_main.agentnum = $1";
5066 # do the same for user
5069 if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) {
5071 "cust_main.usernum = $1";
5078 #prospect ordered active inactive suspended cancelled
5079 if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5080 my $method = $params->{'status'}. '_sql';
5081 #push @where, $class->$method();
5082 push @where, FS::cust_main->$method();
5086 # parse cancelled package checkbox
5091 $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5092 unless $params->{'cancelled_pkgs'};
5095 # parse without census tract checkbox
5098 push @where, "(censustract = '' or censustract is null)"
5099 if $params->{'no_censustract'};
5105 foreach my $field (qw( signupdate )) {
5107 next unless exists($params->{$field});
5109 my($beginning, $ending, $hour) = @{$params->{$field}};
5112 "cust_main.$field IS NOT NULL",
5113 "cust_main.$field >= $beginning",
5114 "cust_main.$field <= $ending";
5116 # XXX: do this for mysql and/or pull it out of here
5118 if ($dbh->{Driver}->{Name} eq 'Pg') {
5119 push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour";
5122 warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases";
5126 $orderby ||= "ORDER BY cust_main.$field";
5134 if ( $params->{'classnum'} ) {
5136 my @classnum = ref( $params->{'classnum'} )
5137 ? @{ $params->{'classnum'} }
5138 : ( $params->{'classnum'} );
5140 @classnum = grep /^(\d*)$/, @classnum;
5143 push @where, '( '. join(' OR ', map {
5144 $_ ? "cust_main.classnum = $_"
5145 : "cust_main.classnum IS NULL"
5158 if ( $params->{'payby'} ) {
5160 my @payby = ref( $params->{'payby'} )
5161 ? @{ $params->{'payby'} }
5162 : ( $params->{'payby'} );
5164 @payby = grep /^([A-Z]{4})$/, @payby;
5166 push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
5172 # paydate_year / paydate_month
5175 if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
5177 $params->{'paydate_month'} =~ /^(\d\d?)$/
5178 or die "paydate_year without paydate_month?";
5182 'paydate IS NOT NULL',
5184 "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
5192 if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
5194 if ( $1 eq 'NULL' ) {
5196 "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
5199 "cust_main.invoice_terms IS NOT NULL",
5200 "cust_main.invoice_terms = '$1'";
5208 if ( $params->{'current_balance'} ) {
5210 #my $balance_sql = $class->balance_sql();
5211 my $balance_sql = FS::cust_main->balance_sql();
5213 my @current_balance =
5214 ref( $params->{'current_balance'} )
5215 ? @{ $params->{'current_balance'} }
5216 : ( $params->{'current_balance'} );
5218 push @where, map { s/current_balance/$balance_sql/; $_ }
5227 if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
5229 "cust_main.custbatch = '$1'";
5233 # setup queries, subs, etc. for the search
5236 $orderby ||= 'ORDER BY custnum';
5238 # here is the agent virtualization
5239 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
5241 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5243 my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum ) ';
5245 my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
5247 my $select = join(', ',
5248 'cust_main.custnum',
5249 FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
5252 my(@extra_headers) = ();
5253 my(@extra_fields) = ();
5255 if ($params->{'flattened_pkgs'}) {
5257 if ($dbh->{Driver}->{Name} eq 'Pg') {
5259 $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";
5261 }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
5262 $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
5263 $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
5265 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
5266 "omitting packing information from report.";
5269 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";
5271 my $sth = dbh->prepare($header_query) or die dbh->errstr;
5272 $sth->execute() or die $sth->errstr;
5273 my $headerrow = $sth->fetchrow_arrayref;
5274 my $headercount = $headerrow ? $headerrow->[0] : 0;
5275 while($headercount) {
5276 unshift @extra_headers, "Package ". $headercount;
5277 unshift @extra_fields, eval q!sub {my $c = shift;
5278 my @a = split '\|', $c->magic;
5279 my $p = $a[!.--$headercount. q!];
5287 'table' => 'cust_main',
5288 'select' => $select,
5290 'extra_sql' => $extra_sql,
5291 'order_by' => $orderby,
5292 'count_query' => $count_query,
5293 'extra_headers' => \@extra_headers,
5294 'extra_fields' => \@extra_fields,
5299 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
5301 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
5302 records. Currently, I<first>, I<last>, I<company> and/or I<address1> may be
5303 specified (the appropriate ship_ field is also searched).
5305 Additional options are the same as FS::Record::qsearch
5310 my( $self, $fuzzy, $hash, @opt) = @_;
5315 check_and_rebuild_fuzzyfiles();
5316 foreach my $field ( keys %$fuzzy ) {
5318 my $all = $self->all_X($field);
5319 next unless scalar(@$all);
5322 $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
5325 foreach ( keys %match ) {
5326 push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
5327 push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
5330 push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
5333 # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
5335 @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
5343 Returns a masked version of the named field
5348 my ($self,$field) = @_;
5352 'x'x(length($self->getfield($field))-4).
5353 substr($self->getfield($field), (length($self->getfield($field))-4));
5363 =item smart_search OPTION => VALUE ...
5365 Accepts the following options: I<search>, the string to search for. The string
5366 will be searched for as a customer number, phone number, name or company name,
5367 as an exact, or, in some cases, a substring or fuzzy match (see the source code
5368 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
5369 skip fuzzy matching when an exact match is found.
5371 Any additional options are treated as an additional qualifier on the search
5374 Returns a (possibly empty) array of FS::cust_main objects.
5381 #here is the agent virtualization
5382 my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5386 my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
5387 my $search = delete $options{'search'};
5388 ( my $alphanum_search = $search ) =~ s/\W//g;
5390 if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
5392 #false laziness w/Record::ut_phone
5393 my $phonen = "$1-$2-$3";
5394 $phonen .= " x$4" if $4;
5396 push @cust_main, qsearch( {
5397 'table' => 'cust_main',
5398 'hashref' => { %options },
5399 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5401 join(' OR ', map "$_ = '$phonen'",
5402 qw( daytime night fax
5403 ship_daytime ship_night ship_fax )
5406 " AND $agentnums_sql", #agent virtualization
5409 unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
5410 #try looking for matches with extensions unless one was specified
5412 push @cust_main, qsearch( {
5413 'table' => 'cust_main',
5414 'hashref' => { %options },
5415 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5417 join(' OR ', map "$_ LIKE '$phonen\%'",
5419 ship_daytime ship_night )
5422 " AND $agentnums_sql", #agent virtualization
5427 # custnum search (also try agent_custid), with some tweaking options if your
5428 # legacy cust "numbers" have letters
5431 if ( $search =~ /^\s*(\d+)\s*$/
5432 || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
5433 && $search =~ /^\s*(\w\w?\d+)\s*$/
5435 || ( $conf->exists('address1-search' )
5436 && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
5443 if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
5444 push @cust_main, qsearch( {
5445 'table' => 'cust_main',
5446 'hashref' => { 'custnum' => $num, %options },
5447 'extra_sql' => " AND $agentnums_sql", #agent virtualization
5451 push @cust_main, qsearch( {
5452 'table' => 'cust_main',
5453 'hashref' => { 'agent_custid' => $num, %options },
5454 'extra_sql' => " AND $agentnums_sql", #agent virtualization
5457 if ( $conf->exists('address1-search') ) {
5458 my $len = length($num);
5460 foreach my $prefix ( '', 'ship_' ) {
5461 push @cust_main, qsearch( {
5462 'table' => 'cust_main',
5463 'hashref' => { %options, },
5465 ( keys(%options) ? ' AND ' : ' WHERE ' ).
5466 " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
5467 " AND $agentnums_sql",
5472 } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
5474 my($company, $last, $first) = ( $1, $2, $3 );
5476 # "Company (Last, First)"
5477 #this is probably something a browser remembered,
5478 #so just do an exact search (but case-insensitive, so USPS standardization
5479 #doesn't throw a wrench in the works)
5481 foreach my $prefix ( '', 'ship_' ) {
5482 push @cust_main, qsearch( {
5483 'table' => 'cust_main',
5484 'hashref' => { %options },
5486 ( keys(%options) ? ' AND ' : ' WHERE ' ).
5488 " LOWER(${prefix}first) = ". dbh->quote(lc($first)),
5489 " LOWER(${prefix}last) = ". dbh->quote(lc($last)),
5490 " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
5496 } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
5497 # try (ship_){last,company}
5501 # # remove "(Last, First)" in "Company (Last, First)", otherwise the
5502 # # full strings the browser remembers won't work
5503 # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
5505 use Lingua::EN::NameParse;
5506 my $NameParse = new Lingua::EN::NameParse(
5508 allow_reversed => 1,
5511 my($last, $first) = ( '', '' );
5512 #maybe disable this too and just rely on NameParse?
5513 if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
5515 ($last, $first) = ( $1, $2 );
5517 #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) {
5518 } elsif ( ! $NameParse->parse($value) ) {
5520 my %name = $NameParse->components;
5521 $first = $name{'given_name_1'};
5522 $last = $name{'surname_1'};
5526 if ( $first && $last ) {
5528 my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
5531 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
5533 ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
5534 OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
5537 push @cust_main, qsearch( {
5538 'table' => 'cust_main',
5539 'hashref' => \%options,
5540 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
5543 # or it just be something that was typed in... (try that in a sec)
5547 my $q_value = dbh->quote($value);
5550 my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
5551 $sql .= " ( LOWER(last) = $q_value
5552 OR LOWER(company) = $q_value
5553 OR LOWER(ship_last) = $q_value
5554 OR LOWER(ship_company) = $q_value
5556 $sql .= " OR LOWER(address1) = $q_value
5557 OR LOWER(ship_address1) = $q_value
5559 if $conf->exists('address1-search');
5562 push @cust_main, qsearch( {
5563 'table' => 'cust_main',
5564 'hashref' => \%options,
5565 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
5568 #no exact match, trying substring/fuzzy
5569 #always do substring & fuzzy (unless they're explicity config'ed off)
5570 #getting complaints searches are not returning enough
5571 unless ( @cust_main && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
5573 #still some false laziness w/search (was search/cust_main.cgi)
5578 { 'company' => { op=>'ILIKE', value=>"%$value%" }, },
5579 { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
5582 if ( $first && $last ) {
5585 { 'first' => { op=>'ILIKE', value=>"%$first%" },
5586 'last' => { op=>'ILIKE', value=>"%$last%" },
5588 { 'ship_first' => { op=>'ILIKE', value=>"%$first%" },
5589 'ship_last' => { op=>'ILIKE', value=>"%$last%" },
5596 { 'last' => { op=>'ILIKE', value=>"%$value%" }, },
5597 { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, },
5601 if ( $conf->exists('address1-search') ) {
5603 { 'address1' => { op=>'ILIKE', value=>"%$value%" }, },
5604 { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
5608 foreach my $hashref ( @hashrefs ) {
5610 push @cust_main, qsearch( {
5611 'table' => 'cust_main',
5612 'hashref' => { %$hashref,
5615 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
5624 " AND $agentnums_sql", #extra_sql #agent virtualization
5627 if ( $first && $last ) {
5628 push @cust_main, FS::cust_main->fuzzy_search(
5629 { 'last' => $last, #fuzzy hashref
5630 'first' => $first }, #
5634 foreach my $field ( 'last', 'company' ) {
5636 FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
5638 if ( $conf->exists('address1-search') ) {
5640 FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
5647 #eliminate duplicates
5649 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
5657 Accepts the following options: I<email>, the email address to search for. The
5658 email address will be searched for as an email invoice destination and as an
5661 #Any additional options are treated as an additional qualifier on the search
5662 #(i.e. I<agentnum>).
5664 Returns a (possibly empty) array of FS::cust_main objects (but usually just
5674 my $email = delete $options{'email'};
5676 #we're only being used by RT at the moment... no agent virtualization yet
5677 #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5681 if ( $email =~ /([^@]+)\@([^@]+)/ ) {
5683 my ( $user, $domain ) = ( $1, $2 );
5685 warn "$me smart_search: searching for $user in domain $domain"
5691 'table' => 'cust_main_invoice',
5692 'hashref' => { 'dest' => $email },
5699 map $_->cust_svc->cust_pkg,
5701 'table' => 'svc_acct',
5702 'hashref' => { 'username' => $user, },
5704 'AND ( SELECT domain FROM svc_domain
5705 WHERE svc_acct.domsvc = svc_domain.svcnum
5706 ) = '. dbh->quote($domain),
5712 @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
5714 warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
5721 =item check_and_rebuild_fuzzyfiles
5725 sub check_and_rebuild_fuzzyfiles {
5726 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5727 rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
5730 =item rebuild_fuzzyfiles
5734 sub rebuild_fuzzyfiles {
5736 use Fcntl qw(:flock);
5738 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5739 mkdir $dir, 0700 unless -d $dir;
5741 foreach my $fuzzy ( @fuzzyfields ) {
5743 open(LOCK,">>$dir/cust_main.$fuzzy")
5744 or die "can't open $dir/cust_main.$fuzzy: $!";
5746 or die "can't lock $dir/cust_main.$fuzzy: $!";
5748 open (CACHE,">$dir/cust_main.$fuzzy.tmp")
5749 or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
5751 foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
5752 my $sth = dbh->prepare("SELECT $field FROM cust_main".
5753 " WHERE $field != '' AND $field IS NOT NULL");
5754 $sth->execute or die $sth->errstr;
5756 while ( my $row = $sth->fetchrow_arrayref ) {
5757 print CACHE $row->[0]. "\n";
5762 close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
5764 rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
5775 my( $self, $field ) = @_;
5776 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5777 open(CACHE,"<$dir/cust_main.$field")
5778 or die "can't open $dir/cust_main.$field: $!";
5779 my @array = map { chomp; $_; } <CACHE>;
5784 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
5788 sub append_fuzzyfiles {
5789 #my( $first, $last, $company ) = @_;
5791 &check_and_rebuild_fuzzyfiles;
5793 use Fcntl qw(:flock);
5795 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5797 foreach my $field (@fuzzyfields) {
5802 open(CACHE,">>$dir/cust_main.$field")
5803 or die "can't open $dir/cust_main.$field: $!";
5804 flock(CACHE,LOCK_EX)
5805 or die "can't lock $dir/cust_main.$field: $!";
5807 print CACHE "$value\n";
5809 flock(CACHE,LOCK_UN)
5810 or die "can't unlock $dir/cust_main.$field: $!";
5825 #warn join('-',keys %$param);
5826 my $fh = $param->{filehandle};
5827 my $agentnum = $param->{agentnum};
5828 my $format = $param->{format};
5830 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
5833 if ( $format eq 'simple' ) {
5834 @fields = qw( custnum agent_custid amount pkg );
5836 die "unknown format $format";
5839 eval "use Text::CSV_XS;";
5842 my $csv = new Text::CSV_XS;
5849 local $SIG{HUP} = 'IGNORE';
5850 local $SIG{INT} = 'IGNORE';
5851 local $SIG{QUIT} = 'IGNORE';
5852 local $SIG{TERM} = 'IGNORE';
5853 local $SIG{TSTP} = 'IGNORE';
5854 local $SIG{PIPE} = 'IGNORE';
5856 my $oldAutoCommit = $FS::UID::AutoCommit;
5857 local $FS::UID::AutoCommit = 0;
5860 #while ( $columns = $csv->getline($fh) ) {
5862 while ( defined($line=<$fh>) ) {
5864 $csv->parse($line) or do {
5865 $dbh->rollback if $oldAutoCommit;
5866 return "can't parse: ". $csv->error_input();
5869 my @columns = $csv->fields();
5870 #warn join('-',@columns);
5873 foreach my $field ( @fields ) {
5874 $row{$field} = shift @columns;
5877 if ( $row{custnum} && $row{agent_custid} ) {
5878 dbh->rollback if $oldAutoCommit;
5879 return "can't specify custnum with agent_custid $row{agent_custid}";
5883 if ( $row{agent_custid} && $agentnum ) {
5884 %hash = ( 'agent_custid' => $row{agent_custid},
5885 'agentnum' => $agentnum,
5889 if ( $row{custnum} ) {
5890 %hash = ( 'custnum' => $row{custnum} );
5893 unless ( scalar(keys %hash) ) {
5894 $dbh->rollback if $oldAutoCommit;
5895 return "can't find customer without custnum or agent_custid and agentnum";
5898 my $cust_main = qsearchs('cust_main', { %hash } );
5899 unless ( $cust_main ) {
5900 $dbh->rollback if $oldAutoCommit;
5901 my $custnum = $row{custnum} || $row{agent_custid};
5902 return "unknown custnum $custnum";
5905 if ( $row{'amount'} > 0 ) {
5906 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5908 $dbh->rollback if $oldAutoCommit;
5912 } elsif ( $row{'amount'} < 0 ) {
5913 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5916 $dbh->rollback if $oldAutoCommit;
5926 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5928 return "Empty file!" unless $imported;
5934 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5936 Deprecated. Use event notification and message templates
5937 (L<FS::msg_template>) instead.
5939 Sends a templated email notification to the customer (see L<Text::Template>).
5941 OPTIONS is a hash and may include
5943 I<from> - the email sender (default is invoice_from)
5945 I<to> - comma-separated scalar or arrayref of recipients
5946 (default is invoicing_list)
5948 I<subject> - The subject line of the sent email notification
5949 (default is "Notice from company_name")
5951 I<extra_fields> - a hashref of name/value pairs which will be substituted
5954 The following variables are vavailable in the template.
5956 I<$first> - the customer first name
5957 I<$last> - the customer last name
5958 I<$company> - the customer company
5959 I<$payby> - a description of the method of payment for the customer
5960 # would be nice to use FS::payby::shortname
5961 I<$payinfo> - the account information used to collect for this customer
5962 I<$expdate> - the expiration of the customer payment in seconds from epoch
5967 my ($self, $template, %options) = @_;
5969 return unless $conf->exists($template);
5971 my $from = $conf->config('invoice_from', $self->agentnum)
5972 if $conf->exists('invoice_from', $self->agentnum);
5973 $from = $options{from} if exists($options{from});
5975 my $to = join(',', $self->invoicing_list_emailonly);
5976 $to = $options{to} if exists($options{to});
5978 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5979 if $conf->exists('company_name', $self->agentnum);
5980 $subject = $options{subject} if exists($options{subject});
5982 my $notify_template = new Text::Template (TYPE => 'ARRAY',
5983 SOURCE => [ map "$_\n",
5984 $conf->config($template)]
5986 or die "can't create new Text::Template object: Text::Template::ERROR";
5987 $notify_template->compile()
5988 or die "can't compile template: Text::Template::ERROR";
5990 $FS::notify_template::_template::company_name =
5991 $conf->config('company_name', $self->agentnum);
5992 $FS::notify_template::_template::company_address =
5993 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5995 my $paydate = $self->paydate || '2037-12-31';
5996 $FS::notify_template::_template::first = $self->first;
5997 $FS::notify_template::_template::last = $self->last;
5998 $FS::notify_template::_template::company = $self->company;
5999 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
6000 my $payby = $self->payby;
6001 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6002 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6004 #credit cards expire at the end of the month/year of their exp date
6005 if ($payby eq 'CARD' || $payby eq 'DCRD') {
6006 $FS::notify_template::_template::payby = 'credit card';
6007 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6008 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6010 }elsif ($payby eq 'COMP') {
6011 $FS::notify_template::_template::payby = 'complimentary account';
6013 $FS::notify_template::_template::payby = 'current method';
6015 $FS::notify_template::_template::expdate = $expire_time;
6017 for (keys %{$options{extra_fields}}){
6019 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6022 send_email(from => $from,
6024 subject => $subject,
6025 body => $notify_template->fill_in( PACKAGE =>
6026 'FS::notify_template::_template' ),
6031 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6033 Generates a templated notification to the customer (see L<Text::Template>).
6035 OPTIONS is a hash and may include
6037 I<extra_fields> - a hashref of name/value pairs which will be substituted
6038 into the template. These values may override values mentioned below
6039 and those from the customer record.
6041 The following variables are available in the template instead of or in addition
6042 to the fields of the customer record.
6044 I<$payby> - a description of the method of payment for the customer
6045 # would be nice to use FS::payby::shortname
6046 I<$payinfo> - the masked account information used to collect for this customer
6047 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6048 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6052 # a lot like cust_bill::print_latex
6053 sub generate_letter {
6054 my ($self, $template, %options) = @_;
6056 return unless $conf->exists($template);
6058 my $letter_template = new Text::Template
6060 SOURCE => [ map "$_\n", $conf->config($template)],
6061 DELIMITERS => [ '[@--', '--@]' ],
6063 or die "can't create new Text::Template object: Text::Template::ERROR";
6065 $letter_template->compile()
6066 or die "can't compile template: Text::Template::ERROR";
6068 my %letter_data = map { $_ => $self->$_ } $self->fields;
6069 $letter_data{payinfo} = $self->mask_payinfo;
6071 #my $paydate = $self->paydate || '2037-12-31';
6072 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6074 my $payby = $self->payby;
6075 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6076 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6078 #credit cards expire at the end of the month/year of their exp date
6079 if ($payby eq 'CARD' || $payby eq 'DCRD') {
6080 $letter_data{payby} = 'credit card';
6081 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6082 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6084 }elsif ($payby eq 'COMP') {
6085 $letter_data{payby} = 'complimentary account';
6087 $letter_data{payby} = 'current method';
6089 $letter_data{expdate} = $expire_time;
6091 for (keys %{$options{extra_fields}}){
6092 $letter_data{$_} = $options{extra_fields}->{$_};
6095 unless(exists($letter_data{returnaddress})){
6096 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6097 $self->agent_template)
6099 if ( length($retadd) ) {
6100 $letter_data{returnaddress} = $retadd;
6101 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
6102 $letter_data{returnaddress} =
6103 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
6107 ( $conf->config('company_name', $self->agentnum),
6108 $conf->config('company_address', $self->agentnum),
6112 $letter_data{returnaddress} = '~';
6116 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6118 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
6120 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
6122 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6126 ) or die "can't open temp file: $!\n";
6127 print $lh $conf->config_binary('logo.eps', $self->agentnum)
6128 or die "can't write temp file: $!\n";
6130 $letter_data{'logo_file'} = $lh->filename;
6132 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6136 ) or die "can't open temp file: $!\n";
6138 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6140 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6141 return ($1, $letter_data{'logo_file'});
6145 =item print_ps TEMPLATE
6147 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6153 my($file, $lfile) = $self->generate_letter(@_);
6154 my $ps = FS::Misc::generate_ps($file);
6155 unlink($file.'.tex');
6161 =item print TEMPLATE
6163 Prints the filled in template.
6165 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6169 sub queueable_print {
6172 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6173 or die "invalid customer number: " . $opt{custvnum};
6175 my $error = $self->print( $opt{template} );
6176 die $error if $error;
6180 my ($self, $template) = (shift, shift);
6181 do_print [ $self->print_ps($template) ];
6184 #these three subs should just go away once agent stuff is all config overrides
6186 sub agent_template {
6188 $self->_agent_plandata('agent_templatename');
6191 sub agent_invoice_from {
6193 $self->_agent_plandata('agent_invoice_from');
6196 sub _agent_plandata {
6197 my( $self, $option ) = @_;
6199 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
6200 #agent-specific Conf
6202 use FS::part_event::Condition;
6204 my $agentnum = $self->agentnum;
6206 my $regexp = regexp_sql();
6208 my $part_event_option =
6210 'select' => 'part_event_option.*',
6211 'table' => 'part_event_option',
6213 LEFT JOIN part_event USING ( eventpart )
6214 LEFT JOIN part_event_option AS peo_agentnum
6215 ON ( part_event.eventpart = peo_agentnum.eventpart
6216 AND peo_agentnum.optionname = 'agentnum'
6217 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
6219 LEFT JOIN part_event_condition
6220 ON ( part_event.eventpart = part_event_condition.eventpart
6221 AND part_event_condition.conditionname = 'cust_bill_age'
6223 LEFT JOIN part_event_condition_option
6224 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
6225 AND part_event_condition_option.optionname = 'age'
6228 #'hashref' => { 'optionname' => $option },
6229 #'hashref' => { 'part_event_option.optionname' => $option },
6231 " WHERE part_event_option.optionname = ". dbh->quote($option).
6232 " AND action = 'cust_bill_send_agent' ".
6233 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
6234 " AND peo_agentnum.optionname = 'agentnum' ".
6235 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
6237 CASE WHEN part_event_condition_option.optionname IS NULL
6239 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
6241 , part_event.weight".
6245 unless ( $part_event_option ) {
6246 return $self->agent->invoice_template || ''
6247 if $option eq 'agent_templatename';
6251 $part_event_option->optionvalue;
6255 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
6257 Subroutine (not a method), designed to be called from the queue.
6259 Takes a list of options and values.
6261 Pulls up the customer record via the custnum option and calls bill_and_collect.
6266 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
6268 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
6269 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
6271 $cust_main->bill_and_collect( %args );
6274 sub process_bill_and_collect {
6276 my $param = thaw(decode_base64(shift));
6277 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
6278 or die "custnum '$param->{custnum}' not found!\n";
6279 $param->{'job'} = $job;
6280 $param->{'fatal'} = 1; # runs from job queue, will be caught
6281 $param->{'retry'} = 1;
6283 $cust_main->bill_and_collect( %$param );
6286 sub _upgrade_data { #class method
6287 my ($class, %opts) = @_;
6289 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
6290 my $sth = dbh->prepare($sql) or die dbh->errstr;
6291 $sth->execute or die $sth->errstr;
6293 local($ignore_expired_card) = 1;
6294 local($skip_fuzzyfiles) = 1;
6295 $class->_upgrade_otaker(%opts);
6305 The delete method should possibly take an FS::cust_main object reference
6306 instead of a scalar customer number.
6308 Bill and collect options should probably be passed as references instead of a
6311 There should probably be a configuration file with a list of allowed credit
6314 No multiple currency support (probably a larger project than just this module).
6316 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
6318 Birthdates rely on negative epoch values.
6320 The payby for card/check batches is broken. With mixed batching, bad
6323 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
6327 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
6328 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
6329 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.