2 use base qw( FS::cust_main::Packages
4 FS::cust_main::NationalID
6 FS::cust_main::Billing_Realtime
7 FS::cust_main::Billing_Batch
8 FS::cust_main::Billing_Discount
9 FS::cust_main::Billing_ThirdParty
10 FS::cust_main::Location
11 FS::cust_main::Credit_Limit
14 FS::otaker_Mixin FS::cust_main_Mixin
15 FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
24 use Scalar::Util qw( blessed );
25 use List::Util qw(min);
27 use File::Temp; #qw( tempfile );
29 use Time::Local qw(timelocal);
33 use Business::CreditCard 0.28;
34 use FS::UID qw( dbh driver_name );
35 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
37 use FS::Misc qw( generate_ps do_print money_pretty card_types );
38 use FS::Msgcat qw(gettext);
45 use FS::cust_bill_void;
46 use FS::legacy_cust_bill;
48 use FS::cust_pay_pending;
49 use FS::cust_pay_void;
50 use FS::cust_pay_batch;
53 use FS::part_referral;
54 use FS::cust_main_county;
55 use FS::cust_location;
58 use FS::cust_main_exemption;
59 use FS::cust_tax_adjustment;
60 use FS::cust_tax_location;
61 use FS::agent_currency;
62 use FS::cust_main_invoice;
64 use FS::prepay_credit;
70 use FS::payment_gateway;
71 use FS::agent_payment_gateway;
73 use FS::cust_main_note;
74 use FS::cust_attachment;
77 use FS::upgrade_journal;
82 use FS::Misc::Savepoint;
84 # 1 is mostly method/subroutine entry and options
85 # 2 traces progress of some operations
86 # 3 is even more information including possibly sensitive data
88 our $me = '[FS::cust_main]';
91 our $ignore_expired_card = 0;
92 our $ignore_banned_card = 0;
93 our $ignore_invalid_card = 0;
95 our $skip_fuzzyfiles = 0;
97 our $ucfirst_nowarn = 0;
99 #this info is in cust_payby as of 4.x
100 #this and the fields themselves can be removed in 5.x
101 our @encrypted_fields = ('payinfo', 'paycvv');
102 sub nohistory_fields { ('payinfo', 'paycvv'); }
105 our $default_agent_custid;
106 our $custnum_display_length;
107 #ask FS::UID to run this stuff for us later
108 #$FS::UID::callback{'FS::cust_main'} = sub {
109 install_callback FS::UID sub {
110 $conf = new FS::Conf;
111 $ignore_invalid_card = $conf->exists('allow_invalid_cards');
112 $default_agent_custid = $conf->exists('cust_main-default_agent_custid');
113 $custnum_display_length = $conf->config('cust_main-custnum-display_length');
118 my ( $hashref, $cache ) = @_;
119 if ( exists $hashref->{'pkgnum'} ) {
120 #@{ $self->{'_pkgnum'} } = ();
121 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
122 $self->{'_pkgnum'} = $subcache;
123 #push @{ $self->{'_pkgnum'} },
124 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
130 FS::cust_main - Object methods for cust_main records
136 $record = new FS::cust_main \%hash;
137 $record = new FS::cust_main { 'column' => 'value' };
139 $error = $record->insert;
141 $error = $new_record->replace($old_record);
143 $error = $record->delete;
145 $error = $record->check;
147 @cust_pkg = $record->all_pkgs;
149 @cust_pkg = $record->ncancelled_pkgs;
151 @cust_pkg = $record->suspended_pkgs;
153 $error = $record->bill;
154 $error = $record->bill %options;
155 $error = $record->bill 'time' => $time;
157 $error = $record->collect;
158 $error = $record->collect %options;
159 $error = $record->collect 'invoice_time' => $time,
164 An FS::cust_main object represents a customer. FS::cust_main inherits from
165 FS::Record. The following fields are currently supported:
171 Primary key (assigned automatically for new customers)
175 Agent (see L<FS::agent>)
179 Advertising source (see L<FS::part_referral>)
191 Cocial security number (optional)
215 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
219 Payment Information (See L<FS::payinfo_Mixin> for data format)
223 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
227 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
231 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
235 Start date month (maestro/solo cards only)
239 Start date year (maestro/solo cards only)
243 Issue number (maestro/solo cards only)
247 Name on card or billing name
251 IP address from which payment information was received
255 Tax exempt, empty or `Y'
259 Order taker (see L<FS::access_user>)
265 =item referral_custnum
267 Referring customer number
271 Enable individual CDR spooling, empty or `Y'
275 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
279 Discourage individual CDR printing, empty or `Y'
283 Allow self-service editing of ticket subjects, empty or 'Y'
285 =item calling_list_exempt
287 Do not call, empty or 'Y'
289 =item invoice_ship_address
291 Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
301 Creates a new customer. To add the customer to the database, see L<"insert">.
303 Note that this stores the hash reference, not a distinct copy of the hash it
304 points to. You can ask the object for a copy with the I<hash> method.
308 sub table { 'cust_main'; }
310 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
312 Adds this customer to the database. If there is an error, returns the error,
313 otherwise returns false.
315 Usually the customer's location will not yet exist in the database, and
316 the C<bill_location> and C<ship_location> pseudo-fields must be set to
317 uninserted L<FS::cust_location> objects. These will be inserted and linked
318 (in both directions) to the new customer record. If they're references
319 to the same object, they will become the same location.
321 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
322 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
323 are inserted atomicly, or the transaction is rolled back. Passing an empty
324 hash reference is equivalent to not supplying this parameter. There should be
325 a better explanation of this, but until then, here's an example:
328 tie %hash, 'Tie::RefHash'; #this part is important
330 $cust_pkg => [ $svc_acct ],
333 $cust_main->insert( \%hash );
335 INVOICING_LIST_ARYREF: No longer supported.
337 Currently available options are: I<depend_jobnum>, I<noexport>,
338 I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
340 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
341 on the supplied jobnum (they will not run until the specific job completes).
342 This can be used to defer provisioning until some action completes (such
343 as running the customer's credit card successfully).
345 The I<noexport> option is deprecated. If I<noexport> is set true, no
346 provisioning jobs (exports) are scheduled. (You can schedule them later with
347 the B<reexport> method.)
349 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
350 of tax names and exemption numbers. FS::cust_main_exemption records will be
351 created and inserted.
353 If I<prospectnum> is set, moves contacts and locations from that prospect.
355 If I<contact> is set to an arrayref of FS::contact objects, those will be
358 If I<contact_params> is set to a hashref of CGI parameters (and I<contact> is
359 unset), inserts those new contacts with this new customer. Handles CGI
360 paramaters for an "m2" multiple entry field as passed by edit/cust_main.cgi
362 If I<cust_payby_params> is set to a hashref o fCGI parameters, inserts those
363 new stored payment records with this new customer. Handles CGI parameters
364 for an "m2" multiple entry field as passed by edit/cust_main.cgi
370 my $cust_pkgs = @_ ? shift : {};
372 if ( $_[0] and ref($_[0]) eq 'ARRAY' ) {
373 warn "cust_main::insert using deprecated invoicing list argument";
374 $invoicing_list = shift;
377 warn "$me insert called with options ".
378 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
381 return "You are not permitted to change customer invoicing terms."
382 if $self->invoice_terms #i.e. not the default
383 && ! $FS::CurrentUser::CurrentUser->access_right('Edit customer invoice terms');
385 local $SIG{HUP} = 'IGNORE';
386 local $SIG{INT} = 'IGNORE';
387 local $SIG{QUIT} = 'IGNORE';
388 local $SIG{TERM} = 'IGNORE';
389 local $SIG{TSTP} = 'IGNORE';
390 local $SIG{PIPE} = 'IGNORE';
392 my $oldAutoCommit = $FS::UID::AutoCommit;
393 local $FS::UID::AutoCommit = 0;
396 my $prepay_identifier = '';
397 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
399 if ( $self->payby eq 'PREPAY' ) {
401 $self->payby(''); #'BILL');
402 $prepay_identifier = $self->payinfo;
405 warn " looking up prepaid card $prepay_identifier\n"
408 my $error = $self->get_prepay( $prepay_identifier,
409 'amount_ref' => \$amount,
410 'seconds_ref' => \$seconds,
411 'upbytes_ref' => \$upbytes,
412 'downbytes_ref' => \$downbytes,
413 'totalbytes_ref' => \$totalbytes,
416 $dbh->rollback if $oldAutoCommit;
417 #return "error applying prepaid card (transaction rolled back): $error";
421 $payby = 'PREP' if $amount;
423 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
426 $self->payby(''); #'BILL');
427 $amount = $self->paid;
432 foreach my $l (qw(bill_location ship_location)) {
434 my $loc = delete $self->hashref->{$l} or next;
436 if ( !$loc->locationnum ) {
437 # warn the location that we're going to insert it with no custnum
438 $loc->set(custnum_pending => 1);
439 warn " inserting $l\n"
441 my $error = $loc->insert;
443 $dbh->rollback if $oldAutoCommit;
444 my $label = $l eq 'ship_location' ? 'service' : 'billing';
445 return "$error (in $label location)";
448 } elsif ( $loc->prospectnum ) {
450 $loc->prospectnum('');
451 $loc->set(custnum_pending => 1);
452 my $error = $loc->replace;
454 $dbh->rollback if $oldAutoCommit;
455 my $label = $l eq 'ship_location' ? 'service' : 'billing';
456 return "$error (moving $label location)";
459 } elsif ( ($loc->custnum || 0) > 0 ) {
460 # then it somehow belongs to another customer--shouldn't happen
461 $dbh->rollback if $oldAutoCommit;
462 return "$l belongs to customer ".$loc->custnum;
464 # else it already belongs to this customer
465 # (happens when ship_location is identical to bill_location)
467 $self->set($l.'num', $loc->locationnum);
469 if ( $self->get($l.'num') eq '' ) {
470 $dbh->rollback if $oldAutoCommit;
475 warn " inserting $self\n"
478 $self->signupdate(time) unless $self->signupdate;
480 $self->auto_agent_custid()
481 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
483 my $error = $self->check_payinfo_cardtype
484 || $self->SUPER::insert;
486 $dbh->rollback if $oldAutoCommit;
487 #return "inserting cust_main record (transaction rolled back): $error";
491 # now set cust_location.custnum
492 foreach my $l (qw(bill_location ship_location)) {
493 warn " setting $l.custnum\n"
495 my $loc = $self->$l or next;
496 unless ( $loc->custnum ) {
497 $loc->set(custnum => $self->custnum);
498 $error ||= $loc->replace;
502 $dbh->rollback if $oldAutoCommit;
503 return "error setting $l custnum: $error";
507 warn " setting customer tags\n"
510 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
511 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
512 'custnum' => $self->custnum };
513 my $error = $cust_tag->insert;
515 $dbh->rollback if $oldAutoCommit;
520 my $prospectnum = delete $options{'prospectnum'};
521 if ( $prospectnum ) {
523 warn " moving contacts and locations from prospect $prospectnum\n"
527 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
528 unless ( $prospect_main ) {
529 $dbh->rollback if $oldAutoCommit;
530 return "Unknown prospectnum $prospectnum";
532 $prospect_main->custnum($self->custnum);
533 $prospect_main->disabled('Y');
534 my $error = $prospect_main->replace;
536 $dbh->rollback if $oldAutoCommit;
540 foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
541 my $cust_contact = new FS::cust_contact {
542 'custnum' => $self->custnum,
543 'invoice_dest' => 'Y', # invoice_dest currently not set for prospect contacts
544 map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
546 my $error = $cust_contact->insert
547 || $prospect_contact->delete;
549 $dbh->rollback if $oldAutoCommit;
554 my @cust_location = $prospect_main->cust_location;
555 my @qual = $prospect_main->qual;
557 foreach my $r ( @cust_location, @qual ) {
559 $r->custnum($self->custnum);
560 my $error = $r->replace;
562 $dbh->rollback if $oldAutoCommit;
566 # since we set invoice_dest on all migrated prospect contacts (for now),
567 # don't process invoicing_list.
568 delete $options{'invoicing_list'};
569 $invoicing_list = undef;
572 warn " setting contacts\n"
575 $invoicing_list ||= $options{'invoicing_list'};
576 if ( $invoicing_list ) {
578 $invoicing_list = [ $invoicing_list ] if !ref($invoicing_list);
581 foreach my $dest (@$invoicing_list ) {
582 if ($dest eq 'POST') {
583 $self->set('postal_invoice', 'Y');
586 my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
587 if ( $contact_email ) {
588 my $cust_contact = FS::cust_contact->new({
589 contactnum => $contact_email->contactnum,
590 custnum => $self->custnum,
592 $cust_contact->set('invoice_dest', 'Y');
593 my $error = $cust_contact->insert;
595 $dbh->rollback if $oldAutoCommit;
596 return "$error (linking to email address $dest)";
600 # this email address is not yet linked to any contact
601 $email .= ',' if length($email);
609 my $contact = FS::contact->new({
610 'custnum' => $self->get('custnum'),
611 'last' => $self->get('last'),
612 'first' => $self->get('first'),
613 'emailaddress' => $email,
614 'invoice_dest' => 'Y', # yes, you can set this via the contact
616 my $error = $contact->insert;
618 $dbh->rollback if $oldAutoCommit;
626 if ( my $contact = delete $options{'contact'} ) {
628 foreach my $c ( @$contact ) {
629 $c->custnum($self->custnum);
630 my $error = $c->insert;
632 $dbh->rollback if $oldAutoCommit;
638 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
640 my $error = $self->process_o2m( 'table' => 'contact',
641 'fields' => FS::contact->cgi_contact_fields,
642 'params' => $contact_params,
645 $dbh->rollback if $oldAutoCommit;
650 warn " setting cust_payby\n"
653 if ( $options{cust_payby} ) {
655 foreach my $cust_payby ( @{ $options{cust_payby} } ) {
656 $cust_payby->custnum($self->custnum);
657 my $error = $cust_payby->insert;
659 $dbh->rollback if $oldAutoCommit;
664 } elsif ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
666 my $error = $self->process_o2m(
667 'table' => 'cust_payby',
668 'fields' => FS::cust_payby->cgi_cust_payby_fields,
669 'params' => $cust_payby_params,
670 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
673 $dbh->rollback if $oldAutoCommit;
679 warn " setting cust_main_exemption\n"
682 my $tax_exemption = delete $options{'tax_exemption'};
683 if ( $tax_exemption ) {
685 $tax_exemption = { map { $_ => '' } @$tax_exemption }
686 if ref($tax_exemption) eq 'ARRAY';
688 foreach my $taxname ( keys %$tax_exemption ) {
689 my $cust_main_exemption = new FS::cust_main_exemption {
690 'custnum' => $self->custnum,
691 'taxname' => $taxname,
692 'exempt_number' => $tax_exemption->{$taxname},
694 my $error = $cust_main_exemption->insert;
696 $dbh->rollback if $oldAutoCommit;
697 return "inserting cust_main_exemption (transaction rolled back): $error";
702 warn " ordering packages\n"
705 $error = $self->order_pkgs( $cust_pkgs,
707 'seconds_ref' => \$seconds,
708 'upbytes_ref' => \$upbytes,
709 'downbytes_ref' => \$downbytes,
710 'totalbytes_ref' => \$totalbytes,
713 $dbh->rollback if $oldAutoCommit;
718 $dbh->rollback if $oldAutoCommit;
719 return "No svc_acct record to apply pre-paid time";
721 if ( $upbytes || $downbytes || $totalbytes ) {
722 $dbh->rollback if $oldAutoCommit;
723 return "No svc_acct record to apply pre-paid data";
727 warn " inserting initial $payby payment of $amount\n"
729 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
731 $dbh->rollback if $oldAutoCommit;
732 return "inserting payment (transaction rolled back): $error";
736 unless ( $import || $skip_fuzzyfiles ) {
737 warn " queueing fuzzyfiles update\n"
739 $error = $self->queue_fuzzyfiles_update;
741 $dbh->rollback if $oldAutoCommit;
742 return "updating fuzzy search cache: $error";
746 # FS::geocode_Mixin::after_insert or something?
747 if ( $conf->config('tax_district_method') and !$import ) {
748 # if anything non-empty, try to look it up
749 my $queue = new FS::queue {
750 'job' => 'FS::geocode_Mixin::process_district_update',
751 'custnum' => $self->custnum,
753 my $error = $queue->insert( ref($self), $self->custnum );
755 $dbh->rollback if $oldAutoCommit;
756 return "queueing tax district update: $error";
761 warn " exporting\n" if $DEBUG > 1;
763 my $export_args = $options{'export_args'} || [];
766 map qsearch( 'part_export', {exportnum=>$_} ),
767 $conf->config('cust_main-exports'); #, $agentnum
769 foreach my $part_export ( @part_export ) {
770 my $error = $part_export->export_insert($self, @$export_args);
772 $dbh->rollback if $oldAutoCommit;
773 return "exporting to ". $part_export->exporttype.
774 " (transaction rolled back): $error";
778 #foreach my $depend_jobnum ( @$depend_jobnums ) {
779 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
781 # foreach my $jobnum ( @jobnums ) {
782 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
783 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
785 # my $error = $queue->depend_insert($depend_jobnum);
787 # $dbh->rollback if $oldAutoCommit;
788 # return "error queuing job dependancy: $error";
795 #if ( exists $options{'jobnums'} ) {
796 # push @{ $options{'jobnums'} }, @jobnums;
799 warn " insert complete; committing transaction\n"
802 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
807 use File::CounterFile;
808 sub auto_agent_custid {
811 my $format = $conf->config('cust_main-auto_agent_custid');
813 if ( $format eq '1YMMXXXXXXXX' ) {
815 my $counter = new File::CounterFile 'cust_main.agent_custid';
818 my $ym = 100000000000 + time2str('%y%m00000000', time);
819 if ( $ym > $counter->value ) {
820 $counter->{'value'} = $agent_custid = $ym;
821 $counter->{'updated'} = 1;
823 $agent_custid = $counter->inc;
829 die "Unknown cust_main-auto_agent_custid format: $format";
832 $self->agent_custid($agent_custid);
836 =item PACKAGE METHODS
838 Documentation on customer package methods has been moved to
839 L<FS::cust_main::Packages>.
841 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
843 Recharges this (existing) customer with the specified prepaid card (see
844 L<FS::prepay_credit>), specified either by I<identifier> or as an
845 FS::prepay_credit object. If there is an error, returns the error, otherwise
848 Optionally, five scalar references can be passed as well. They will have their
849 values filled in with the amount, number of seconds, and number of upload,
850 download, and total bytes applied by this prepaid card.
854 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
855 #the only place that uses these args
856 sub recharge_prepay {
857 my( $self, $prepay_credit, $amountref, $secondsref,
858 $upbytesref, $downbytesref, $totalbytesref ) = @_;
860 local $SIG{HUP} = 'IGNORE';
861 local $SIG{INT} = 'IGNORE';
862 local $SIG{QUIT} = 'IGNORE';
863 local $SIG{TERM} = 'IGNORE';
864 local $SIG{TSTP} = 'IGNORE';
865 local $SIG{PIPE} = 'IGNORE';
867 my $oldAutoCommit = $FS::UID::AutoCommit;
868 local $FS::UID::AutoCommit = 0;
871 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
873 my $error = $self->get_prepay( $prepay_credit,
874 'amount_ref' => \$amount,
875 'seconds_ref' => \$seconds,
876 'upbytes_ref' => \$upbytes,
877 'downbytes_ref' => \$downbytes,
878 'totalbytes_ref' => \$totalbytes,
880 || $self->increment_seconds($seconds)
881 || $self->increment_upbytes($upbytes)
882 || $self->increment_downbytes($downbytes)
883 || $self->increment_totalbytes($totalbytes)
884 || $self->insert_cust_pay_prepay( $amount,
886 ? $prepay_credit->identifier
891 $dbh->rollback if $oldAutoCommit;
895 if ( defined($amountref) ) { $$amountref = $amount; }
896 if ( defined($secondsref) ) { $$secondsref = $seconds; }
897 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
898 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
899 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
901 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
906 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
908 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
909 specified either by I<identifier> or as an FS::prepay_credit object.
911 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
912 incremented by the values of the prepaid card.
914 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
915 check or set this customer's I<agentnum>.
917 If there is an error, returns the error, otherwise returns false.
923 my( $self, $prepay_credit, %opt ) = @_;
925 local $SIG{HUP} = 'IGNORE';
926 local $SIG{INT} = 'IGNORE';
927 local $SIG{QUIT} = 'IGNORE';
928 local $SIG{TERM} = 'IGNORE';
929 local $SIG{TSTP} = 'IGNORE';
930 local $SIG{PIPE} = 'IGNORE';
932 my $oldAutoCommit = $FS::UID::AutoCommit;
933 local $FS::UID::AutoCommit = 0;
936 unless ( ref($prepay_credit) ) {
938 my $identifier = $prepay_credit;
940 $prepay_credit = qsearchs(
942 { 'identifier' => $identifier },
947 unless ( $prepay_credit ) {
948 $dbh->rollback if $oldAutoCommit;
949 return "Invalid prepaid card: ". $identifier;
954 if ( $prepay_credit->agentnum ) {
955 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
956 $dbh->rollback if $oldAutoCommit;
957 return "prepaid card not valid for agent ". $self->agentnum;
959 $self->agentnum($prepay_credit->agentnum);
962 my $error = $prepay_credit->delete;
964 $dbh->rollback if $oldAutoCommit;
965 return "removing prepay_credit (transaction rolled back): $error";
968 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
969 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
971 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
976 =item increment_upbytes SECONDS
978 Updates this customer's single or primary account (see L<FS::svc_acct>) by
979 the specified number of upbytes. If there is an error, returns the error,
980 otherwise returns false.
984 sub increment_upbytes {
985 _increment_column( shift, 'upbytes', @_);
988 =item increment_downbytes SECONDS
990 Updates this customer's single or primary account (see L<FS::svc_acct>) by
991 the specified number of downbytes. If there is an error, returns the error,
992 otherwise returns false.
996 sub increment_downbytes {
997 _increment_column( shift, 'downbytes', @_);
1000 =item increment_totalbytes SECONDS
1002 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1003 the specified number of totalbytes. If there is an error, returns the error,
1004 otherwise returns false.
1008 sub increment_totalbytes {
1009 _increment_column( shift, 'totalbytes', @_);
1012 =item increment_seconds SECONDS
1014 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1015 the specified number of seconds. If there is an error, returns the error,
1016 otherwise returns false.
1020 sub increment_seconds {
1021 _increment_column( shift, 'seconds', @_);
1024 =item _increment_column AMOUNT
1026 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1027 the specified number of seconds or bytes. If there is an error, returns
1028 the error, otherwise returns false.
1032 sub _increment_column {
1033 my( $self, $column, $amount ) = @_;
1034 warn "$me increment_column called: $column, $amount\n"
1037 return '' unless $amount;
1039 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1040 $self->ncancelled_pkgs;
1042 if ( ! @cust_pkg ) {
1043 return 'No packages with primary or single services found'.
1044 ' to apply pre-paid time';
1045 } elsif ( scalar(@cust_pkg) > 1 ) {
1046 #maybe have a way to specify the package/account?
1047 return 'Multiple packages found to apply pre-paid time';
1050 my $cust_pkg = $cust_pkg[0];
1051 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1055 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1057 if ( ! @cust_svc ) {
1058 return 'No account found to apply pre-paid time';
1059 } elsif ( scalar(@cust_svc) > 1 ) {
1060 return 'Multiple accounts found to apply pre-paid time';
1063 my $svc_acct = $cust_svc[0]->svc_x;
1064 warn " found service svcnum ". $svc_acct->pkgnum.
1065 ' ('. $svc_acct->email. ")\n"
1068 $column = "increment_$column";
1069 $svc_acct->$column($amount);
1073 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1075 Inserts a prepayment in the specified amount for this customer. An optional
1076 second argument can specify the prepayment identifier for tracking purposes.
1077 If there is an error, returns the error, otherwise returns false.
1081 sub insert_cust_pay_prepay {
1082 shift->insert_cust_pay('PREP', @_);
1085 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1087 Inserts a cash payment in the specified amount for this customer. An optional
1088 second argument can specify the payment identifier for tracking purposes.
1089 If there is an error, returns the error, otherwise returns false.
1093 sub insert_cust_pay_cash {
1094 shift->insert_cust_pay('CASH', @_);
1097 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1099 Inserts a Western Union payment in the specified amount for this customer. An
1100 optional second argument can specify the prepayment identifier for tracking
1101 purposes. If there is an error, returns the error, otherwise returns false.
1105 sub insert_cust_pay_west {
1106 shift->insert_cust_pay('WEST', @_);
1109 sub insert_cust_pay {
1110 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1111 my $payinfo = scalar(@_) ? shift : '';
1113 my $cust_pay = new FS::cust_pay {
1114 'custnum' => $self->custnum,
1115 'paid' => sprintf('%.2f', $amount),
1116 #'_date' => #date the prepaid card was purchased???
1118 'payinfo' => $payinfo,
1124 =item delete [ OPTION => VALUE ... ]
1126 This deletes the customer. If there is an error, returns the error, otherwise
1129 This will completely remove all traces of the customer record. This is not
1130 what you want when a customer cancels service; for that, cancel all of the
1131 customer's packages (see L</cancel>).
1133 If the customer has any uncancelled packages, you need to pass a new (valid)
1134 customer number for those packages to be transferred to, as the "new_customer"
1135 option. Cancelled packages will be deleted. Did I mention that this is NOT
1136 what you want when a customer cancels service and that you really should be
1137 looking at L<FS::cust_pkg/cancel>?
1139 You can't delete a customer with invoices (see L<FS::cust_bill>),
1140 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1141 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1142 set the "delete_financials" option to a true value.
1147 my( $self, %opt ) = @_;
1149 local $SIG{HUP} = 'IGNORE';
1150 local $SIG{INT} = 'IGNORE';
1151 local $SIG{QUIT} = 'IGNORE';
1152 local $SIG{TERM} = 'IGNORE';
1153 local $SIG{TSTP} = 'IGNORE';
1154 local $SIG{PIPE} = 'IGNORE';
1156 my $oldAutoCommit = $FS::UID::AutoCommit;
1157 local $FS::UID::AutoCommit = 0;
1160 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1161 $dbh->rollback if $oldAutoCommit;
1162 return "Can't delete a master agent customer";
1165 #use FS::access_user
1166 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1167 $dbh->rollback if $oldAutoCommit;
1168 return "Can't delete a master employee customer";
1171 tie my %financial_tables, 'Tie::IxHash',
1172 'cust_bill' => 'invoices',
1173 'cust_statement' => 'statements',
1174 'cust_credit' => 'credits',
1175 'cust_pay' => 'payments',
1176 'cust_refund' => 'refunds',
1179 foreach my $table ( keys %financial_tables ) {
1181 my @records = $self->$table();
1183 if ( @records && ! $opt{'delete_financials'} ) {
1184 $dbh->rollback if $oldAutoCommit;
1185 return "Can't delete a customer with ". $financial_tables{$table};
1188 foreach my $record ( @records ) {
1189 my $error = $record->delete;
1191 $dbh->rollback if $oldAutoCommit;
1192 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1198 my @cust_pkg = $self->ncancelled_pkgs;
1200 my $new_custnum = $opt{'new_custnum'};
1201 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1202 $dbh->rollback if $oldAutoCommit;
1203 return "Invalid new customer number: $new_custnum";
1205 foreach my $cust_pkg ( @cust_pkg ) {
1206 my %hash = $cust_pkg->hash;
1207 $hash{'custnum'} = $new_custnum;
1208 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1209 my $error = $new_cust_pkg->replace($cust_pkg,
1210 options => { $cust_pkg->options },
1213 $dbh->rollback if $oldAutoCommit;
1218 my @cancelled_cust_pkg = $self->all_pkgs;
1219 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1220 my $error = $cust_pkg->delete;
1222 $dbh->rollback if $oldAutoCommit;
1227 #cust_tax_adjustment in financials?
1228 #cust_pay_pending? ouch
1229 foreach my $table (qw(
1230 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1231 cust_payby cust_location cust_main_note cust_tax_adjustment
1232 cust_pay_void cust_pay_batch queue cust_tax_exempt
1234 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1235 my $error = $record->delete;
1237 $dbh->rollback if $oldAutoCommit;
1243 my $sth = $dbh->prepare(
1244 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1246 my $errstr = $dbh->errstr;
1247 $dbh->rollback if $oldAutoCommit;
1250 $sth->execute($self->custnum) or do {
1251 my $errstr = $sth->errstr;
1252 $dbh->rollback if $oldAutoCommit;
1258 my $ticket_dbh = '';
1259 if ($conf->config('ticket_system') eq 'RT_Internal') {
1261 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1262 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1263 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1264 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1267 if ( $ticket_dbh ) {
1269 my $ticket_sth = $ticket_dbh->prepare(
1270 'DELETE FROM Links WHERE Target = ?'
1272 my $errstr = $ticket_dbh->errstr;
1273 $dbh->rollback if $oldAutoCommit;
1276 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1278 my $errstr = $ticket_sth->errstr;
1279 $dbh->rollback if $oldAutoCommit;
1283 #check and see if the customer is the only link on the ticket, and
1284 #if so, set the ticket to deleted status in RT?
1285 #maybe someday, for now this will at least fix tickets not displaying
1289 #delete the customer record
1291 my $error = $self->SUPER::delete;
1293 $dbh->rollback if $oldAutoCommit;
1297 # cust_main exports!
1299 #my $export_args = $options{'export_args'} || [];
1302 map qsearch( 'part_export', {exportnum=>$_} ),
1303 $conf->config('cust_main-exports'); #, $agentnum
1305 foreach my $part_export ( @part_export ) {
1306 my $error = $part_export->export_delete( $self ); #, @$export_args);
1308 $dbh->rollback if $oldAutoCommit;
1309 return "exporting to ". $part_export->exporttype.
1310 " (transaction rolled back): $error";
1314 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1319 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1321 Replaces the OLD_RECORD with this one in the database. If there is an error,
1322 returns the error, otherwise returns false.
1324 To change the customer's address, set the pseudo-fields C<bill_location> and
1325 C<ship_location>. The address will still only change if at least one of the
1326 address fields differs from the existing values.
1328 INVOICING_LIST_ARYREF: If you pass an arrayref to this method, it will be
1329 set as the contact email address for a default contact with the same name as
1332 Currently available options are: I<tax_exemption>, I<cust_payby_params>,
1333 I<contact_params>, I<invoicing_list>, and I<move_pkgs>.
1335 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1336 of tax names and exemption numbers. FS::cust_main_exemption records will be
1337 deleted and inserted as appropriate.
1339 I<cust_payby_params> and I<contact_params> can be hashrefs of named parameter
1340 groups (describing the customer's payment methods and contacts, respectively)
1341 in the style supported by L<FS::o2m_Common/process_o2m>. See L<FS::cust_payby>
1342 and L<FS::contact> for the fields these can contain.
1344 I<invoicing_list> is a synonym for the INVOICING_LIST_ARYREF parameter, and
1345 should be used instead if possible.
1347 If I<move_pkgs> is an arrayref, it will override the list of packages
1348 to be moved to the new address (see L<FS::cust_location/move_pkgs>.)
1355 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1357 : $self->replace_old;
1361 warn "$me replace called\n"
1364 my $curuser = $FS::CurrentUser::CurrentUser;
1365 return "You are not permitted to create complimentary accounts."
1366 if $self->complimentary eq 'Y'
1367 && $self->complimentary ne $old->complimentary
1368 && ! $curuser->access_right('Complimentary customer');
1370 local($ignore_expired_card) = 1
1371 if $old->payby =~ /^(CARD|DCRD)$/
1372 && $self->payby =~ /^(CARD|DCRD)$/
1373 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1375 local($ignore_banned_card) = 1
1376 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1377 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1378 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1380 if ( $self->payby =~ /^(CARD|DCRD)$/
1381 && $old->payinfo ne $self->payinfo
1382 && $old->paymask ne $self->paymask )
1384 my $error = $self->check_payinfo_cardtype;
1385 return $error if $error;
1388 return "Invoicing locale is required"
1391 && $conf->exists('cust_main-require_locale');
1393 return "You are not permitted to change customer invoicing terms."
1394 if $old->invoice_terms ne $self->invoice_terms
1395 && ! $curuser->access_right('Edit customer invoice terms');
1397 local $SIG{HUP} = 'IGNORE';
1398 local $SIG{INT} = 'IGNORE';
1399 local $SIG{QUIT} = 'IGNORE';
1400 local $SIG{TERM} = 'IGNORE';
1401 local $SIG{TSTP} = 'IGNORE';
1402 local $SIG{PIPE} = 'IGNORE';
1404 my $oldAutoCommit = $FS::UID::AutoCommit;
1405 local $FS::UID::AutoCommit = 0;
1408 for my $l (qw(bill_location ship_location)) {
1409 #my $old_loc = $old->$l;
1410 my $new_loc = $self->$l or next;
1412 # find the existing location if there is one
1413 $new_loc->set('custnum' => $self->custnum);
1414 my $error = $new_loc->find_or_insert;
1416 $dbh->rollback if $oldAutoCommit;
1419 $self->set($l.'num', $new_loc->locationnum);
1423 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1424 warn "cust_main::replace: using deprecated invoicing list argument";
1425 $invoicing_list = shift @param;
1428 my %options = @param;
1430 $invoicing_list ||= $options{invoicing_list};
1432 my @contacts = map { $_->contact } $self->cust_contact;
1433 # find a contact that matches the customer's name
1434 my ($implicit_contact) = grep { $_->first eq $old->get('first')
1435 and $_->last eq $old->get('last') }
1437 $implicit_contact ||= FS::contact->new({
1438 'custnum' => $self->custnum,
1439 'locationnum' => $self->get('bill_locationnum'),
1442 # for any of these that are already contact emails, link to the existing
1444 if ( $invoicing_list ) {
1447 # kind of like process_m2m on these, except:
1448 # - the other side is two tables in a join
1449 # - and we might have to create new contact_emails
1450 # - and possibly a new contact
1452 # Find existing invoice emails that aren't on the implicit contact.
1453 # Any of these that are not on the new invoicing list will be removed.
1454 my %old_email_cust_contact;
1455 foreach my $cust_contact ($self->cust_contact) {
1456 next if !$cust_contact->invoice_dest;
1457 next if $cust_contact->contactnum == ($implicit_contact->contactnum || 0);
1459 foreach my $contact_email ($cust_contact->contact->contact_email) {
1460 $old_email_cust_contact{ $contact_email->emailaddress } = $cust_contact;
1464 foreach my $dest (@$invoicing_list) {
1466 if ($dest eq 'POST') {
1468 $self->set('postal_invoice', 'Y');
1470 } elsif ( exists($old_email_cust_contact{$dest}) ) {
1472 delete $old_email_cust_contact{$dest}; # don't need to remove it, then
1476 # See if it belongs to some other contact; if so, link it.
1477 my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
1479 and $contact_email->contactnum != ($implicit_contact->contactnum || 0) ) {
1480 my $cust_contact = qsearchs('cust_contact', {
1481 contactnum => $contact_email->contactnum,
1482 custnum => $self->custnum,
1483 }) || FS::cust_contact->new({
1484 contactnum => $contact_email->contactnum,
1485 custnum => $self->custnum,
1487 $cust_contact->set('invoice_dest', 'Y');
1488 my $error = $cust_contact->custcontactnum ?
1489 $cust_contact->replace : $cust_contact->insert;
1491 $dbh->rollback if $oldAutoCommit;
1492 return "$error (linking to email address $dest)";
1496 # This email address is not yet linked to any contact, so it will
1497 # be added to the implicit contact.
1498 $email .= ',' if length($email);
1504 foreach my $remove_dest (keys %old_email_cust_contact) {
1505 my $cust_contact = $old_email_cust_contact{$remove_dest};
1506 # These were not in the list of requested destinations, so take them off.
1507 $cust_contact->set('invoice_dest', '');
1508 my $error = $cust_contact->replace;
1510 $dbh->rollback if $oldAutoCommit;
1511 return "$error (unlinking email address $remove_dest)";
1515 # make sure it keeps up with the changed customer name, if any
1516 $implicit_contact->set('last', $self->get('last'));
1517 $implicit_contact->set('first', $self->get('first'));
1518 $implicit_contact->set('emailaddress', $email);
1519 $implicit_contact->set('invoice_dest', 'Y');
1520 $implicit_contact->set('custnum', $self->custnum);
1521 my $i_cust_contact =
1522 qsearchs('cust_contact', {
1523 contactnum => $implicit_contact->contactnum,
1524 custnum => $self->custnum,
1527 if ( $i_cust_contact ) {
1528 $implicit_contact->set($_, $i_cust_contact->$_)
1529 foreach qw( classnum selfservice_access comment );
1533 if ( $implicit_contact->contactnum ) {
1534 $error = $implicit_contact->replace;
1535 } elsif ( length($email) ) { # don't create a new contact if not needed
1536 $error = $implicit_contact->insert;
1540 $dbh->rollback if $oldAutoCommit;
1541 return "$error (adding email address $email)";
1546 # replace the customer record
1547 my $error = $self->SUPER::replace($old);
1550 $dbh->rollback if $oldAutoCommit;
1554 # now move packages to the new service location
1555 $self->set('ship_location', ''); #flush cache
1556 if ( $old->ship_locationnum and # should only be null during upgrade...
1557 $old->ship_locationnum != $self->ship_locationnum ) {
1558 $error = $old->ship_location->move_to($self->ship_location, move_pkgs => $options{'move_pkgs'});
1560 $dbh->rollback if $oldAutoCommit;
1564 # don't move packages based on the billing location, but
1565 # disable it if it's no longer in use
1566 if ( $old->bill_locationnum and
1567 $old->bill_locationnum != $self->bill_locationnum ) {
1568 $error = $old->bill_location->disable_if_unused;
1570 $dbh->rollback if $oldAutoCommit;
1575 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1577 #this could be more efficient than deleting and re-inserting, if it matters
1578 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1579 my $error = $cust_tag->delete;
1581 $dbh->rollback if $oldAutoCommit;
1585 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1586 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1587 'custnum' => $self->custnum };
1588 my $error = $cust_tag->insert;
1590 $dbh->rollback if $oldAutoCommit;
1597 my $tax_exemption = delete $options{'tax_exemption'};
1598 if ( $tax_exemption ) {
1600 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1601 if ref($tax_exemption) eq 'ARRAY';
1603 my %cust_main_exemption =
1604 map { $_->taxname => $_ }
1605 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1607 foreach my $taxname ( keys %$tax_exemption ) {
1609 if ( $cust_main_exemption{$taxname} &&
1610 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1613 delete $cust_main_exemption{$taxname};
1617 my $cust_main_exemption = new FS::cust_main_exemption {
1618 'custnum' => $self->custnum,
1619 'taxname' => $taxname,
1620 'exempt_number' => $tax_exemption->{$taxname},
1622 my $error = $cust_main_exemption->insert;
1624 $dbh->rollback if $oldAutoCommit;
1625 return "inserting cust_main_exemption (transaction rolled back): $error";
1629 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1630 my $error = $cust_main_exemption->delete;
1632 $dbh->rollback if $oldAutoCommit;
1633 return "deleting cust_main_exemption (transaction rolled back): $error";
1639 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1641 my $error = $self->process_o2m(
1642 'table' => 'cust_payby',
1643 'fields' => FS::cust_payby->cgi_cust_payby_fields,
1644 'params' => $cust_payby_params,
1645 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1648 $dbh->rollback if $oldAutoCommit;
1654 if ( my $contact_params = delete $options{'contact_params'} ) {
1656 # this can potentially replace contacts that were created by the
1657 # invoicing list argument, but the UI shouldn't allow both of them
1660 my $error = $self->process_o2m(
1661 'table' => 'contact',
1662 'fields' => FS::contact->cgi_contact_fields,
1663 'params' => $contact_params,
1666 $dbh->rollback if $oldAutoCommit;
1672 unless ( $import || $skip_fuzzyfiles ) {
1673 $error = $self->queue_fuzzyfiles_update;
1675 $dbh->rollback if $oldAutoCommit;
1676 return "updating fuzzy search cache: $error";
1680 # tax district update in cust_location
1682 # cust_main exports!
1684 my $export_args = $options{'export_args'} || [];
1687 map qsearch( 'part_export', {exportnum=>$_} ),
1688 $conf->config('cust_main-exports'); #, $agentnum
1690 foreach my $part_export ( @part_export ) {
1691 my $error = $part_export->export_replace( $self, $old, @$export_args);
1693 $dbh->rollback if $oldAutoCommit;
1694 return "exporting to ". $part_export->exporttype.
1695 " (transaction rolled back): $error";
1699 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1704 =item queue_fuzzyfiles_update
1706 Used by insert & replace to update the fuzzy search cache
1710 use FS::cust_main::Search;
1711 sub queue_fuzzyfiles_update {
1714 local $SIG{HUP} = 'IGNORE';
1715 local $SIG{INT} = 'IGNORE';
1716 local $SIG{QUIT} = 'IGNORE';
1717 local $SIG{TERM} = 'IGNORE';
1718 local $SIG{TSTP} = 'IGNORE';
1719 local $SIG{PIPE} = 'IGNORE';
1721 my $oldAutoCommit = $FS::UID::AutoCommit;
1722 local $FS::UID::AutoCommit = 0;
1725 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1726 my $queue = new FS::queue {
1727 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1729 my @args = "cust_main.$field", $self->get($field);
1730 my $error = $queue->insert( @args );
1732 $dbh->rollback if $oldAutoCommit;
1733 return "queueing job (transaction rolled back): $error";
1738 push @locations, $self->bill_location if $self->bill_locationnum;
1739 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1740 foreach my $location (@locations) {
1741 my $queue = new FS::queue {
1742 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1744 my @args = 'cust_location.address1', $location->address1;
1745 my $error = $queue->insert( @args );
1747 $dbh->rollback if $oldAutoCommit;
1748 return "queueing job (transaction rolled back): $error";
1752 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1759 Checks all fields to make sure this is a valid customer record. If there is
1760 an error, returns the error, otherwise returns false. Called by the insert
1761 and replace methods.
1768 warn "$me check BEFORE: \n". $self->_dump
1772 $self->ut_numbern('custnum')
1773 || $self->ut_number('agentnum')
1774 || $self->ut_textn('agent_custid')
1775 || $self->ut_number('refnum')
1776 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1777 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1778 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1779 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1780 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1781 || $self->ut_textn('custbatch')
1782 || $self->ut_name('last')
1783 || $self->ut_name('first')
1784 || $self->ut_snumbern('signupdate')
1785 || $self->ut_snumbern('birthdate')
1786 || $self->ut_namen('spouse_last')
1787 || $self->ut_namen('spouse_first')
1788 || $self->ut_snumbern('spouse_birthdate')
1789 || $self->ut_snumbern('anniversary_date')
1790 || $self->ut_textn('company')
1791 || $self->ut_textn('ship_company')
1792 || $self->ut_anything('comments')
1793 || $self->ut_numbern('referral_custnum')
1794 || $self->ut_textn('stateid')
1795 || $self->ut_textn('stateid_state')
1796 || $self->ut_textn('invoice_terms')
1797 || $self->ut_floatn('cdr_termination_percentage')
1798 || $self->ut_floatn('credit_limit')
1799 || $self->ut_numbern('billday')
1800 || $self->ut_numbern('prorate_day')
1801 || $self->ut_flag('force_prorate_day')
1802 || $self->ut_flag('edit_subject')
1803 || $self->ut_flag('calling_list_exempt')
1804 || $self->ut_flag('invoice_noemail')
1805 || $self->ut_flag('message_noemail')
1806 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1807 || $self->ut_currencyn('currency')
1808 || $self->ut_textn('po_number')
1809 || $self->ut_enum('complimentary', [ '', 'Y' ])
1810 || $self->ut_flag('invoice_ship_address')
1811 || $self->ut_flag('invoice_dest')
1814 foreach (qw(company ship_company)) {
1815 my $company = $self->get($_);
1816 $company =~ s/^\s+//;
1817 $company =~ s/\s+$//;
1818 $company =~ s/\s+/ /g;
1819 $self->set($_, $company);
1822 #barf. need message catalogs. i18n. etc.
1823 $error .= "Please select an advertising source."
1824 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1825 return $error if $error;
1827 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1828 or return "Unknown agent";
1830 if ( $self->currency ) {
1831 my $agent_currency = qsearchs( 'agent_currency', {
1832 'agentnum' => $agent->agentnum,
1833 'currency' => $self->currency,
1835 or return "Agent ". $agent->agent.
1836 " not permitted to offer ". $self->currency. " invoicing";
1839 return "Unknown refnum"
1840 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1842 return "Unknown referring custnum: ". $self->referral_custnum
1843 unless ! $self->referral_custnum
1844 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1846 if ( $self->ss eq '' ) {
1851 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1852 or return "Illegal social security number: ". $self->ss;
1853 $self->ss("$1-$2-$3");
1856 #turn off invoice_ship_address if ship & bill are the same
1857 if ($self->bill_locationnum eq $self->ship_locationnum) {
1858 $self->invoice_ship_address('');
1861 # cust_main_county verification now handled by cust_location check
1864 $self->ut_phonen('daytime', $self->country)
1865 || $self->ut_phonen('night', $self->country)
1866 || $self->ut_phonen('fax', $self->country)
1867 || $self->ut_phonen('mobile', $self->country)
1869 return $error if $error;
1871 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1873 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1876 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1878 : FS::Msgcat::_gettext('daytime');
1879 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1881 : FS::Msgcat::_gettext('night');
1883 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1885 : FS::Msgcat::_gettext('mobile');
1887 return "$daytime_label, $night_label or $mobile_label is required"
1891 return "Please select an invoicing locale"
1894 && $conf->exists('cust_main-require_locale');
1896 return "Please select a customer class"
1897 if ! $self->classnum
1898 && $conf->exists('cust_main-require_classnum');
1900 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1901 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1905 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1907 warn "$me check AFTER: \n". $self->_dump
1910 $self->SUPER::check;
1913 sub check_payinfo_cardtype {
1916 return '' unless $self->payby =~ /^(CARD|DCRD)$/;
1918 my $payinfo = $self->payinfo;
1919 $payinfo =~ s/\D//g;
1921 return '' if $self->tokenized($payinfo); #token
1923 my %bop_card_types = map { $_=>1 } values %{ card_types() };
1924 my $cardtype = cardtype($payinfo);
1926 return "$cardtype not accepted" unless $bop_card_types{$cardtype};
1934 Additional checks for replace only.
1939 my ($new,$old) = @_;
1940 #preserve old value if global config is set
1941 if ($old && $conf->exists('invoice-ship_address')) {
1942 $new->invoice_ship_address($old->invoice_ship_address);
1949 Returns a list of fields which have ship_ duplicates.
1954 qw( last first company
1956 address1 address2 city county state zip country
1958 daytime night fax mobile
1962 =item has_ship_address
1964 Returns true if this customer record has a separate shipping address.
1968 sub has_ship_address {
1970 $self->bill_locationnum != $self->ship_locationnum;
1975 Returns a list of key/value pairs, with the following keys: address1,
1976 adddress2, city, county, state, zip, country, district, and geocode. The
1977 shipping address is used if present.
1983 $self->ship_location->location_hash;
1988 Returns all locations (see L<FS::cust_location>) for this customer.
1995 'table' => 'cust_location',
1996 'hashref' => { 'custnum' => $self->custnum,
1997 'prospectnum' => '',
1999 'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
2005 Returns all contact associations (see L<FS::cust_contact>) for this customer.
2011 qsearch('cust_contact', { 'custnum' => $self->custnum } );
2014 =item cust_payby PAYBY
2016 Returns all payment methods (see L<FS::cust_payby>) for this customer.
2018 If one or more PAYBY are specified, returns only payment methods for specified PAYBY.
2019 Does not validate PAYBY.
2027 'table' => 'cust_payby',
2028 'hashref' => { 'custnum' => $self->custnum },
2029 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
2031 $search->{'extra_sql'} = ' AND payby IN ( '.
2032 join(',', map dbh->quote($_), @payby).
2039 =item has_cust_payby_auto
2041 Returns true if customer has an automatic payment method ('CARD' or 'CHEK')
2045 sub has_cust_payby_auto {
2048 'table' => 'cust_payby',
2049 'hashref' => { 'custnum' => $self->custnum, },
2050 'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ",
2051 'order_by' => 'LIMIT 1',
2058 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2059 and L<FS::cust_pkg>) for this customer, except those on hold.
2061 Returns a list: an empty list on success or a list of errors.
2067 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_);
2072 Unsuspends all suspended packages in the on-hold state (those without setup
2073 dates) for this customer.
2079 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2084 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2086 Returns a list: an empty list on success or a list of errors.
2092 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2095 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2097 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2098 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2099 of a list of pkgparts; the hashref has the following keys:
2103 =item pkgparts - listref of pkgparts
2105 =item (other options are passed to the suspend method)
2110 Returns a list: an empty list on success or a list of errors.
2114 sub suspend_if_pkgpart {
2116 my (@pkgparts, %opt);
2117 if (ref($_[0]) eq 'HASH'){
2118 @pkgparts = @{$_[0]{pkgparts}};
2123 grep { $_->suspend(%opt) }
2124 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2125 $self->unsuspended_pkgs;
2128 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2130 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2131 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2132 instead of a list of pkgparts; the hashref has the following keys:
2136 =item pkgparts - listref of pkgparts
2138 =item (other options are passed to the suspend method)
2142 Returns a list: an empty list on success or a list of errors.
2146 sub suspend_unless_pkgpart {
2148 my (@pkgparts, %opt);
2149 if (ref($_[0]) eq 'HASH'){
2150 @pkgparts = @{$_[0]{pkgparts}};
2155 grep { $_->suspend(%opt) }
2156 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2157 $self->unsuspended_pkgs;
2160 =item cancel [ OPTION => VALUE ... ]
2162 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2163 The cancellation time will be now.
2167 Always returns a list: an empty list on success or a list of errors.
2174 warn "$me cancel called on customer ". $self->custnum. " with options ".
2175 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2177 my @pkgs = $self->ncancelled_pkgs;
2179 $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
2182 =item cancel_pkgs OPTIONS
2184 Cancels a specified list of packages. OPTIONS can include:
2188 =item cust_pkg - an arrayref of the packages. Required.
2190 =item time - the cancellation time, used to calculate final bills and
2191 unused-time credits if any. Will be passed through to the bill() and
2192 FS::cust_pkg::cancel() methods.
2194 =item quiet - can be set true to supress email cancellation notices.
2196 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a
2197 reasonnum of an existing reason, or passing a hashref will create a new reason.
2198 The hashref should have the following keys:
2199 typenum - Reason type (see L<FS::reason_type>)
2200 reason - Text of the new reason.
2202 =item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
2203 for the individual packages, parallel to the C<cust_pkg> argument. The
2204 reason and reason_otaker arguments will be taken from those objects.
2206 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2208 =item nobill - can be set true to skip billing if it might otherwise be done.
2213 my( $self, %opt ) = @_;
2215 # we're going to cancel services, which is not reversible
2216 # unless exports are suppressed
2217 die "cancel_pkgs cannot be run inside a transaction"
2218 if !$FS::UID::AutoCommit && !$FS::svc_Common::noexport_hack;
2220 my $oldAutoCommit = $FS::UID::AutoCommit;
2221 local $FS::UID::AutoCommit = 0;
2223 savepoint_create('cancel_pkgs');
2225 return ( 'access denied' )
2226 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2228 if ( $opt{'ban'} ) {
2230 foreach my $cust_payby ( $self->cust_payby ) {
2232 #well, if they didn't get decrypted on search, then we don't have to
2233 # try again... queue a job for the server that does have decryption
2234 # capability if we're in a paranoid multi-server implementation?
2235 return ( "Can't (yet) ban encrypted credit cards" )
2236 if $cust_payby->is_encrypted($cust_payby->payinfo);
2238 my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2239 my $error = $ban->insert;
2241 savepoint_rollback_and_release('cancel_pkgs');
2242 dbh->rollback if $oldAutoCommit;
2250 my @pkgs = @{ delete $opt{'cust_pkg'} };
2251 my $cancel_time = $opt{'time'} || time;
2253 # bill all packages first, so we don't lose usage, service counts for
2254 # bulk billing, etc.
2255 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2257 my $error = $self->bill( 'pkg_list' => [ @pkgs ],
2259 'time' => $cancel_time );
2261 warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
2262 savepoint_rollback_and_release('cancel_pkgs');
2263 dbh->rollback if $oldAutoCommit;
2264 return ( "Error billing during cancellation: $error" );
2267 savepoint_release('cancel_pkgs');
2268 dbh->commit if $oldAutoCommit;
2271 # try to cancel each service, the same way we would for individual packages,
2272 # but in cancel weight order.
2273 my @cust_svc = map { $_->cust_svc } @pkgs;
2274 my @sorted_cust_svc =
2276 sort { $a->[1] <=> $b->[1] }
2277 map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc
2279 warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
2283 foreach my $cust_svc (@sorted_cust_svc) {
2284 my $savepoint = 'cancel_pkgs_'.$i++;
2285 savepoint_create( $savepoint );
2286 my $part_svc = $cust_svc->part_svc;
2287 next if ( defined($part_svc) and $part_svc->preserve );
2288 # immediate cancel, no date option
2289 # transactionize individually
2290 my $error = try { $cust_svc->cancel } catch { $_ };
2292 savepoint_rollback_and_release( $savepoint );
2293 dbh->rollback if $oldAutoCommit;
2294 push @errors, $error;
2296 savepoint_release( $savepoint );
2297 dbh->commit if $oldAutoCommit;
2304 warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
2305 $self->custnum. "\n"
2309 if ($opt{'cust_pkg_reason'}) {
2310 @cprs = @{ delete $opt{'cust_pkg_reason'} };
2316 my $savepoint = 'cancel_pkgs_'.$i++;
2317 savepoint_create( $savepoint );
2319 my $cpr = shift @cprs;
2321 $lopt{'reason'} = $cpr->reasonnum;
2322 $lopt{'reason_otaker'} = $cpr->otaker;
2324 warn "no reason found when canceling package ".$_->pkgnum."\n";
2325 # we're not actually required to pass a reason to cust_pkg::cancel,
2326 # but if we're getting to this point, something has gone awry.
2327 $null_reason ||= FS::reason->new_or_existing(
2328 reason => 'unknown reason',
2329 type => 'Cancel Reason',
2332 $lopt{'reason'} = $null_reason->reasonnum;
2333 $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username;
2336 my $error = $_->cancel(%lopt);
2338 savepoint_rollback_and_release( $savepoint );
2339 dbh->rollback if $oldAutoCommit;
2340 push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
2342 savepoint_release( $savepoint );
2343 dbh->commit if $oldAutoCommit;
2350 sub _banned_pay_hashref {
2351 die 'cust_main->_banned_pay_hashref deprecated';
2363 'payby' => $payby2ban{$self->payby},
2364 'payinfo' => $self->payinfo,
2365 #don't ever *search* on reason! #'reason' =>
2371 Returns all notes (see L<FS::cust_main_note>) for this customer.
2376 my($self,$orderby_classnum) = (shift,shift);
2377 my $orderby = "sticky DESC, _date DESC";
2378 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2379 qsearch( 'cust_main_note',
2380 { 'custnum' => $self->custnum },
2382 "ORDER BY $orderby",
2388 Returns the agent (see L<FS::agent>) for this customer.
2392 Returns the agent name (see L<FS::agent>) for this customer.
2398 $self->agent->agent;
2403 Returns any tags associated with this customer, as FS::cust_tag objects,
2404 or an empty list if there are no tags.
2408 Returns any tags associated with this customer, as FS::part_tag objects,
2409 or an empty list if there are no tags.
2415 map $_->part_tag, $self->cust_tag;
2421 Returns the customer class, as an FS::cust_class object, or the empty string
2422 if there is no customer class.
2426 Returns the customer category name, or the empty string if there is no customer
2433 my $cust_class = $self->cust_class;
2435 ? $cust_class->categoryname
2441 Returns the customer class name, or the empty string if there is no customer
2448 my $cust_class = $self->cust_class;
2450 ? $cust_class->classname
2456 Returns the external tax status, as an FS::tax_status object, or the empty
2457 string if there is no tax status.
2463 if ( $self->taxstatusnum ) {
2464 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2472 Returns the tax status code if there is one.
2478 my $tax_status = $self->tax_status;
2480 ? $tax_status->taxstatus
2484 =item BILLING METHODS
2486 Documentation on billing methods has been moved to
2487 L<FS::cust_main::Billing>.
2489 =item REALTIME BILLING METHODS
2491 Documentation on realtime billing methods has been moved to
2492 L<FS::cust_main::Billing_Realtime>.
2496 Removes the I<paycvv> field from the database directly.
2498 If there is an error, returns the error, otherwise returns false.
2500 DEPRECATED. Use L</remove_cvv_from_cust_payby> instead.
2505 die 'cust_main->remove_cvv deprecated';
2507 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2508 or return dbh->errstr;
2509 $sth->execute($self->custnum)
2510 or return $sth->errstr;
2517 Returns the total owed for this customer on all invoices
2518 (see L<FS::cust_bill/owed>).
2524 $self->total_owed_date(2145859200); #12/31/2037
2527 =item total_owed_date TIME
2529 Returns the total owed for this customer on all invoices with date earlier than
2530 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2531 see L<Time::Local> and L<Date::Parse> for conversion functions.
2535 sub total_owed_date {
2539 my $custnum = $self->custnum;
2541 my $owed_sql = FS::cust_bill->owed_sql;
2544 SELECT SUM($owed_sql) FROM cust_bill
2545 WHERE custnum = $custnum
2549 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2553 =item total_owed_pkgnum PKGNUM
2555 Returns the total owed on all invoices for this customer's specific package
2556 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2560 sub total_owed_pkgnum {
2561 my( $self, $pkgnum ) = @_;
2562 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2565 =item total_owed_date_pkgnum TIME PKGNUM
2567 Returns the total owed for this customer's specific package when using
2568 experimental package balances on all invoices with date earlier than
2569 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2570 see L<Time::Local> and L<Date::Parse> for conversion functions.
2574 sub total_owed_date_pkgnum {
2575 my( $self, $time, $pkgnum ) = @_;
2578 foreach my $cust_bill (
2579 grep { $_->_date <= $time }
2580 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2582 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2584 sprintf( "%.2f", $total_bill );
2590 Returns the total amount of all payments.
2597 $total += $_->paid foreach $self->cust_pay;
2598 sprintf( "%.2f", $total );
2601 =item total_unapplied_credits
2603 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2604 customer. See L<FS::cust_credit/credited>.
2606 =item total_credited
2608 Old name for total_unapplied_credits. Don't use.
2612 sub total_credited {
2613 #carp "total_credited deprecated, use total_unapplied_credits";
2614 shift->total_unapplied_credits(@_);
2617 sub total_unapplied_credits {
2620 my $custnum = $self->custnum;
2622 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2625 SELECT SUM($unapplied_sql) FROM cust_credit
2626 WHERE custnum = $custnum
2629 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2633 =item total_unapplied_credits_pkgnum PKGNUM
2635 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2636 customer. See L<FS::cust_credit/credited>.
2640 sub total_unapplied_credits_pkgnum {
2641 my( $self, $pkgnum ) = @_;
2642 my $total_credit = 0;
2643 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2644 sprintf( "%.2f", $total_credit );
2648 =item total_unapplied_payments
2650 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2651 See L<FS::cust_pay/unapplied>.
2655 sub total_unapplied_payments {
2658 my $custnum = $self->custnum;
2660 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2663 SELECT SUM($unapplied_sql) FROM cust_pay
2664 WHERE custnum = $custnum
2667 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2671 =item total_unapplied_payments_pkgnum PKGNUM
2673 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2674 specific package when using experimental package balances. See
2675 L<FS::cust_pay/unapplied>.
2679 sub total_unapplied_payments_pkgnum {
2680 my( $self, $pkgnum ) = @_;
2681 my $total_unapplied = 0;
2682 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2683 sprintf( "%.2f", $total_unapplied );
2687 =item total_unapplied_refunds
2689 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2690 customer. See L<FS::cust_refund/unapplied>.
2694 sub total_unapplied_refunds {
2696 my $custnum = $self->custnum;
2698 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2701 SELECT SUM($unapplied_sql) FROM cust_refund
2702 WHERE custnum = $custnum
2705 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2711 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2712 total_unapplied_credits minus total_unapplied_payments).
2718 $self->balance_date_range;
2721 =item balance_date TIME
2723 Returns the balance for this customer, only considering invoices with date
2724 earlier than TIME (total_owed_date minus total_credited minus
2725 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2726 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2733 $self->balance_date_range(shift);
2736 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2738 Returns the balance for this customer, optionally considering invoices with
2739 date earlier than START_TIME, and not later than END_TIME
2740 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2742 Times are specified as SQL fragments or numeric
2743 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2744 L<Date::Parse> for conversion functions. The empty string can be passed
2745 to disable that time constraint completely.
2747 Accepts the same options as L<balance_date_sql>:
2751 =item unapplied_date
2753 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)
2757 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2758 time will be ignored. Note that START_TIME and END_TIME only limit the date
2759 range for invoices and I<unapplied> payments, credits, and refunds.
2765 sub balance_date_range {
2767 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2768 ') FROM cust_main WHERE custnum='. $self->custnum;
2769 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2772 =item balance_pkgnum PKGNUM
2774 Returns the balance for this customer's specific package when using
2775 experimental package balances (total_owed plus total_unrefunded, minus
2776 total_unapplied_credits minus total_unapplied_payments)
2780 sub balance_pkgnum {
2781 my( $self, $pkgnum ) = @_;
2784 $self->total_owed_pkgnum($pkgnum)
2785 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2786 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2787 - $self->total_unapplied_credits_pkgnum($pkgnum)
2788 - $self->total_unapplied_payments_pkgnum($pkgnum)
2794 Returns a hash of useful information for making a payment.
2804 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2805 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2806 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2810 For credit card transactions:
2822 For electronic check transactions:
2832 #XXX i need to be updated for 4.x+
2838 $return{balance} = $self->balance;
2840 $return{payname} = $self->payname
2841 || ( $self->first. ' '. $self->get('last') );
2843 $return{$_} = $self->bill_location->$_
2844 for qw(address1 address2 city state zip);
2846 $return{payby} = $self->payby;
2847 $return{stateid_state} = $self->stateid_state;
2849 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2850 $return{card_type} = cardtype($self->payinfo);
2851 $return{payinfo} = $self->paymask;
2853 @return{'month', 'year'} = $self->paydate_monthyear;
2857 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2858 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2859 $return{payinfo1} = $payinfo1;
2860 $return{payinfo2} = $payinfo2;
2861 $return{paytype} = $self->paytype;
2862 $return{paystate} = $self->paystate;
2866 #doubleclick protection
2868 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2876 Returns the next payment expiration date for this customer. If they have no
2877 payment methods that will expire, returns 0.
2883 # filter out the ones that individually return 0, but then return 0 if
2884 # there are no results
2885 my @epochs = grep { $_ > 0 } map { $_->paydate_epoch } $self->cust_payby;
2886 min( @epochs ) || 0;
2889 =item paydate_epoch_sql
2891 Returns an SQL expression to get the next payment expiration date for a
2892 customer. Returns 2143260000 (2037-12-01) if there are no payment expiration
2893 dates, so that it's safe to test for "will it expire before date X" for any
2898 sub paydate_epoch_sql {
2900 my $paydate = FS::cust_payby->paydate_epoch_sql;
2901 "(SELECT COALESCE(MIN($paydate), 2143260000) FROM cust_payby WHERE cust_payby.custnum = cust_main.custnum)";
2905 my( $self, $taxname ) = @_;
2907 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2908 'taxname' => $taxname,
2913 =item cust_main_exemption
2915 =item invoicing_list
2917 Returns a list of email addresses (with svcnum entries expanded), and the word
2918 'POST' if the customer receives postal invoices.
2922 sub invoicing_list {
2923 my( $self, $arrayref ) = @_;
2926 warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
2929 my @emails = $self->invoicing_list_emailonly;
2930 push @emails, 'POST' if $self->get('postal_invoice');
2935 =item check_invoicing_list ARRAYREF
2937 Checks these arguements as valid input for the invoicing_list method. If there
2938 is an error, returns the error, otherwise returns false.
2942 sub check_invoicing_list {
2943 my( $self, $arrayref ) = @_;
2945 foreach my $address ( @$arrayref ) {
2947 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2948 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2951 my $cust_main_invoice = new FS::cust_main_invoice ( {
2952 'custnum' => $self->custnum,
2955 my $error = $self->custnum
2956 ? $cust_main_invoice->check
2957 : $cust_main_invoice->checkdest
2959 return $error if $error;
2963 return "Email address required"
2964 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2965 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2972 Returns the email addresses of all accounts provisioned for this customer.
2979 foreach my $cust_pkg ( $self->all_pkgs ) {
2980 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2982 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2983 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2985 $list{$_}=1 foreach map { $_->email } @svc_acct;
2990 =item invoicing_list_addpost
2992 Adds postal invoicing to this customer. If this customer is already configured
2993 to receive postal invoices, does nothing.
2997 sub invoicing_list_addpost {
2999 if ( $self->get('postal_invoice') eq '' ) {
3000 $self->set('postal_invoice', 'Y');
3001 my $error = $self->replace;
3002 warn $error if $error; # should fail harder, but this is traditional
3006 =item invoicing_list_emailonly
3008 Returns the list of email invoice recipients (invoicing_list without non-email
3009 destinations such as POST and FAX).
3013 sub invoicing_list_emailonly {
3015 warn "$me invoicing_list_emailonly called"
3017 return () if !$self->custnum; # not yet inserted
3018 return map { $_->emailaddress }
3020 table => 'cust_contact',
3021 select => 'emailaddress',
3022 addl_from => ' JOIN contact USING (contactnum) '.
3023 ' JOIN contact_email USING (contactnum)',
3024 hashref => { 'custnum' => $self->custnum, },
3025 extra_sql => q( AND cust_contact.invoice_dest = 'Y'),
3029 =item invoicing_list_emailonly_scalar
3031 Returns the list of email invoice recipients (invoicing_list without non-email
3032 destinations such as POST and FAX) as a comma-separated scalar.
3036 sub invoicing_list_emailonly_scalar {
3038 warn "$me invoicing_list_emailonly_scalar called"
3040 join(', ', $self->invoicing_list_emailonly);
3043 =item contact_list [ CLASSNUM, DEST_FLAG... ]
3045 Returns a list of contacts (L<FS::contact> objects) for the customer.
3047 If no arguments are given, returns all contacts for the customer.
3049 Arguments may contain classnums. When classnums are specified, only
3050 contacts with a matching cust_contact.classnum are returned. When a
3051 classnum of 0 is given, contacts with a null classnum are also included.
3053 Arguments may also contain the dest flag names 'invoice' or 'message'.
3054 If given, contacts who's invoice_dest and/or message_dest flags are
3055 not set to 'Y' will be excluded.
3063 select => join(', ',(
3065 'cust_contact.invoice_dest',
3066 'cust_contact.message_dest',
3068 addl_from => ' JOIN cust_contact USING (contactnum)',
3069 extra_sql => ' WHERE cust_contact.custnum = '.$self->custnum,
3073 # Calling methods were relying on this method to use invoice_dest to
3074 # block e-mail messages. Depending on parameters, this may or may not
3075 # have actually happened.
3077 # The bug could cause this SQL to be used to filter e-mail addresses:
3080 # cust_contact.classnums IN (1,2,3)
3081 # OR cust_contact.invoice_dest = 'Y'
3084 # improperly including everybody with the opt-in flag AND everybody
3085 # in the contact classes
3087 # Possibility to introduce new bugs:
3088 # If callers of this method called it incorrectly, and didn't notice
3089 # because it seemed to send the e-mails they wanted.
3094 # cust_contact.classnum IN (1,2,3)
3096 # cust_contact.classnum IS NULL
3099 # cust_contact.invoice_dest = 'Y'
3101 # cust_contact.message_dest = 'Y'
3109 if ($_ eq 'invoice' || $_ eq 'message') {
3110 push @and_dest, " cust_contact.${_}_dest = 'Y' ";
3111 } elsif ($_ eq '0') {
3112 push @or_classnum, ' cust_contact.classnum IS NULL ';
3113 } elsif ( /^\d+$/ ) {
3114 push @classnums, $_;
3116 croak "bad classnum argument '$_'";
3120 push @or_classnum, 'cust_contact.classnum IN ('.join(',',@classnums).')'
3123 if (@or_classnum || @and_dest) { # catch, no arguments given
3124 $search->{extra_sql} .= ' AND ( ';
3127 $search->{extra_sql} .= ' ( ';
3128 $search->{extra_sql} .= join ' OR ', map {" $_ "} @or_classnum;
3129 $search->{extra_sql} .= ' ) ';
3130 $search->{extra_sql} .= ' AND ( ' if @and_dest;
3134 $search->{extra_sql} .= join ' OR ', map {" $_ "} @and_dest;
3135 $search->{extra_sql} .= ' ) ' if @or_classnum;
3138 $search->{extra_sql} .= ' ) ';
3140 warn "\$extra_sql: $search->{extra_sql} \n" if $DEBUG;
3146 =item contact_list_email [ CLASSNUM, ... ]
3148 Same as L</contact_list>, but returns email destinations instead of contact
3153 sub contact_list_email {
3155 my @contacts = $self->contact_list(@_);
3157 foreach my $contact (@contacts) {
3158 foreach my $contact_email ($contact->contact_email) {
3159 push @emails, Email::Address->new( $contact->firstlast,
3160 $contact_email->emailaddress
3167 =item referral_custnum_cust_main
3169 Returns the customer who referred this customer (or the empty string, if
3170 this customer was not referred).
3172 Note the difference with referral_cust_main method: This method,
3173 referral_custnum_cust_main returns the single customer (if any) who referred
3174 this customer, while referral_cust_main returns an array of customers referred
3179 sub referral_custnum_cust_main {
3181 return '' unless $self->referral_custnum;
3182 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3185 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3187 Returns an array of customers referred by this customer (referral_custnum set
3188 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3189 customers referred by customers referred by this customer and so on, inclusive.
3190 The default behavior is DEPTH 1 (no recursion).
3192 Note the difference with referral_custnum_cust_main method: This method,
3193 referral_cust_main, returns an array of customers referred BY this customer,
3194 while referral_custnum_cust_main returns the single customer (if any) who
3195 referred this customer.
3199 sub referral_cust_main {
3201 my $depth = @_ ? shift : 1;
3202 my $exclude = @_ ? shift : {};
3205 map { $exclude->{$_->custnum}++; $_; }
3206 grep { ! $exclude->{ $_->custnum } }
3207 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3211 map { $_->referral_cust_main($depth-1, $exclude) }
3218 =item referral_cust_main_ncancelled
3220 Same as referral_cust_main, except only returns customers with uncancelled
3225 sub referral_cust_main_ncancelled {
3227 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3230 =item referral_cust_pkg [ DEPTH ]
3232 Like referral_cust_main, except returns a flat list of all unsuspended (and
3233 uncancelled) packages for each customer. The number of items in this list may
3234 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3238 sub referral_cust_pkg {
3240 my $depth = @_ ? shift : 1;
3242 map { $_->unsuspended_pkgs }
3243 grep { $_->unsuspended_pkgs }
3244 $self->referral_cust_main($depth);
3247 =item referring_cust_main
3249 Returns the single cust_main record for the customer who referred this customer
3250 (referral_custnum), or false.
3254 sub referring_cust_main {
3256 return '' unless $self->referral_custnum;
3257 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3260 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3262 Applies a credit to this customer. If there is an error, returns the error,
3263 otherwise returns false.
3265 REASON can be a text string, an FS::reason object, or a scalar reference to
3266 a reasonnum. If a text string, it will be automatically inserted as a new
3267 reason, and a 'reason_type' option must be passed to indicate the
3268 FS::reason_type for the new reason.
3270 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3271 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3272 I<commission_pkgnum>.
3274 Any other options are passed to FS::cust_credit::insert.
3279 my( $self, $amount, $reason, %options ) = @_;
3281 my $cust_credit = new FS::cust_credit {
3282 'custnum' => $self->custnum,
3283 'amount' => $amount,
3286 if ( ref($reason) ) {
3288 if ( ref($reason) eq 'SCALAR' ) {
3289 $cust_credit->reasonnum( $$reason );
3291 $cust_credit->reasonnum( $reason->reasonnum );
3295 $cust_credit->set('reason', $reason)
3298 $cust_credit->$_( delete $options{$_} )
3299 foreach grep exists($options{$_}),
3300 qw( addlinfo eventnum ),
3301 map "commission_$_", qw( agentnum salesnum pkgnum );
3303 $cust_credit->insert(%options);
3307 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3309 Creates a one-time charge for this customer. If there is an error, returns
3310 the error, otherwise returns false.
3312 New-style, with a hashref of options:
3314 my $error = $cust_main->charge(
3318 'start_date' => str2time('7/4/2009'),
3319 'pkg' => 'Description',
3320 'comment' => 'Comment',
3321 'additional' => [], #extra invoice detail
3322 'classnum' => 1, #pkg_class
3324 'setuptax' => '', # or 'Y' for tax exempt
3326 'locationnum'=> 1234, # optional
3329 'taxclass' => 'Tax class',
3332 'taxproduct' => 2, #part_pkg_taxproduct
3333 'override' => {}, #XXX describe
3335 #will be filled in with the new object
3336 'cust_pkg_ref' => \$cust_pkg,
3338 #generate an invoice immediately
3340 'invoice_terms' => '', #with these terms
3346 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3350 #super false laziness w/quotation::charge
3353 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3354 my ( $pkg, $comment, $additional );
3355 my ( $setuptax, $taxclass ); #internal taxes
3356 my ( $taxproduct, $override ); #vendor (CCH) taxes
3358 my $separate_bill = '';
3359 my $cust_pkg_ref = '';
3360 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3362 my ( $discountnum, $discountnum_amount, $discountnum_percent ) = ( '','','' );
3363 if ( ref( $_[0] ) ) {
3364 $amount = $_[0]->{amount};
3365 $setup_cost = $_[0]->{setup_cost};
3366 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3367 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3368 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3369 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3370 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3371 : '$'. sprintf("%.2f",$amount);
3372 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3373 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3374 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3375 $additional = $_[0]->{additional} || [];
3376 $taxproduct = $_[0]->{taxproductnum};
3377 $override = { '' => $_[0]->{tax_override} };
3378 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3379 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3380 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3381 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3382 $separate_bill = $_[0]->{separate_bill} || '';
3383 $discountnum = $_[0]->{setup_discountnum};
3384 $discountnum_amount = $_[0]->{setup_discountnum_amount};
3385 $discountnum_percent = $_[0]->{setup_discountnum_percent};
3391 $pkg = @_ ? shift : 'One-time charge';
3392 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3394 $taxclass = @_ ? shift : '';
3398 local $SIG{HUP} = 'IGNORE';
3399 local $SIG{INT} = 'IGNORE';
3400 local $SIG{QUIT} = 'IGNORE';
3401 local $SIG{TERM} = 'IGNORE';
3402 local $SIG{TSTP} = 'IGNORE';
3403 local $SIG{PIPE} = 'IGNORE';
3405 my $oldAutoCommit = $FS::UID::AutoCommit;
3406 local $FS::UID::AutoCommit = 0;
3409 my $part_pkg = new FS::part_pkg ( {
3411 'comment' => $comment,
3415 'classnum' => ( $classnum ? $classnum : '' ),
3416 'setuptax' => $setuptax,
3417 'taxclass' => $taxclass,
3418 'taxproductnum' => $taxproduct,
3419 'setup_cost' => $setup_cost,
3422 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3423 ( 0 .. @$additional - 1 )
3425 'additional_count' => scalar(@$additional),
3426 'setup_fee' => $amount,
3429 my $error = $part_pkg->insert( options => \%options,
3430 tax_overrides => $override,
3433 $dbh->rollback if $oldAutoCommit;
3437 my $pkgpart = $part_pkg->pkgpart;
3438 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3439 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3440 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3441 $error = $type_pkgs->insert;
3443 $dbh->rollback if $oldAutoCommit;
3448 my $cust_pkg = new FS::cust_pkg ( {
3449 'custnum' => $self->custnum,
3450 'pkgpart' => $pkgpart,
3451 'quantity' => $quantity,
3452 'start_date' => $start_date,
3453 'no_auto' => $no_auto,
3454 'separate_bill' => $separate_bill,
3455 'locationnum' => $locationnum,
3456 'setup_discountnum' => $discountnum,
3457 'setup_discountnum_amount' => $discountnum_amount,
3458 'setup_discountnum_percent' => $discountnum_percent,
3461 $error = $cust_pkg->insert;
3463 $dbh->rollback if $oldAutoCommit;
3465 } elsif ( $cust_pkg_ref ) {
3466 ${$cust_pkg_ref} = $cust_pkg;
3470 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3471 'pkg_list' => [ $cust_pkg ],
3474 $dbh->rollback if $oldAutoCommit;
3479 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3484 #=item charge_postal_fee
3486 #Applies a one time charge this customer. If there is an error,
3487 #returns the error, returns the cust_pkg charge object or false
3488 #if there was no charge.
3492 # This should be a customer event. For that to work requires that bill
3493 # also be a customer event.
3495 sub charge_postal_fee {
3498 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3499 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3501 my $cust_pkg = new FS::cust_pkg ( {
3502 'custnum' => $self->custnum,
3503 'pkgpart' => $pkgpart,
3507 my $error = $cust_pkg->insert;
3508 $error ? $error : $cust_pkg;
3511 =item num_cust_attachment_deleted
3513 Returns the number of deleted attachments for this customer (see
3514 L<FS::num_cust_attachment>).
3518 sub num_cust_attachments_deleted {
3521 " SELECT COUNT(*) FROM cust_attachment ".
3522 " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0",
3529 Returns the most recent invnum (invoice number) for this customer.
3536 " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?",
3541 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3543 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3545 Optionally, a list or hashref of additional arguments to the qsearch call can
3552 my $opt = ref($_[0]) ? shift : { @_ };
3554 #return $self->num_cust_bill unless wantarray || keys %$opt;
3556 $opt->{'table'} = 'cust_bill';
3557 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3558 $opt->{'hashref'}{'custnum'} = $self->custnum;
3559 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3561 map { $_ } #behavior of sort undefined in scalar context
3562 sort { $a->_date <=> $b->_date }
3566 =item open_cust_bill
3568 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3573 sub open_cust_bill {
3577 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3583 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3585 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3589 sub legacy_cust_bill {
3592 #return $self->num_legacy_cust_bill unless wantarray;
3594 map { $_ } #behavior of sort undefined in scalar context
3595 sort { $a->_date <=> $b->_date }
3596 qsearch({ 'table' => 'legacy_cust_bill',
3597 'hashref' => { 'custnum' => $self->custnum, },
3598 'order_by' => 'ORDER BY _date ASC',
3602 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3604 Returns all the statements (see L<FS::cust_statement>) for this customer.
3606 Optionally, a list or hashref of additional arguments to the qsearch call can
3611 =item cust_bill_void
3613 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3617 sub cust_bill_void {
3620 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3621 sort { $a->_date <=> $b->_date }
3622 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3625 sub cust_statement {
3627 my $opt = ref($_[0]) ? shift : { @_ };
3629 #return $self->num_cust_statement unless wantarray || keys %$opt;
3631 $opt->{'table'} = 'cust_statement';
3632 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3633 $opt->{'hashref'}{'custnum'} = $self->custnum;
3634 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3636 map { $_ } #behavior of sort undefined in scalar context
3637 sort { $a->_date <=> $b->_date }
3641 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3643 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3645 Optionally, a list or hashref of additional arguments to the qsearch call can
3646 be passed following the SVCDB.
3653 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3654 warn "$me svc_x requires a svcdb";
3657 my $opt = ref($_[0]) ? shift : { @_ };
3659 $opt->{'table'} = $svcdb;
3660 $opt->{'addl_from'} =
3661 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3662 ($opt->{'addl_from'} || '');
3664 my $custnum = $self->custnum;
3665 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3666 my $where = "cust_pkg.custnum = $custnum";
3668 my $extra_sql = $opt->{'extra_sql'} || '';
3669 if ( keys %{ $opt->{'hashref'} } ) {
3670 $extra_sql = " AND $where $extra_sql";
3673 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3674 $extra_sql = "WHERE $where AND $1";
3677 $extra_sql = "WHERE $where $extra_sql";
3680 $opt->{'extra_sql'} = $extra_sql;
3685 # required for use as an eventtable;
3688 $self->svc_x('svc_acct', @_);
3693 Returns all the credits (see L<FS::cust_credit>) for this customer.
3700 #return $self->num_cust_credit unless wantarray;
3702 map { $_ } #behavior of sort undefined in scalar context
3703 sort { $a->_date <=> $b->_date }
3704 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3707 =item cust_credit_pkgnum
3709 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3710 package when using experimental package balances.
3714 sub cust_credit_pkgnum {
3715 my( $self, $pkgnum ) = @_;
3716 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3717 sort { $a->_date <=> $b->_date }
3718 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3719 'pkgnum' => $pkgnum,
3724 =item cust_credit_void
3726 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3730 sub cust_credit_void {
3733 sort { $a->_date <=> $b->_date }
3734 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3739 Returns all the payments (see L<FS::cust_pay>) for this customer.
3745 my $opt = ref($_[0]) ? shift : { @_ };
3747 return $self->num_cust_pay unless wantarray || keys %$opt;
3749 $opt->{'table'} = 'cust_pay';
3750 $opt->{'hashref'}{'custnum'} = $self->custnum;
3752 map { $_ } #behavior of sort undefined in scalar context
3753 sort { $a->_date <=> $b->_date }
3760 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3761 called automatically when the cust_pay method is used in a scalar context.
3767 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3768 my $sth = dbh->prepare($sql) or die dbh->errstr;
3769 $sth->execute($self->custnum) or die $sth->errstr;
3770 $sth->fetchrow_arrayref->[0];
3773 =item unapplied_cust_pay
3775 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3779 sub unapplied_cust_pay {
3783 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3789 =item cust_pay_pkgnum
3791 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3792 package when using experimental package balances.
3796 sub cust_pay_pkgnum {
3797 my( $self, $pkgnum ) = @_;
3798 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3799 sort { $a->_date <=> $b->_date }
3800 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3801 'pkgnum' => $pkgnum,
3808 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3814 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3815 sort { $a->_date <=> $b->_date }
3816 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3819 =item cust_pay_pending
3821 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3822 (without status "done").
3826 sub cust_pay_pending {
3828 return $self->num_cust_pay_pending unless wantarray;
3829 sort { $a->_date <=> $b->_date }
3830 qsearch( 'cust_pay_pending', {
3831 'custnum' => $self->custnum,
3832 'status' => { op=>'!=', value=>'done' },
3837 =item cust_pay_pending_attempt
3839 Returns all payment attempts / declined payments for this customer, as pending
3840 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3841 a corresponding payment (see L<FS::cust_pay>).
3845 sub cust_pay_pending_attempt {
3847 return $self->num_cust_pay_pending_attempt unless wantarray;
3848 sort { $a->_date <=> $b->_date }
3849 qsearch( 'cust_pay_pending', {
3850 'custnum' => $self->custnum,
3857 =item num_cust_pay_pending
3859 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3860 customer (without status "done"). Also called automatically when the
3861 cust_pay_pending method is used in a scalar context.
3865 sub num_cust_pay_pending {
3868 " SELECT COUNT(*) FROM cust_pay_pending ".
3869 " WHERE custnum = ? AND status != 'done' ",
3874 =item num_cust_pay_pending_attempt
3876 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3877 customer, with status "done" but without a corresp. Also called automatically when the
3878 cust_pay_pending method is used in a scalar context.
3882 sub num_cust_pay_pending_attempt {
3885 " SELECT COUNT(*) FROM cust_pay_pending ".
3886 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3893 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3899 map { $_ } #return $self->num_cust_refund unless wantarray;
3900 sort { $a->_date <=> $b->_date }
3901 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3904 =item display_custnum
3906 Returns the displayed customer number for this customer: agent_custid if
3907 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3911 sub display_custnum {
3914 return $self->agent_custid
3915 if $default_agent_custid && $self->agent_custid;
3917 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3921 sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
3922 } elsif ( $custnum_display_length ) {
3923 return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
3925 return $self->custnum;
3931 Returns a name string for this customer, either "Company (Last, First)" or
3938 my $name = $self->contact;
3939 $name = $self->company. " ($name)" if $self->company;
3943 =item batch_payment_payname
3945 Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company,
3946 based on if a company name exists and is the account being used a business account.
3950 sub batch_payment_payname {
3952 my $cust_pay_batch = shift;
3955 if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; }
3956 else { $name = $self->first .' '. $self->last; }
3958 $name = $self->company
3959 if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company);
3964 =item service_contact
3966 Returns the L<FS::contact> object for this customer that has the 'Service'
3967 contact class, or undef if there is no such contact. Deprecated; don't use
3972 sub service_contact {
3974 if ( !exists($self->{service_contact}) ) {
3975 my $classnum = $self->scalar_sql(
3976 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3977 ) || 0; #if it's zero, qsearchs will return nothing
3978 my $cust_contact = qsearchs('cust_contact', {
3979 'classnum' => $classnum,
3980 'custnum' => $self->custnum,
3982 $self->{service_contact} = $cust_contact->contact if $cust_contact;
3984 $self->{service_contact};
3989 Returns a name string for this (service/shipping) contact, either
3990 "Company (Last, First)" or "Last, First".
3997 my $name = $self->ship_contact;
3998 $name = $self->company. " ($name)" if $self->company;
4004 Returns a name string for this customer, either "Company" or "First Last".
4010 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4013 =item ship_name_short
4015 Returns a name string for this (service/shipping) contact, either "Company"
4020 sub ship_name_short {
4022 $self->service_contact
4023 ? $self->ship_contact_firstlast
4029 Returns this customer's full (billing) contact name only, "Last, First"
4035 $self->get('last'). ', '. $self->first;
4040 Returns this customer's full (shipping) contact name only, "Last, First"
4046 my $contact = $self->service_contact || $self;
4047 $contact->get('last') . ', ' . $contact->get('first');
4050 =item contact_firstlast
4052 Returns this customers full (billing) contact name only, "First Last".
4056 sub contact_firstlast {
4058 $self->first. ' '. $self->get('last');
4061 =item ship_contact_firstlast
4063 Returns this customer's full (shipping) contact name only, "First Last".
4067 sub ship_contact_firstlast {
4069 my $contact = $self->service_contact || $self;
4070 $contact->get('first') . ' '. $contact->get('last');
4073 sub bill_country_full {
4075 $self->bill_location->country_full;
4078 sub ship_country_full {
4080 $self->ship_location->country_full;
4083 =item county_state_county [ PREFIX ]
4085 Returns a string consisting of just the county, state and country.
4089 sub county_state_country {
4092 if ( @_ && $_[0] && $self->has_ship_address ) {
4093 $locationnum = $self->ship_locationnum;
4095 $locationnum = $self->bill_locationnum;
4097 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4098 $cust_location->county_state_country;
4101 =item geocode DATA_VENDOR
4103 Returns a value for the customer location as encoded by DATA_VENDOR.
4104 Currently this only makes sense for "CCH" as DATA_VENDOR.
4112 Returns a status string for this customer, currently:
4118 No packages have ever been ordered. Displayed as "No packages".
4122 Recurring packages all are new (not yet billed).
4126 One or more recurring packages is active.
4130 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
4134 All non-cancelled recurring packages are suspended.
4138 All recurring packages are cancelled.
4142 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4143 cust_main-status_module configuration option.
4147 sub status { shift->cust_status(@_); }
4151 return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4152 for my $status ( FS::cust_main->statuses() ) {
4153 my $method = $status.'_sql';
4154 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4155 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4156 $sth->execute( ($self->custnum) x $numnum )
4157 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4158 if ( $sth->fetchrow_arrayref->[0] ) {
4159 $self->hashref->{cust_status} = $status;
4165 =item is_status_delay_cancel
4167 Returns true if customer status is 'suspended'
4168 and all suspended cust_pkg return true for
4169 cust_pkg->is_status_delay_cancel.
4171 This is not a real status, this only meant for hacking display
4172 values, because otherwise treating the customer as suspended is
4173 really the whole point of the delay_cancel option.
4177 sub is_status_delay_cancel {
4179 return 0 unless $self->status eq 'suspended';
4180 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4181 return 0 unless $cust_pkg->is_status_delay_cancel;
4186 =item ucfirst_cust_status
4188 =item ucfirst_status
4190 Deprecated, use the cust_status_label method instead.
4192 Returns the status with the first character capitalized.
4196 sub ucfirst_status {
4197 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4198 local($ucfirst_nowarn) = 1;
4199 shift->ucfirst_cust_status(@_);
4202 sub ucfirst_cust_status {
4203 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4205 ucfirst($self->cust_status);
4208 =item cust_status_label
4212 Returns the display label for this status.
4216 sub status_label { shift->cust_status_label(@_); }
4218 sub cust_status_label {
4220 __PACKAGE__->statuslabels->{$self->cust_status};
4225 Returns a hex triplet color string for this customer's status.
4229 sub statuscolor { shift->cust_statuscolor(@_); }
4231 sub cust_statuscolor {
4233 __PACKAGE__->statuscolors->{$self->cust_status};
4236 =item tickets [ STATUS ]
4238 Returns an array of hashes representing the customer's RT tickets.
4240 An optional status (or arrayref or hashref of statuses) may be specified.
4246 my $status = ( @_ && $_[0] ) ? shift : '';
4248 my $num = $conf->config('cust_main-max_tickets') || 10;
4251 if ( $conf->config('ticket_system') ) {
4252 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4254 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4263 foreach my $priority (
4264 $conf->config('ticket_system-custom_priority_field-values'), ''
4266 last if scalar(@tickets) >= $num;
4268 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4269 $num - scalar(@tickets),
4280 =item appointments [ STATUS ]
4282 Returns an array of hashes representing the customer's RT tickets which
4289 my $status = ( @_ && $_[0] ) ? shift : '';
4291 return () unless $conf->config('ticket_system');
4293 my $queueid = $conf->config('ticket_system-appointment-queueid');
4295 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4304 # Return services representing svc_accts in customer support packages
4305 sub support_services {
4307 my %packages = map { $_ => 1 } $conf->config('support_packages');
4309 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4310 grep { $_->part_svc->svcdb eq 'svc_acct' }
4311 map { $_->cust_svc }
4312 grep { exists $packages{ $_->pkgpart } }
4313 $self->ncancelled_pkgs;
4317 # Return a list of latitude/longitude for one of the services (if any)
4318 sub service_coordinates {
4322 grep { $_->latitude && $_->longitude }
4324 map { $_->cust_svc }
4325 $self->ncancelled_pkgs;
4327 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4332 Returns a masked version of the named field
4337 my ($self,$field) = @_;
4341 'x'x(length($self->getfield($field))-4).
4342 substr($self->getfield($field), (length($self->getfield($field))-4));
4346 =item payment_history
4348 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4349 cust_credit and cust_refund objects. Each hashref has the following fields:
4351 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4353 I<date> - value of _date field, unix timestamp
4355 I<date_pretty> - user-friendly date
4357 I<description> - user-friendly description of item
4359 I<amount> - impact of item on user's balance
4360 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4361 Not to be confused with the native 'amount' field in cust_credit, see below.
4363 I<amount_pretty> - includes money char
4365 I<balance> - customer balance, chronologically as of this item
4367 I<balance_pretty> - includes money char
4369 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4371 I<paid> - amount paid for cust_pay records, undef for other types
4373 I<credit> - amount credited for cust_credit records, undef for other types.
4374 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4376 I<refund> - amount refunded for cust_refund records, undef for other types
4378 The four table-specific keys always have positive values, whether they reflect charges or payments.
4380 The following options may be passed to this method:
4382 I<line_items> - if true, returns charges ('Line item') rather than invoices
4384 I<start_date> - unix timestamp, only include records on or after.
4385 If specified, an item of type 'Previous' will also be included.
4386 It does not have table-specific fields.
4388 I<end_date> - unix timestamp, only include records before
4390 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4392 I<conf> - optional already-loaded FS::Conf object.
4396 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4397 # and also for sending customer statements, which should both be kept customer-friendly.
4398 # If you add anything that shouldn't be passed on through the API or exposed
4399 # to customers, add a new option to include it, don't include it by default
4400 sub payment_history {
4402 my $opt = ref($_[0]) ? $_[0] : { @_ };
4404 my $conf = $$opt{'conf'} || new FS::Conf;
4405 my $money_char = $conf->config("money_char") || '$',
4407 #first load entire history,
4408 #need previous to calculate previous balance
4409 #loading after end_date shouldn't hurt too much?
4411 if ( $$opt{'line_items'} ) {
4413 foreach my $cust_bill ( $self->cust_bill ) {
4416 'type' => 'Line item',
4417 'description' => $_->desc( $self->locale ).
4418 ( $_->sdate && $_->edate
4419 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4420 ' To '. time2str('%d-%b-%Y', $_->edate)
4423 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4424 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4425 'date' => $cust_bill->_date,
4426 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4428 foreach $cust_bill->cust_bill_pkg;
4435 'type' => 'Invoice',
4436 'description' => 'Invoice #'. $_->display_invnum,
4437 'amount' => sprintf('%.2f', $_->charged ),
4438 'charged' => sprintf('%.2f', $_->charged ),
4439 'date' => $_->_date,
4440 'date_pretty' => $self->time2str_local('short', $_->_date ),
4442 foreach $self->cust_bill;
4447 'type' => 'Payment',
4448 'description' => 'Payment', #XXX type
4449 'amount' => sprintf('%.2f', 0 - $_->paid ),
4450 'paid' => sprintf('%.2f', $_->paid ),
4451 'date' => $_->_date,
4452 'date_pretty' => $self->time2str_local('short', $_->_date ),
4454 foreach $self->cust_pay;
4458 'description' => 'Credit', #more info?
4459 'amount' => sprintf('%.2f', 0 -$_->amount ),
4460 'credit' => sprintf('%.2f', $_->amount ),
4461 'date' => $_->_date,
4462 'date_pretty' => $self->time2str_local('short', $_->_date ),
4464 foreach $self->cust_credit;
4468 'description' => 'Refund', #more info? type, like payment?
4469 'amount' => $_->refund,
4470 'refund' => $_->refund,
4471 'date' => $_->_date,
4472 'date_pretty' => $self->time2str_local('short', $_->_date ),
4474 foreach $self->cust_refund;
4476 #put it all in chronological order
4477 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4479 #calculate balance, filter items outside date range
4483 foreach my $item (@history) {
4484 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4485 $balance += $$item{'amount'};
4486 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4487 $previous += $$item{'amount'};
4490 $$item{'balance'} = sprintf("%.2f",$balance);
4491 foreach my $key ( qw(amount balance) ) {
4492 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4497 # start with previous balance, if there was one
4500 'type' => 'Previous',
4501 'description' => 'Previous balance',
4502 'amount' => sprintf("%.2f",$previous),
4503 'balance' => sprintf("%.2f",$previous),
4504 'date' => $$opt{'start_date'},
4505 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4507 #false laziness with above
4508 foreach my $key ( qw(amount balance) ) {
4509 $$item{$key.'_pretty'} = $$item{$key};
4510 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4512 unshift(@out,$item);
4515 @out = reverse @history if $$opt{'reverse_sort'};
4520 =item save_cust_payby
4522 Saves a new cust_payby for this customer, replacing an existing entry only
4523 in select circumstances. Does not validate input.
4525 If auto is specified, marks this as the customer's primary method, or the
4526 specified weight. Existing payment methods have their weight incremented as
4529 If bill_location is specified with auto, also sets location in cust_main.
4531 Will not insert complete duplicates of existing records, or records in which the
4532 only difference from an existing record is to turn off automatic payment (will
4533 return without error.) Will replace existing records in which the only difference
4534 is to add a value to a previously empty preserved field and/or turn on automatic payment.
4535 Fields marked as preserved are optional, and existing values will not be overwritten with
4536 blanks when replacing.
4538 Accepts the following named parameters:
4548 save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
4552 optional, set higher than 1 for secondary, etc.
4560 optional, but should be specified for anything that might be tokenized, will be preserved when replacing
4568 optional, will be preserved when replacing
4576 CARD only, required, FS::cust_location object
4578 =item paystart_month
4580 CARD only, optional, will be preserved when replacing
4584 CARD only, optional, will be preserved when replacing
4588 CARD only, optional, will be preserved when replacing
4592 CARD only, only used if conf cvv-save is set appropriately
4602 =item saved_cust_payby
4604 scalar reference, for returning saved object
4610 #The code for this option is in place, but it's not currently used
4614 # existing cust_payby object to be replaced (must match custnum)
4616 # stateid/stateid_state/ss are not currently supported in cust_payby,
4617 # might not even work properly in 4.x, but will need to work here if ever added
4619 sub save_cust_payby {
4623 my $old = $opt{'replace'};
4624 my $new = new FS::cust_payby { $old ? $old->hash : () };
4625 return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum;
4626 $new->set( 'custnum' => $self->custnum );
4628 my $payby = $opt{'payment_payby'};
4629 return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK'));
4631 # don't allow turning off auto when replacing
4632 $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/;
4634 my @check_existing; # payby relevant to this payment_payby
4636 # set payby based on auto
4637 if ( $payby eq 'CARD' ) {
4638 $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) );
4639 @check_existing = qw( CARD DCRD );
4640 } elsif ( $payby eq 'CHEK' ) {
4641 $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) );
4642 @check_existing = qw( CHEK DCHK );
4645 $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' );
4648 $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized
4649 $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask
4650 $new->set( 'payname' => $opt{'payname'} );
4651 $new->set( 'payip' => $opt{'payip'} ); # will be preserved below
4653 my $conf = new FS::Conf;
4655 # compare to FS::cust_main::realtime_bop - check both to make sure working correctly
4656 if ( $payby eq 'CARD' &&
4657 ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save'))
4658 || $conf->exists('business-onlinepayment-verification')
4661 $new->set( 'paycvv' => $opt{'paycvv'} );
4663 $new->set( 'paycvv' => '');
4666 local $SIG{HUP} = 'IGNORE';
4667 local $SIG{INT} = 'IGNORE';
4668 local $SIG{QUIT} = 'IGNORE';
4669 local $SIG{TERM} = 'IGNORE';
4670 local $SIG{TSTP} = 'IGNORE';
4671 local $SIG{PIPE} = 'IGNORE';
4673 my $oldAutoCommit = $FS::UID::AutoCommit;
4674 local $FS::UID::AutoCommit = 0;
4677 # set fields specific to payment_payby
4678 if ( $payby eq 'CARD' ) {
4679 if ($opt{'bill_location'}) {
4680 $opt{'bill_location'}->set('custnum' => $self->custnum);
4681 my $error = $opt{'bill_location'}->find_or_insert;
4683 $dbh->rollback if $oldAutoCommit;
4686 $new->set( 'locationnum' => $opt{'bill_location'}->locationnum );
4688 foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) {
4689 $new->set( $field => $opt{$field} );
4692 foreach my $field ( qw(paytype paystate) ) {
4693 $new->set( $field => $opt{$field} );
4697 # other cust_payby to compare this to
4698 my @existing = $self->cust_payby(@check_existing);
4700 # fields that can overwrite blanks with values, but not values with blanks
4701 my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip );
4703 my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby
4705 # generally, we don't want to overwrite existing cust_payby with this,
4706 # but we can replace if we're only marking it auto or adding a preserved field
4707 # and we can avoid saving a total duplicate or merely turning off auto
4709 foreach my $cust_payby (@existing) {
4710 # check fields that absolutely should not change
4711 foreach my $field ($new->fields) {
4712 next if grep(/^$field$/, qw( custpaybynum payby weight ) );
4713 next if grep(/^$field$/, @preserve );
4714 next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
4715 # check if paymask exists, if so stop and don't save, no need for a duplicate.
4716 return '' if $new->get('paymask') eq $cust_payby->get('paymask');
4718 # now check fields that can replace if one value is blank
4720 foreach my $field (@preserve) {
4722 ( $new->get($field) and !$cust_payby->get($field) ) or
4723 ( $cust_payby->get($field) and !$new->get($field) )
4725 # prevention of overwriting values with blanks happens farther below
4727 } elsif ( $new->get($field) ne $cust_payby->get($field) ) {
4731 unless ( $replace ) {
4732 # nearly identical, now check weight
4733 if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) {
4734 # ignore identical cust_payby, and ignore attempts to turn off auto
4735 # no need to save or re-weight cust_payby (but still need to update/commit $self)
4736 $skip_cust_payby = 1;
4739 # otherwise, only change is to mark this as primary
4741 # if we got this far, we're definitely replacing
4748 $new->set( 'custpaybynum' => $old->custpaybynum );
4749 # don't turn off automatic payment (but allow it to be turned on)
4750 if ($new->payby =~ /^D/ and $new->payby ne $old->payby) {
4752 $new->set( 'payby' => $old->payby );
4753 $new->set( 'weight' => 1 );
4755 # make sure we're not overwriting values with blanks
4756 foreach my $field (@preserve) {
4757 if ( $old->get($field) and !$new->get($field) ) {
4758 $new->set( $field => $old->get($field) );
4763 # only overwrite cust_main bill_location if auto
4764 if ($opt{'auto'} && $opt{'bill_location'}) {
4765 $self->set('bill_location' => $opt{'bill_location'});
4766 my $error = $self->replace;
4768 $dbh->rollback if $oldAutoCommit;
4773 # done with everything except reweighting and saving cust_payby
4774 # still need to commit changes to cust_main and cust_location
4775 if ($skip_cust_payby) {
4776 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4780 # re-weight existing primary cust_pay for this payby
4782 foreach my $cust_payby (@existing) {
4783 # relies on cust_payby return order
4784 last unless $cust_payby->payby !~ /^D/;
4785 last if $cust_payby->weight > 1;
4786 next if $new->custpaybynum eq $cust_payby->custpaybynum;
4787 next if $cust_payby->weight < ($opt{'weight'} || 1);
4788 $cust_payby->weight( $cust_payby->weight + 1 );
4789 my $error = $cust_payby->replace;
4791 $dbh->rollback if $oldAutoCommit;
4792 return "Error reweighting cust_payby: $error";
4797 # finally, save cust_payby
4798 my $error = $old ? $new->replace($old) : $new->insert;
4800 $dbh->rollback if $oldAutoCommit;
4804 ${$opt{'saved_cust_payby'}} = $new
4805 if $opt{'saved_cust_payby'};
4807 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4812 =item remove_cvv_from_cust_payby PAYINFO
4814 Removes paycvv from associated cust_payby with matching PAYINFO.
4818 sub remove_cvv_from_cust_payby {
4819 my ($self,$payinfo) = @_;
4821 my $oldAutoCommit = $FS::UID::AutoCommit;
4822 local $FS::UID::AutoCommit = 0;
4825 foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) {
4826 next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo
4827 $cust_payby->paycvv('');
4828 my $error = $cust_payby->replace;
4830 $dbh->rollback if $oldAutoCommit;
4835 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4841 =head1 CLASS METHODS
4847 Class method that returns the list of possible status strings for customers
4848 (see L<the status method|/status>). For example:
4850 @statuses = FS::cust_main->statuses();
4856 keys %{ $self->statuscolors };
4859 =item cust_status_sql
4861 Returns an SQL fragment to determine the status of a cust_main record, as a
4866 sub cust_status_sql {
4868 for my $status ( FS::cust_main->statuses() ) {
4869 my $method = $status.'_sql';
4870 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4879 Returns an SQL expression identifying prospective cust_main records (customers
4880 with no packages ever ordered)
4884 use vars qw($select_count_pkgs);
4885 $select_count_pkgs =
4886 "SELECT COUNT(*) FROM cust_pkg
4887 WHERE cust_pkg.custnum = cust_main.custnum";
4889 sub select_count_pkgs_sql {
4894 " 0 = ( $select_count_pkgs ) ";
4899 Returns an SQL expression identifying ordered cust_main records (customers with
4900 no active packages, but recurring packages not yet setup or one time charges
4906 FS::cust_main->none_active_sql.
4907 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4912 Returns an SQL expression identifying active cust_main records (customers with
4913 active recurring packages).
4918 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4921 =item none_active_sql
4923 Returns an SQL expression identifying cust_main records with no active
4924 recurring packages. This includes customers of status prospect, ordered,
4925 inactive, and suspended.
4929 sub none_active_sql {
4930 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4935 Returns an SQL expression identifying inactive cust_main records (customers with
4936 no active recurring packages, but otherwise unsuspended/uncancelled).
4941 FS::cust_main->none_active_sql.
4942 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4948 Returns an SQL expression identifying suspended cust_main records.
4953 sub suspended_sql { susp_sql(@_); }
4955 FS::cust_main->none_active_sql.
4956 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4962 Returns an SQL expression identifying cancelled cust_main records.
4966 sub cancel_sql { shift->cancelled_sql(@_); }
4969 =item uncancelled_sql
4971 Returns an SQL expression identifying un-cancelled cust_main records.
4975 sub uncancelled_sql { uncancel_sql(@_); }
4978 "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
4983 Returns an SQL fragment to retreive the balance.
4988 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4989 WHERE cust_bill.custnum = cust_main.custnum )
4990 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4991 WHERE cust_pay.custnum = cust_main.custnum )
4992 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4993 WHERE cust_credit.custnum = cust_main.custnum )
4994 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4995 WHERE cust_refund.custnum = cust_main.custnum )
4998 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
5000 Returns an SQL fragment to retreive the balance for this customer, optionally
5001 considering invoices with date earlier than START_TIME, and not
5002 later than END_TIME (total_owed_date minus total_unapplied_credits minus
5003 total_unapplied_payments).
5005 Times are specified as SQL fragments or numeric
5006 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5007 L<Date::Parse> for conversion functions. The empty string can be passed
5008 to disable that time constraint completely.
5010 Available options are:
5014 =item unapplied_date
5016 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)
5021 set to true to remove all customer comparison clauses, for totals
5026 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5031 JOIN clause (typically used with the total option)
5035 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
5036 time will be ignored. Note that START_TIME and END_TIME only limit the date
5037 range for invoices and I<unapplied> payments, credits, and refunds.
5043 sub balance_date_sql {
5044 my( $class, $start, $end, %opt ) = @_;
5046 my $cutoff = $opt{'cutoff'};
5048 my $owed = FS::cust_bill->owed_sql($cutoff);
5049 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
5050 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
5051 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5053 my $j = $opt{'join'} || '';
5055 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5056 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5057 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5058 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5060 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5061 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5062 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5063 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5068 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
5070 Returns an SQL fragment to retreive the total unapplied payments for this
5071 customer, only considering payments with date earlier than START_TIME, and
5072 optionally not later than END_TIME.
5074 Times are specified as SQL fragments or numeric
5075 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5076 L<Date::Parse> for conversion functions. The empty string can be passed
5077 to disable that time constraint completely.
5079 Available options are:
5083 sub unapplied_payments_date_sql {
5084 my( $class, $start, $end, %opt ) = @_;
5086 my $cutoff = $opt{'cutoff'};
5088 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5090 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
5091 'unapplied_date'=>1 );
5093 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
5096 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5098 Helper method for balance_date_sql; name (and usage) subject to change
5099 (suggestions welcome).
5101 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5102 cust_refund, cust_credit or cust_pay).
5104 If TABLE is "cust_bill" or the unapplied_date option is true, only
5105 considers records with date earlier than START_TIME, and optionally not
5106 later than END_TIME .
5110 sub _money_table_where {
5111 my( $class, $table, $start, $end, %opt ) = @_;
5114 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5115 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5116 push @where, "$table._date <= $start" if defined($start) && length($start);
5117 push @where, "$table._date > $end" if defined($end) && length($end);
5119 push @where, @{$opt{'where'}} if $opt{'where'};
5120 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5126 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5127 use FS::cust_main::Search;
5130 FS::cust_main::Search->search(@_);
5139 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5141 Generates a templated notification to the customer (see L<Text::Template>).
5143 OPTIONS is a hash and may include
5145 I<extra_fields> - a hashref of name/value pairs which will be substituted
5146 into the template. These values may override values mentioned below
5147 and those from the customer record.
5149 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5151 The following variables are available in the template instead of or in addition
5152 to the fields of the customer record.
5154 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5158 # a lot like cust_bill::print_latex
5159 sub generate_letter {
5160 my ($self, $template, %options) = @_;
5162 warn "Template $template does not exist" && return
5163 unless $conf->exists($template) || $options{'template_text'};
5165 my $template_source = $options{'template_text'}
5166 ? [ $options{'template_text'} ]
5167 : [ map "$_\n", $conf->config($template) ];
5169 my $letter_template = new Text::Template
5171 SOURCE => $template_source,
5172 DELIMITERS => [ '[@--', '--@]' ],
5174 or die "can't create new Text::Template object: Text::Template::ERROR";
5176 $letter_template->compile()
5177 or die "can't compile template: Text::Template::ERROR";
5179 my %letter_data = map { $_ => $self->$_ } $self->fields;
5181 for (keys %{$options{extra_fields}}){
5182 $letter_data{$_} = $options{extra_fields}->{$_};
5185 unless(exists($letter_data{returnaddress})){
5186 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5187 $self->agent_template)
5189 if ( length($retadd) ) {
5190 $letter_data{returnaddress} = $retadd;
5191 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5192 $letter_data{returnaddress} =
5193 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5197 ( $conf->config('company_name', $self->agentnum),
5198 $conf->config('company_address', $self->agentnum),
5202 $letter_data{returnaddress} = '~';
5206 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5208 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5210 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5212 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5216 ) or die "can't open temp file: $!\n";
5217 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5218 or die "can't write temp file: $!\n";
5220 $letter_data{'logo_file'} = $lh->filename;
5222 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5226 ) or die "can't open temp file: $!\n";
5228 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5230 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5231 return ($1, $letter_data{'logo_file'});
5235 =item print_ps TEMPLATE
5237 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5243 my($file, $lfile) = $self->generate_letter(@_);
5244 my $ps = FS::Misc::generate_ps($file);
5245 unlink($file.'.tex');
5251 =item print TEMPLATE
5253 Prints the filled in template.
5255 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5259 sub queueable_print {
5262 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5263 or die "invalid customer number: " . $opt{custnum};
5265 #do not backport this change to 3.x
5266 # my $error = $self->print( { 'template' => $opt{template} } );
5267 my $error = $self->print( $opt{'template'} );
5268 die $error if $error;
5272 my ($self, $template) = (shift, shift);
5274 [ $self->print_ps($template) ],
5275 'agentnum' => $self->agentnum,
5279 #these three subs should just go away once agent stuff is all config overrides
5281 sub agent_template {
5283 $self->_agent_plandata('agent_templatename');
5286 sub agent_invoice_from {
5288 $self->_agent_plandata('agent_invoice_from');
5291 sub _agent_plandata {
5292 my( $self, $option ) = @_;
5294 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5295 #agent-specific Conf
5297 use FS::part_event::Condition;
5299 my $agentnum = $self->agentnum;
5301 my $regexp = regexp_sql();
5303 my $part_event_option =
5305 'select' => 'part_event_option.*',
5306 'table' => 'part_event_option',
5308 LEFT JOIN part_event USING ( eventpart )
5309 LEFT JOIN part_event_option AS peo_agentnum
5310 ON ( part_event.eventpart = peo_agentnum.eventpart
5311 AND peo_agentnum.optionname = 'agentnum'
5312 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5314 LEFT JOIN part_event_condition
5315 ON ( part_event.eventpart = part_event_condition.eventpart
5316 AND part_event_condition.conditionname = 'cust_bill_age'
5318 LEFT JOIN part_event_condition_option
5319 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5320 AND part_event_condition_option.optionname = 'age'
5323 #'hashref' => { 'optionname' => $option },
5324 #'hashref' => { 'part_event_option.optionname' => $option },
5326 " WHERE part_event_option.optionname = ". dbh->quote($option).
5327 " AND action = 'cust_bill_send_agent' ".
5328 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5329 " AND peo_agentnum.optionname = 'agentnum' ".
5330 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5332 CASE WHEN part_event_condition_option.optionname IS NULL
5334 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5336 , part_event.weight".
5340 unless ( $part_event_option ) {
5341 return $self->agent->invoice_template || ''
5342 if $option eq 'agent_templatename';
5346 $part_event_option->optionvalue;
5350 sub process_o2m_qsearch {
5353 return qsearch($table, @_) unless $table eq 'contact';
5355 my $hashref = shift;
5356 my %hash = %$hashref;
5357 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5358 or die 'guru meditation #4343';
5360 qsearch({ 'table' => 'contact',
5361 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5362 'hashref' => \%hash,
5363 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5364 " cust_contact.custnum = $custnum "
5368 sub process_o2m_qsearchs {
5371 return qsearchs($table, @_) unless $table eq 'contact';
5373 my $hashref = shift;
5374 my %hash = %$hashref;
5375 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5376 or die 'guru meditation #2121';
5378 qsearchs({ 'table' => 'contact',
5379 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5380 'hashref' => \%hash,
5381 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5382 " cust_contact.custnum = $custnum "
5386 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5388 Subroutine (not a method), designed to be called from the queue.
5390 Takes a list of options and values.
5392 Pulls up the customer record via the custnum option and calls bill_and_collect.
5397 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5399 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5400 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5402 #without this errors don't get rolled back
5403 $args{'fatal'} = 1; # runs from job queue, will be caught
5405 $cust_main->bill_and_collect( %args );
5408 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5410 Like queued_bill, but instead of C<bill_and_collect>, just runs the
5411 C<collect> part. This is used in batch tax calculation, where invoice
5412 generation and collection events have to be completely separated.
5416 sub queued_collect {
5418 my $cust_main = FS::cust_main->by_key($args{'custnum'});
5420 $cust_main->collect(%args);
5423 sub process_bill_and_collect {
5426 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5427 or die "custnum '$param->{custnum}' not found!\n";
5428 $param->{'job'} = $job;
5429 $param->{'fatal'} = 1; # runs from job queue, will be caught
5430 $param->{'retry'} = 1;
5433 eval { $cust_main->bill_and_collect( %$param) };
5435 die $@ =~ /cancel_pkgs cannot be run inside a transaction/
5436 ? "Bill Now unavailable for customer with pending package expiration\n"
5441 =item pending_invoice_count
5443 Return number of cust_bill with pending=Y for this customer
5447 sub pending_invoice_count {
5448 FS::cust_bill->count( 'custnum = '.shift->custnum."AND pending = 'Y'" );
5451 #starting to take quite a while for big dbs
5452 # (JRNL: journaled so it only happens once per database)
5453 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5454 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5455 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5456 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5457 # JRNL leading/trailing spaces in first, last, company
5458 # JRNL migrate to cust_payby
5459 # - otaker upgrade? journal and call it good? (double check to make sure
5460 # we're not still setting otaker here)
5462 #only going to get worse with new location stuff...
5464 sub _upgrade_data { #class method
5465 my ($class, %opts) = @_;
5467 my @statements = ();
5469 #this seems to be the only expensive one.. why does it take so long?
5470 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5472 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL';
5473 FS::upgrade_journal->set_done('cust_main__signupdate');
5477 foreach my $sql ( @statements ) {
5478 my $sth = dbh->prepare($sql) or die dbh->errstr;
5479 $sth->execute or die $sth->errstr;
5480 #warn ( (time - $t). " seconds\n" );
5484 local($ignore_expired_card) = 1;
5485 local($ignore_banned_card) = 1;
5486 local($skip_fuzzyfiles) = 1;
5487 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5489 FS::cust_main::Location->_upgrade_data(%opts);
5491 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5493 foreach my $cust_main ( qsearch({
5494 'table' => 'cust_main',
5496 'extra_sql' => 'WHERE '.
5498 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5499 qw( first last company )
5502 my $error = $cust_main->replace;
5503 die $error if $error;
5506 FS::upgrade_journal->set_done('cust_main__trimspaces');
5510 $class->_upgrade_otaker(%opts);
5512 # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
5513 # existing records will be encrypted in queueable_upgrade (below)
5514 unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
5515 eval "use FS::Setup";
5517 FS::Setup::enable_encryption();
5522 sub queueable_upgrade {
5525 ### encryption gets turned on in _upgrade_data, above
5527 eval "use FS::upgrade_journal";
5530 # prior to 2013 (commit f16665c9) payinfo was stored in history if not
5531 # encrypted, clear that out before encrypting/tokenizing anything else
5532 if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
5533 foreach my $table (qw(
5534 cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
5537 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
5538 my $sth = dbh->prepare($sql) or die dbh->errstr;
5539 $sth->execute or die $sth->errstr;
5541 FS::upgrade_journal->set_done('clear_payinfo_history');
5544 # fix Tokenized paycardtype and encrypt old records
5545 if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
5546 || ! FS::upgrade_journal->is_done('encryption_check')
5550 # allow replacement of closed cust_pay/cust_refund records
5551 local $FS::payinfo_Mixin::allow_closed_replace = 1;
5553 # because it looks like nothing's changing
5554 local $FS::Record::no_update_diff = 1;
5556 # commit everything immediately
5557 local $FS::UID::AutoCommit = 1;
5559 # encrypt what's there
5560 foreach my $table (qw(
5561 cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
5563 my $tclass = 'FS::'.$table;
5567 my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)
5569 my $record = $tclass->by_key($recnum);
5570 next unless $record; # small chance it's been deleted, that's ok
5571 next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
5572 # window for possible conflict is practically nonexistant,
5573 # but just in case...
5574 $record = $record->select_for_update;
5575 if (!$record->custnum && $table eq 'cust_pay_pending') {
5576 $record->set('custnum_pending',1);
5578 $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
5580 local($ignore_expired_card) = 1;
5581 local($ignore_banned_card) = 1;
5582 local($skip_fuzzyfiles) = 1;
5583 local($import) = 1;#prevent automatic geocoding (need its own variable?)
5585 my $error = $record->replace;
5586 die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
5590 FS::upgrade_journal->set_done('paycardtype_Tokenized');
5591 FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
5594 # now that everything's encrypted, tokenize...
5595 FS::cust_main::Billing_Realtime::token_check(@_);
5598 # not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
5599 # cust_payby might get deleted while this runs
5601 sub _upgrade_next_recnum {
5602 my ($dbh,$table,$lastrecnum,$recnums) = @_;
5603 my $recnum = shift @$recnums;
5604 return $recnum if $recnum;
5605 my $tclass = 'FS::'.$table;
5606 my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : '';
5607 my $sql = 'SELECT '.$tclass->primary_key.
5609 ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
5610 " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
5611 " AND ( length(payinfo) < 80$paycardtypecheck ) ".
5612 ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
5613 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
5614 $sth->execute() or die $sth->errstr;
5616 while (my $rec = $sth->fetchrow_hashref) {
5617 push @$recnums, $rec->{$tclass->primary_key};
5620 $$lastrecnum = $$recnums[-1];
5621 return shift @$recnums;
5630 The delete method should possibly take an FS::cust_main object reference
5631 instead of a scalar customer number.
5633 Bill and collect options should probably be passed as references instead of a
5636 There should probably be a configuration file with a list of allowed credit
5639 No multiple currency support (probably a larger project than just this module).
5641 Birthdates rely on negative epoch values.
5643 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5647 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5648 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5649 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.