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";
747 warn " exporting\n" if $DEBUG > 1;
749 my $export_args = $options{'export_args'} || [];
752 map qsearch( 'part_export', {exportnum=>$_} ),
753 $conf->config('cust_main-exports'); #, $agentnum
755 foreach my $part_export ( @part_export ) {
756 my $error = $part_export->export_insert($self, @$export_args);
758 $dbh->rollback if $oldAutoCommit;
759 return "exporting to ". $part_export->exporttype.
760 " (transaction rolled back): $error";
764 #foreach my $depend_jobnum ( @$depend_jobnums ) {
765 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
767 # foreach my $jobnum ( @jobnums ) {
768 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
769 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
771 # my $error = $queue->depend_insert($depend_jobnum);
773 # $dbh->rollback if $oldAutoCommit;
774 # return "error queuing job dependancy: $error";
781 #if ( exists $options{'jobnums'} ) {
782 # push @{ $options{'jobnums'} }, @jobnums;
785 warn " insert complete; committing transaction\n"
788 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
793 use File::CounterFile;
794 sub auto_agent_custid {
797 my $format = $conf->config('cust_main-auto_agent_custid');
799 if ( $format eq '1YMMXXXXXXXX' ) {
801 my $counter = new File::CounterFile 'cust_main.agent_custid';
804 my $ym = 100000000000 + time2str('%y%m00000000', time);
805 if ( $ym > $counter->value ) {
806 $counter->{'value'} = $agent_custid = $ym;
807 $counter->{'updated'} = 1;
809 $agent_custid = $counter->inc;
815 die "Unknown cust_main-auto_agent_custid format: $format";
818 $self->agent_custid($agent_custid);
822 =item PACKAGE METHODS
824 Documentation on customer package methods has been moved to
825 L<FS::cust_main::Packages>.
827 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
829 Recharges this (existing) customer with the specified prepaid card (see
830 L<FS::prepay_credit>), specified either by I<identifier> or as an
831 FS::prepay_credit object. If there is an error, returns the error, otherwise
834 Optionally, five scalar references can be passed as well. They will have their
835 values filled in with the amount, number of seconds, and number of upload,
836 download, and total bytes applied by this prepaid card.
840 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
841 #the only place that uses these args
842 sub recharge_prepay {
843 my( $self, $prepay_credit, $amountref, $secondsref,
844 $upbytesref, $downbytesref, $totalbytesref ) = @_;
846 local $SIG{HUP} = 'IGNORE';
847 local $SIG{INT} = 'IGNORE';
848 local $SIG{QUIT} = 'IGNORE';
849 local $SIG{TERM} = 'IGNORE';
850 local $SIG{TSTP} = 'IGNORE';
851 local $SIG{PIPE} = 'IGNORE';
853 my $oldAutoCommit = $FS::UID::AutoCommit;
854 local $FS::UID::AutoCommit = 0;
857 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
859 my $error = $self->get_prepay( $prepay_credit,
860 'amount_ref' => \$amount,
861 'seconds_ref' => \$seconds,
862 'upbytes_ref' => \$upbytes,
863 'downbytes_ref' => \$downbytes,
864 'totalbytes_ref' => \$totalbytes,
866 || $self->increment_seconds($seconds)
867 || $self->increment_upbytes($upbytes)
868 || $self->increment_downbytes($downbytes)
869 || $self->increment_totalbytes($totalbytes)
870 || $self->insert_cust_pay_prepay( $amount,
872 ? $prepay_credit->identifier
877 $dbh->rollback if $oldAutoCommit;
881 if ( defined($amountref) ) { $$amountref = $amount; }
882 if ( defined($secondsref) ) { $$secondsref = $seconds; }
883 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
884 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
885 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
887 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
892 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
894 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
895 specified either by I<identifier> or as an FS::prepay_credit object.
897 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
898 incremented by the values of the prepaid card.
900 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
901 check or set this customer's I<agentnum>.
903 If there is an error, returns the error, otherwise returns false.
909 my( $self, $prepay_credit, %opt ) = @_;
911 local $SIG{HUP} = 'IGNORE';
912 local $SIG{INT} = 'IGNORE';
913 local $SIG{QUIT} = 'IGNORE';
914 local $SIG{TERM} = 'IGNORE';
915 local $SIG{TSTP} = 'IGNORE';
916 local $SIG{PIPE} = 'IGNORE';
918 my $oldAutoCommit = $FS::UID::AutoCommit;
919 local $FS::UID::AutoCommit = 0;
922 unless ( ref($prepay_credit) ) {
924 my $identifier = $prepay_credit;
926 $prepay_credit = qsearchs(
928 { 'identifier' => $identifier },
933 unless ( $prepay_credit ) {
934 $dbh->rollback if $oldAutoCommit;
935 return "Invalid prepaid card: ". $identifier;
940 if ( $prepay_credit->agentnum ) {
941 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
942 $dbh->rollback if $oldAutoCommit;
943 return "prepaid card not valid for agent ". $self->agentnum;
945 $self->agentnum($prepay_credit->agentnum);
948 my $error = $prepay_credit->delete;
950 $dbh->rollback if $oldAutoCommit;
951 return "removing prepay_credit (transaction rolled back): $error";
954 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
955 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
957 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
962 =item increment_upbytes SECONDS
964 Updates this customer's single or primary account (see L<FS::svc_acct>) by
965 the specified number of upbytes. If there is an error, returns the error,
966 otherwise returns false.
970 sub increment_upbytes {
971 _increment_column( shift, 'upbytes', @_);
974 =item increment_downbytes SECONDS
976 Updates this customer's single or primary account (see L<FS::svc_acct>) by
977 the specified number of downbytes. If there is an error, returns the error,
978 otherwise returns false.
982 sub increment_downbytes {
983 _increment_column( shift, 'downbytes', @_);
986 =item increment_totalbytes SECONDS
988 Updates this customer's single or primary account (see L<FS::svc_acct>) by
989 the specified number of totalbytes. If there is an error, returns the error,
990 otherwise returns false.
994 sub increment_totalbytes {
995 _increment_column( shift, 'totalbytes', @_);
998 =item increment_seconds SECONDS
1000 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1001 the specified number of seconds. If there is an error, returns the error,
1002 otherwise returns false.
1006 sub increment_seconds {
1007 _increment_column( shift, 'seconds', @_);
1010 =item _increment_column AMOUNT
1012 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1013 the specified number of seconds or bytes. If there is an error, returns
1014 the error, otherwise returns false.
1018 sub _increment_column {
1019 my( $self, $column, $amount ) = @_;
1020 warn "$me increment_column called: $column, $amount\n"
1023 return '' unless $amount;
1025 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1026 $self->ncancelled_pkgs;
1028 if ( ! @cust_pkg ) {
1029 return 'No packages with primary or single services found'.
1030 ' to apply pre-paid time';
1031 } elsif ( scalar(@cust_pkg) > 1 ) {
1032 #maybe have a way to specify the package/account?
1033 return 'Multiple packages found to apply pre-paid time';
1036 my $cust_pkg = $cust_pkg[0];
1037 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1041 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1043 if ( ! @cust_svc ) {
1044 return 'No account found to apply pre-paid time';
1045 } elsif ( scalar(@cust_svc) > 1 ) {
1046 return 'Multiple accounts found to apply pre-paid time';
1049 my $svc_acct = $cust_svc[0]->svc_x;
1050 warn " found service svcnum ". $svc_acct->pkgnum.
1051 ' ('. $svc_acct->email. ")\n"
1054 $column = "increment_$column";
1055 $svc_acct->$column($amount);
1059 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1061 Inserts a prepayment in the specified amount for this customer. An optional
1062 second argument can specify the prepayment identifier for tracking purposes.
1063 If there is an error, returns the error, otherwise returns false.
1067 sub insert_cust_pay_prepay {
1068 shift->insert_cust_pay('PREP', @_);
1071 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1073 Inserts a cash payment in the specified amount for this customer. An optional
1074 second argument can specify the payment identifier for tracking purposes.
1075 If there is an error, returns the error, otherwise returns false.
1079 sub insert_cust_pay_cash {
1080 shift->insert_cust_pay('CASH', @_);
1083 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1085 Inserts a Western Union payment in the specified amount for this customer. An
1086 optional second argument can specify the prepayment identifier for tracking
1087 purposes. If there is an error, returns the error, otherwise returns false.
1091 sub insert_cust_pay_west {
1092 shift->insert_cust_pay('WEST', @_);
1095 sub insert_cust_pay {
1096 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1097 my $payinfo = scalar(@_) ? shift : '';
1099 my $cust_pay = new FS::cust_pay {
1100 'custnum' => $self->custnum,
1101 'paid' => sprintf('%.2f', $amount),
1102 #'_date' => #date the prepaid card was purchased???
1104 'payinfo' => $payinfo,
1110 =item delete [ OPTION => VALUE ... ]
1112 This deletes the customer. If there is an error, returns the error, otherwise
1115 This will completely remove all traces of the customer record. This is not
1116 what you want when a customer cancels service; for that, cancel all of the
1117 customer's packages (see L</cancel>).
1119 If the customer has any uncancelled packages, you need to pass a new (valid)
1120 customer number for those packages to be transferred to, as the "new_customer"
1121 option. Cancelled packages will be deleted. Did I mention that this is NOT
1122 what you want when a customer cancels service and that you really should be
1123 looking at L<FS::cust_pkg/cancel>?
1125 You can't delete a customer with invoices (see L<FS::cust_bill>),
1126 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1127 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1128 set the "delete_financials" option to a true value.
1133 my( $self, %opt ) = @_;
1135 local $SIG{HUP} = 'IGNORE';
1136 local $SIG{INT} = 'IGNORE';
1137 local $SIG{QUIT} = 'IGNORE';
1138 local $SIG{TERM} = 'IGNORE';
1139 local $SIG{TSTP} = 'IGNORE';
1140 local $SIG{PIPE} = 'IGNORE';
1142 my $oldAutoCommit = $FS::UID::AutoCommit;
1143 local $FS::UID::AutoCommit = 0;
1146 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1147 $dbh->rollback if $oldAutoCommit;
1148 return "Can't delete a master agent customer";
1151 #use FS::access_user
1152 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1153 $dbh->rollback if $oldAutoCommit;
1154 return "Can't delete a master employee customer";
1157 tie my %financial_tables, 'Tie::IxHash',
1158 'cust_bill' => 'invoices',
1159 'cust_statement' => 'statements',
1160 'cust_credit' => 'credits',
1161 'cust_pay' => 'payments',
1162 'cust_refund' => 'refunds',
1165 foreach my $table ( keys %financial_tables ) {
1167 my @records = $self->$table();
1169 if ( @records && ! $opt{'delete_financials'} ) {
1170 $dbh->rollback if $oldAutoCommit;
1171 return "Can't delete a customer with ". $financial_tables{$table};
1174 foreach my $record ( @records ) {
1175 my $error = $record->delete;
1177 $dbh->rollback if $oldAutoCommit;
1178 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1184 my @cust_pkg = $self->ncancelled_pkgs;
1186 my $new_custnum = $opt{'new_custnum'};
1187 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1188 $dbh->rollback if $oldAutoCommit;
1189 return "Invalid new customer number: $new_custnum";
1191 foreach my $cust_pkg ( @cust_pkg ) {
1192 my %hash = $cust_pkg->hash;
1193 $hash{'custnum'} = $new_custnum;
1194 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1195 my $error = $new_cust_pkg->replace($cust_pkg,
1196 options => { $cust_pkg->options },
1199 $dbh->rollback if $oldAutoCommit;
1204 my @cancelled_cust_pkg = $self->all_pkgs;
1205 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1206 my $error = $cust_pkg->delete;
1208 $dbh->rollback if $oldAutoCommit;
1213 #cust_tax_adjustment in financials?
1214 #cust_pay_pending? ouch
1215 foreach my $table (qw(
1216 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1217 cust_payby cust_location cust_main_note cust_tax_adjustment
1218 cust_pay_void cust_pay_batch queue cust_tax_exempt
1220 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1221 my $error = $record->delete;
1223 $dbh->rollback if $oldAutoCommit;
1229 my $sth = $dbh->prepare(
1230 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1232 my $errstr = $dbh->errstr;
1233 $dbh->rollback if $oldAutoCommit;
1236 $sth->execute($self->custnum) or do {
1237 my $errstr = $sth->errstr;
1238 $dbh->rollback if $oldAutoCommit;
1244 my $ticket_dbh = '';
1245 if ($conf->config('ticket_system') eq 'RT_Internal') {
1247 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1248 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1249 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1250 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1253 if ( $ticket_dbh ) {
1255 my $ticket_sth = $ticket_dbh->prepare(
1256 'DELETE FROM Links WHERE Target = ?'
1258 my $errstr = $ticket_dbh->errstr;
1259 $dbh->rollback if $oldAutoCommit;
1262 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1264 my $errstr = $ticket_sth->errstr;
1265 $dbh->rollback if $oldAutoCommit;
1269 #check and see if the customer is the only link on the ticket, and
1270 #if so, set the ticket to deleted status in RT?
1271 #maybe someday, for now this will at least fix tickets not displaying
1275 #delete the customer record
1277 my $error = $self->SUPER::delete;
1279 $dbh->rollback if $oldAutoCommit;
1283 # cust_main exports!
1285 #my $export_args = $options{'export_args'} || [];
1288 map qsearch( 'part_export', {exportnum=>$_} ),
1289 $conf->config('cust_main-exports'); #, $agentnum
1291 foreach my $part_export ( @part_export ) {
1292 my $error = $part_export->export_delete( $self ); #, @$export_args);
1294 $dbh->rollback if $oldAutoCommit;
1295 return "exporting to ". $part_export->exporttype.
1296 " (transaction rolled back): $error";
1300 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1305 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1307 Replaces the OLD_RECORD with this one in the database. If there is an error,
1308 returns the error, otherwise returns false.
1310 To change the customer's address, set the pseudo-fields C<bill_location> and
1311 C<ship_location>. The address will still only change if at least one of the
1312 address fields differs from the existing values.
1314 INVOICING_LIST_ARYREF: If you pass an arrayref to this method, it will be
1315 set as the contact email address for a default contact with the same name as
1318 Currently available options are: I<tax_exemption>, I<cust_payby_params>,
1319 I<contact_params>, I<invoicing_list>, and I<move_pkgs>.
1321 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1322 of tax names and exemption numbers. FS::cust_main_exemption records will be
1323 deleted and inserted as appropriate.
1325 I<cust_payby_params> and I<contact_params> can be hashrefs of named parameter
1326 groups (describing the customer's payment methods and contacts, respectively)
1327 in the style supported by L<FS::o2m_Common/process_o2m>. See L<FS::cust_payby>
1328 and L<FS::contact> for the fields these can contain.
1330 I<invoicing_list> is a synonym for the INVOICING_LIST_ARYREF parameter, and
1331 should be used instead if possible.
1333 If I<move_pkgs> is an arrayref, it will override the list of packages
1334 to be moved to the new address (see L<FS::cust_location/move_pkgs>.)
1341 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1343 : $self->replace_old;
1347 warn "$me replace called\n"
1350 my $curuser = $FS::CurrentUser::CurrentUser;
1351 return "You are not permitted to create complimentary accounts."
1352 if $self->complimentary eq 'Y'
1353 && $self->complimentary ne $old->complimentary
1354 && ! $curuser->access_right('Complimentary customer');
1356 local($ignore_expired_card) = 1
1357 if $old->payby =~ /^(CARD|DCRD)$/
1358 && $self->payby =~ /^(CARD|DCRD)$/
1359 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1361 local($ignore_banned_card) = 1
1362 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1363 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1364 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1366 if ( $self->payby =~ /^(CARD|DCRD)$/
1367 && $old->payinfo ne $self->payinfo
1368 && $old->paymask ne $self->paymask )
1370 my $error = $self->check_payinfo_cardtype;
1371 return $error if $error;
1374 return "Invoicing locale is required"
1377 && $conf->exists('cust_main-require_locale');
1379 return "You are not permitted to change customer invoicing terms."
1380 if $old->invoice_terms ne $self->invoice_terms
1381 && ! $curuser->access_right('Edit customer invoice terms');
1383 local $SIG{HUP} = 'IGNORE';
1384 local $SIG{INT} = 'IGNORE';
1385 local $SIG{QUIT} = 'IGNORE';
1386 local $SIG{TERM} = 'IGNORE';
1387 local $SIG{TSTP} = 'IGNORE';
1388 local $SIG{PIPE} = 'IGNORE';
1390 my $oldAutoCommit = $FS::UID::AutoCommit;
1391 local $FS::UID::AutoCommit = 0;
1394 for my $l (qw(bill_location ship_location)) {
1395 #my $old_loc = $old->$l;
1396 my $new_loc = $self->$l or next;
1398 # find the existing location if there is one
1399 $new_loc->set('custnum' => $self->custnum);
1400 my $error = $new_loc->find_or_insert;
1402 $dbh->rollback if $oldAutoCommit;
1405 $self->set($l.'num', $new_loc->locationnum);
1409 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1410 warn "cust_main::replace: using deprecated invoicing list argument";
1411 $invoicing_list = shift @param;
1414 my %options = @param;
1416 $invoicing_list ||= $options{invoicing_list};
1418 my @contacts = map { $_->contact } $self->cust_contact;
1419 # find a contact that matches the customer's name
1420 my ($implicit_contact) = grep { $_->first eq $old->get('first')
1421 and $_->last eq $old->get('last') }
1423 $implicit_contact ||= FS::contact->new({
1424 'custnum' => $self->custnum,
1425 'locationnum' => $self->get('bill_locationnum'),
1428 # for any of these that are already contact emails, link to the existing
1430 if ( $invoicing_list ) {
1433 # kind of like process_m2m on these, except:
1434 # - the other side is two tables in a join
1435 # - and we might have to create new contact_emails
1436 # - and possibly a new contact
1438 # Find existing invoice emails that aren't on the implicit contact.
1439 # Any of these that are not on the new invoicing list will be removed.
1440 my %old_email_cust_contact;
1441 foreach my $cust_contact ($self->cust_contact) {
1442 next if !$cust_contact->invoice_dest;
1443 next if $cust_contact->contactnum == ($implicit_contact->contactnum || 0);
1445 foreach my $contact_email ($cust_contact->contact->contact_email) {
1446 $old_email_cust_contact{ $contact_email->emailaddress } = $cust_contact;
1450 foreach my $dest (@$invoicing_list) {
1452 if ($dest eq 'POST') {
1454 $self->set('postal_invoice', 'Y');
1456 } elsif ( exists($old_email_cust_contact{$dest}) ) {
1458 delete $old_email_cust_contact{$dest}; # don't need to remove it, then
1462 # See if it belongs to some other contact; if so, link it.
1463 my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
1465 and $contact_email->contactnum != ($implicit_contact->contactnum || 0) ) {
1466 my $cust_contact = qsearchs('cust_contact', {
1467 contactnum => $contact_email->contactnum,
1468 custnum => $self->custnum,
1469 }) || FS::cust_contact->new({
1470 contactnum => $contact_email->contactnum,
1471 custnum => $self->custnum,
1473 $cust_contact->set('invoice_dest', 'Y');
1474 my $error = $cust_contact->custcontactnum ?
1475 $cust_contact->replace : $cust_contact->insert;
1477 $dbh->rollback if $oldAutoCommit;
1478 return "$error (linking to email address $dest)";
1482 # This email address is not yet linked to any contact, so it will
1483 # be added to the implicit contact.
1484 $email .= ',' if length($email);
1490 foreach my $remove_dest (keys %old_email_cust_contact) {
1491 my $cust_contact = $old_email_cust_contact{$remove_dest};
1492 # These were not in the list of requested destinations, so take them off.
1493 $cust_contact->set('invoice_dest', '');
1494 my $error = $cust_contact->replace;
1496 $dbh->rollback if $oldAutoCommit;
1497 return "$error (unlinking email address $remove_dest)";
1501 # make sure it keeps up with the changed customer name, if any
1502 $implicit_contact->set('last', $self->get('last'));
1503 $implicit_contact->set('first', $self->get('first'));
1504 $implicit_contact->set('emailaddress', $email);
1505 $implicit_contact->set('invoice_dest', 'Y');
1506 $implicit_contact->set('custnum', $self->custnum);
1507 my $i_cust_contact =
1508 qsearchs('cust_contact', {
1509 contactnum => $implicit_contact->contactnum,
1510 custnum => $self->custnum,
1513 if ( $i_cust_contact ) {
1514 $implicit_contact->set($_, $i_cust_contact->$_)
1515 foreach qw( classnum selfservice_access comment );
1519 if ( $implicit_contact->contactnum ) {
1520 $error = $implicit_contact->replace;
1521 } elsif ( length($email) ) { # don't create a new contact if not needed
1522 $error = $implicit_contact->insert;
1526 $dbh->rollback if $oldAutoCommit;
1527 return "$error (adding email address $email)";
1532 # replace the customer record
1533 my $error = $self->SUPER::replace($old);
1536 $dbh->rollback if $oldAutoCommit;
1540 # now move packages to the new service location
1541 $self->set('ship_location', ''); #flush cache
1542 if ( $old->ship_locationnum and # should only be null during upgrade...
1543 $old->ship_locationnum != $self->ship_locationnum ) {
1544 $error = $old->ship_location->move_to($self->ship_location, move_pkgs => $options{'move_pkgs'});
1546 $dbh->rollback if $oldAutoCommit;
1550 # don't move packages based on the billing location, but
1551 # disable it if it's no longer in use
1552 if ( $old->bill_locationnum and
1553 $old->bill_locationnum != $self->bill_locationnum ) {
1554 $error = $old->bill_location->disable_if_unused;
1556 $dbh->rollback if $oldAutoCommit;
1561 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1563 #this could be more efficient than deleting and re-inserting, if it matters
1564 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1565 my $error = $cust_tag->delete;
1567 $dbh->rollback if $oldAutoCommit;
1571 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1572 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1573 'custnum' => $self->custnum };
1574 my $error = $cust_tag->insert;
1576 $dbh->rollback if $oldAutoCommit;
1583 my $tax_exemption = delete $options{'tax_exemption'};
1584 if ( $tax_exemption ) {
1586 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1587 if ref($tax_exemption) eq 'ARRAY';
1589 my %cust_main_exemption =
1590 map { $_->taxname => $_ }
1591 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1593 foreach my $taxname ( keys %$tax_exemption ) {
1595 if ( $cust_main_exemption{$taxname} &&
1596 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1599 delete $cust_main_exemption{$taxname};
1603 my $cust_main_exemption = new FS::cust_main_exemption {
1604 'custnum' => $self->custnum,
1605 'taxname' => $taxname,
1606 'exempt_number' => $tax_exemption->{$taxname},
1608 my $error = $cust_main_exemption->insert;
1610 $dbh->rollback if $oldAutoCommit;
1611 return "inserting cust_main_exemption (transaction rolled back): $error";
1615 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1616 my $error = $cust_main_exemption->delete;
1618 $dbh->rollback if $oldAutoCommit;
1619 return "deleting cust_main_exemption (transaction rolled back): $error";
1625 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1627 my $error = $self->process_o2m(
1628 'table' => 'cust_payby',
1629 'fields' => FS::cust_payby->cgi_cust_payby_fields,
1630 'params' => $cust_payby_params,
1631 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1634 $dbh->rollback if $oldAutoCommit;
1640 if ( my $contact_params = delete $options{'contact_params'} ) {
1642 # this can potentially replace contacts that were created by the
1643 # invoicing list argument, but the UI shouldn't allow both of them
1646 my $error = $self->process_o2m(
1647 'table' => 'contact',
1648 'fields' => FS::contact->cgi_contact_fields,
1649 'params' => $contact_params,
1652 $dbh->rollback if $oldAutoCommit;
1658 unless ( $import || $skip_fuzzyfiles ) {
1659 $error = $self->queue_fuzzyfiles_update;
1661 $dbh->rollback if $oldAutoCommit;
1662 return "updating fuzzy search cache: $error";
1666 # tax district update in cust_location
1668 # cust_main exports!
1670 my $export_args = $options{'export_args'} || [];
1673 map qsearch( 'part_export', {exportnum=>$_} ),
1674 $conf->config('cust_main-exports'); #, $agentnum
1676 foreach my $part_export ( @part_export ) {
1677 my $error = $part_export->export_replace( $self, $old, @$export_args);
1679 $dbh->rollback if $oldAutoCommit;
1680 return "exporting to ". $part_export->exporttype.
1681 " (transaction rolled back): $error";
1685 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1690 =item queue_fuzzyfiles_update
1692 Used by insert & replace to update the fuzzy search cache
1696 use FS::cust_main::Search;
1697 sub queue_fuzzyfiles_update {
1700 local $SIG{HUP} = 'IGNORE';
1701 local $SIG{INT} = 'IGNORE';
1702 local $SIG{QUIT} = 'IGNORE';
1703 local $SIG{TERM} = 'IGNORE';
1704 local $SIG{TSTP} = 'IGNORE';
1705 local $SIG{PIPE} = 'IGNORE';
1707 my $oldAutoCommit = $FS::UID::AutoCommit;
1708 local $FS::UID::AutoCommit = 0;
1711 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1712 my $queue = new FS::queue {
1713 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1715 my @args = "cust_main.$field", $self->get($field);
1716 my $error = $queue->insert( @args );
1718 $dbh->rollback if $oldAutoCommit;
1719 return "queueing job (transaction rolled back): $error";
1724 push @locations, $self->bill_location if $self->bill_locationnum;
1725 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1726 foreach my $location (@locations) {
1727 my $queue = new FS::queue {
1728 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1730 my @args = 'cust_location.address1', $location->address1;
1731 my $error = $queue->insert( @args );
1733 $dbh->rollback if $oldAutoCommit;
1734 return "queueing job (transaction rolled back): $error";
1738 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1745 Checks all fields to make sure this is a valid customer record. If there is
1746 an error, returns the error, otherwise returns false. Called by the insert
1747 and replace methods.
1754 warn "$me check BEFORE: \n". $self->_dump
1758 $self->ut_numbern('custnum')
1759 || $self->ut_number('agentnum')
1760 || $self->ut_textn('agent_custid')
1761 || $self->ut_number('refnum')
1762 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1763 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1764 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1765 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1766 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1767 || $self->ut_textn('custbatch')
1768 || $self->ut_name('last')
1769 || $self->ut_name('first')
1770 || $self->ut_snumbern('signupdate')
1771 || $self->ut_snumbern('birthdate')
1772 || $self->ut_namen('spouse_last')
1773 || $self->ut_namen('spouse_first')
1774 || $self->ut_snumbern('spouse_birthdate')
1775 || $self->ut_snumbern('anniversary_date')
1776 || $self->ut_textn('company')
1777 || $self->ut_textn('ship_company')
1778 || $self->ut_anything('comments')
1779 || $self->ut_numbern('referral_custnum')
1780 || $self->ut_textn('stateid')
1781 || $self->ut_textn('stateid_state')
1782 || $self->ut_textn('invoice_terms')
1783 || $self->ut_floatn('cdr_termination_percentage')
1784 || $self->ut_floatn('credit_limit')
1785 || $self->ut_numbern('billday')
1786 || $self->ut_numbern('prorate_day')
1787 || $self->ut_flag('force_prorate_day')
1788 || $self->ut_flag('edit_subject')
1789 || $self->ut_flag('calling_list_exempt')
1790 || $self->ut_flag('invoice_noemail')
1791 || $self->ut_flag('message_noemail')
1792 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1793 || $self->ut_currencyn('currency')
1794 || $self->ut_textn('po_number')
1795 || $self->ut_enum('complimentary', [ '', 'Y' ])
1796 || $self->ut_flag('invoice_ship_address')
1797 || $self->ut_flag('invoice_dest')
1800 foreach (qw(company ship_company)) {
1801 my $company = $self->get($_);
1802 $company =~ s/^\s+//;
1803 $company =~ s/\s+$//;
1804 $company =~ s/\s+/ /g;
1805 $self->set($_, $company);
1808 #barf. need message catalogs. i18n. etc.
1809 $error .= "Please select an advertising source."
1810 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1811 return $error if $error;
1813 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1814 or return "Unknown agent";
1816 if ( $self->currency ) {
1817 my $agent_currency = qsearchs( 'agent_currency', {
1818 'agentnum' => $agent->agentnum,
1819 'currency' => $self->currency,
1821 or return "Agent ". $agent->agent.
1822 " not permitted to offer ". $self->currency. " invoicing";
1825 return "Unknown refnum"
1826 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1828 return "Unknown referring custnum: ". $self->referral_custnum
1829 unless ! $self->referral_custnum
1830 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1832 if ( $self->ss eq '' ) {
1837 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1838 or return "Illegal social security number: ". $self->ss;
1839 $self->ss("$1-$2-$3");
1842 #turn off invoice_ship_address if ship & bill are the same
1843 if ($self->bill_locationnum eq $self->ship_locationnum) {
1844 $self->invoice_ship_address('');
1847 # cust_main_county verification now handled by cust_location check
1850 $self->ut_phonen('daytime', $self->country)
1851 || $self->ut_phonen('night', $self->country)
1852 || $self->ut_phonen('fax', $self->country)
1853 || $self->ut_phonen('mobile', $self->country)
1855 return $error if $error;
1857 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1859 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1862 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1864 : FS::Msgcat::_gettext('daytime');
1865 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1867 : FS::Msgcat::_gettext('night');
1869 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1871 : FS::Msgcat::_gettext('mobile');
1873 return "$daytime_label, $night_label or $mobile_label is required"
1877 return "Please select an invoicing locale"
1880 && $conf->exists('cust_main-require_locale');
1882 return "Please select a customer class"
1883 if ! $self->classnum
1884 && $conf->exists('cust_main-require_classnum');
1886 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1887 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1891 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1893 warn "$me check AFTER: \n". $self->_dump
1896 $self->SUPER::check;
1899 sub check_payinfo_cardtype {
1902 return '' unless $self->payby =~ /^(CARD|DCRD)$/;
1904 my $payinfo = $self->payinfo;
1905 $payinfo =~ s/\D//g;
1907 return '' if $self->tokenized($payinfo); #token
1909 my %bop_card_types = map { $_=>1 } values %{ card_types() };
1910 my $cardtype = cardtype($payinfo);
1912 return "$cardtype not accepted" unless $bop_card_types{$cardtype};
1920 Additional checks for replace only.
1925 my ($new,$old) = @_;
1926 #preserve old value if global config is set
1927 if ($old && $conf->exists('invoice-ship_address')) {
1928 $new->invoice_ship_address($old->invoice_ship_address);
1935 Returns a list of fields which have ship_ duplicates.
1940 qw( last first company
1942 address1 address2 city county state zip country
1944 daytime night fax mobile
1948 =item has_ship_address
1950 Returns true if this customer record has a separate shipping address.
1954 sub has_ship_address {
1956 $self->bill_locationnum != $self->ship_locationnum;
1961 Returns a list of key/value pairs, with the following keys: address1,
1962 adddress2, city, county, state, zip, country, district, and geocode. The
1963 shipping address is used if present.
1969 $self->ship_location->location_hash;
1974 Returns all locations (see L<FS::cust_location>) for this customer.
1981 'table' => 'cust_location',
1982 'hashref' => { 'custnum' => $self->custnum,
1983 'prospectnum' => '',
1985 'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
1991 Returns all contact associations (see L<FS::cust_contact>) for this customer.
1997 qsearch('cust_contact', { 'custnum' => $self->custnum } );
2000 =item cust_payby PAYBY
2002 Returns all payment methods (see L<FS::cust_payby>) for this customer.
2004 If one or more PAYBY are specified, returns only payment methods for specified PAYBY.
2005 Does not validate PAYBY.
2013 'table' => 'cust_payby',
2014 'hashref' => { 'custnum' => $self->custnum },
2015 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
2017 $search->{'extra_sql'} = ' AND payby IN ( '.
2018 join(',', map dbh->quote($_), @payby).
2025 =item has_cust_payby_auto
2027 Returns true if customer has an automatic payment method ('CARD' or 'CHEK')
2031 sub has_cust_payby_auto {
2034 'table' => 'cust_payby',
2035 'hashref' => { 'custnum' => $self->custnum, },
2036 'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ",
2037 'order_by' => 'LIMIT 1',
2044 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2045 and L<FS::cust_pkg>) for this customer, except those on hold.
2047 Returns a list: an empty list on success or a list of errors.
2053 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_);
2058 Unsuspends all suspended packages in the on-hold state (those without setup
2059 dates) for this customer.
2065 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2070 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2072 Returns a list: an empty list on success or a list of errors.
2078 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2081 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2083 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2084 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2085 of a list of pkgparts; the hashref has the following keys:
2089 =item pkgparts - listref of pkgparts
2091 =item (other options are passed to the suspend method)
2096 Returns a list: an empty list on success or a list of errors.
2100 sub suspend_if_pkgpart {
2102 my (@pkgparts, %opt);
2103 if (ref($_[0]) eq 'HASH'){
2104 @pkgparts = @{$_[0]{pkgparts}};
2109 grep { $_->suspend(%opt) }
2110 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2111 $self->unsuspended_pkgs;
2114 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2116 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2117 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2118 instead of a list of pkgparts; the hashref has the following keys:
2122 =item pkgparts - listref of pkgparts
2124 =item (other options are passed to the suspend method)
2128 Returns a list: an empty list on success or a list of errors.
2132 sub suspend_unless_pkgpart {
2134 my (@pkgparts, %opt);
2135 if (ref($_[0]) eq 'HASH'){
2136 @pkgparts = @{$_[0]{pkgparts}};
2141 grep { $_->suspend(%opt) }
2142 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2143 $self->unsuspended_pkgs;
2146 =item cancel [ OPTION => VALUE ... ]
2148 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2149 The cancellation time will be now.
2153 Always returns a list: an empty list on success or a list of errors.
2160 warn "$me cancel called on customer ". $self->custnum. " with options ".
2161 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2163 my @pkgs = $self->ncancelled_pkgs;
2165 $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
2168 =item cancel_pkgs OPTIONS
2170 Cancels a specified list of packages. OPTIONS can include:
2174 =item cust_pkg - an arrayref of the packages. Required.
2176 =item time - the cancellation time, used to calculate final bills and
2177 unused-time credits if any. Will be passed through to the bill() and
2178 FS::cust_pkg::cancel() methods.
2180 =item quiet - can be set true to supress email cancellation notices.
2182 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a
2183 reasonnum of an existing reason, or passing a hashref will create a new reason.
2184 The hashref should have the following keys:
2185 typenum - Reason type (see L<FS::reason_type>)
2186 reason - Text of the new reason.
2188 =item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
2189 for the individual packages, parallel to the C<cust_pkg> argument. The
2190 reason and reason_otaker arguments will be taken from those objects.
2192 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2194 =item nobill - can be set true to skip billing if it might otherwise be done.
2199 my( $self, %opt ) = @_;
2201 # we're going to cancel services, which is not reversible
2202 # unless exports are suppressed
2203 die "cancel_pkgs cannot be run inside a transaction"
2204 if !$FS::UID::AutoCommit && !$FS::svc_Common::noexport_hack;
2206 my $oldAutoCommit = $FS::UID::AutoCommit;
2207 local $FS::UID::AutoCommit = 0;
2209 savepoint_create('cancel_pkgs');
2211 return ( 'access denied' )
2212 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2214 if ( $opt{'ban'} ) {
2216 foreach my $cust_payby ( $self->cust_payby ) {
2218 #well, if they didn't get decrypted on search, then we don't have to
2219 # try again... queue a job for the server that does have decryption
2220 # capability if we're in a paranoid multi-server implementation?
2221 return ( "Can't (yet) ban encrypted credit cards" )
2222 if $cust_payby->is_encrypted($cust_payby->payinfo);
2224 my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2225 my $error = $ban->insert;
2227 savepoint_rollback_and_release('cancel_pkgs');
2228 dbh->rollback if $oldAutoCommit;
2236 my @pkgs = @{ delete $opt{'cust_pkg'} };
2237 my $cancel_time = $opt{'time'} || time;
2239 # bill all packages first, so we don't lose usage, service counts for
2240 # bulk billing, etc.
2241 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2243 my $error = $self->bill( 'pkg_list' => [ @pkgs ],
2245 'time' => $cancel_time );
2247 warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
2248 savepoint_rollback_and_release('cancel_pkgs');
2249 dbh->rollback if $oldAutoCommit;
2250 return ( "Error billing during cancellation: $error" );
2253 savepoint_release('cancel_pkgs');
2254 dbh->commit if $oldAutoCommit;
2257 # try to cancel each service, the same way we would for individual packages,
2258 # but in cancel weight order.
2259 my @cust_svc = map { $_->cust_svc } @pkgs;
2260 my @sorted_cust_svc =
2262 sort { $a->[1] <=> $b->[1] }
2263 map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc
2265 warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
2269 foreach my $cust_svc (@sorted_cust_svc) {
2270 my $savepoint = 'cancel_pkgs_'.$i++;
2271 savepoint_create( $savepoint );
2272 my $part_svc = $cust_svc->part_svc;
2273 next if ( defined($part_svc) and $part_svc->preserve );
2274 # immediate cancel, no date option
2275 # transactionize individually
2276 my $error = try { $cust_svc->cancel } catch { $_ };
2278 savepoint_rollback_and_release( $savepoint );
2279 dbh->rollback if $oldAutoCommit;
2280 push @errors, $error;
2282 savepoint_release( $savepoint );
2283 dbh->commit if $oldAutoCommit;
2290 warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
2291 $self->custnum. "\n"
2295 if ($opt{'cust_pkg_reason'}) {
2296 @cprs = @{ delete $opt{'cust_pkg_reason'} };
2302 my $savepoint = 'cancel_pkgs_'.$i++;
2303 savepoint_create( $savepoint );
2305 my $cpr = shift @cprs;
2307 $lopt{'reason'} = $cpr->reasonnum;
2308 $lopt{'reason_otaker'} = $cpr->otaker;
2310 warn "no reason found when canceling package ".$_->pkgnum."\n";
2311 # we're not actually required to pass a reason to cust_pkg::cancel,
2312 # but if we're getting to this point, something has gone awry.
2313 $null_reason ||= FS::reason->new_or_existing(
2314 reason => 'unknown reason',
2315 type => 'Cancel Reason',
2318 $lopt{'reason'} = $null_reason->reasonnum;
2319 $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username;
2322 my $error = $_->cancel(%lopt);
2324 savepoint_rollback_and_release( $savepoint );
2325 dbh->rollback if $oldAutoCommit;
2326 push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
2328 savepoint_release( $savepoint );
2329 dbh->commit if $oldAutoCommit;
2336 sub _banned_pay_hashref {
2337 die 'cust_main->_banned_pay_hashref deprecated';
2349 'payby' => $payby2ban{$self->payby},
2350 'payinfo' => $self->payinfo,
2351 #don't ever *search* on reason! #'reason' =>
2357 Returns all notes (see L<FS::cust_main_note>) for this customer.
2362 my($self,$orderby_classnum) = (shift,shift);
2363 my $orderby = "sticky DESC, _date DESC";
2364 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2365 qsearch( 'cust_main_note',
2366 { 'custnum' => $self->custnum },
2368 "ORDER BY $orderby",
2374 Returns the agent (see L<FS::agent>) for this customer.
2378 Returns the agent name (see L<FS::agent>) for this customer.
2384 $self->agent->agent;
2389 Returns any tags associated with this customer, as FS::cust_tag objects,
2390 or an empty list if there are no tags.
2394 Returns any tags associated with this customer, as FS::part_tag objects,
2395 or an empty list if there are no tags.
2401 map $_->part_tag, $self->cust_tag;
2407 Returns the customer class, as an FS::cust_class object, or the empty string
2408 if there is no customer class.
2412 Returns the customer category name, or the empty string if there is no customer
2419 my $cust_class = $self->cust_class;
2421 ? $cust_class->categoryname
2427 Returns the customer class name, or the empty string if there is no customer
2434 my $cust_class = $self->cust_class;
2436 ? $cust_class->classname
2442 Returns the external tax status, as an FS::tax_status object, or the empty
2443 string if there is no tax status.
2449 if ( $self->taxstatusnum ) {
2450 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2458 Returns the tax status code if there is one.
2464 my $tax_status = $self->tax_status;
2466 ? $tax_status->taxstatus
2470 =item BILLING METHODS
2472 Documentation on billing methods has been moved to
2473 L<FS::cust_main::Billing>.
2475 =item REALTIME BILLING METHODS
2477 Documentation on realtime billing methods has been moved to
2478 L<FS::cust_main::Billing_Realtime>.
2482 Removes the I<paycvv> field from the database directly.
2484 If there is an error, returns the error, otherwise returns false.
2486 DEPRECATED. Use L</remove_cvv_from_cust_payby> instead.
2491 die 'cust_main->remove_cvv deprecated';
2493 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2494 or return dbh->errstr;
2495 $sth->execute($self->custnum)
2496 or return $sth->errstr;
2503 Returns the total owed for this customer on all invoices
2504 (see L<FS::cust_bill/owed>).
2510 $self->total_owed_date(2145859200); #12/31/2037
2513 =item total_owed_date TIME
2515 Returns the total owed for this customer on all invoices with date earlier than
2516 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2517 see L<Time::Local> and L<Date::Parse> for conversion functions.
2521 sub total_owed_date {
2525 my $custnum = $self->custnum;
2527 my $owed_sql = FS::cust_bill->owed_sql;
2530 SELECT SUM($owed_sql) FROM cust_bill
2531 WHERE custnum = $custnum
2535 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2539 =item total_owed_pkgnum PKGNUM
2541 Returns the total owed on all invoices for this customer's specific package
2542 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2546 sub total_owed_pkgnum {
2547 my( $self, $pkgnum ) = @_;
2548 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2551 =item total_owed_date_pkgnum TIME PKGNUM
2553 Returns the total owed for this customer's specific package when using
2554 experimental package balances on all invoices with date earlier than
2555 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2556 see L<Time::Local> and L<Date::Parse> for conversion functions.
2560 sub total_owed_date_pkgnum {
2561 my( $self, $time, $pkgnum ) = @_;
2564 foreach my $cust_bill (
2565 grep { $_->_date <= $time }
2566 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2568 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2570 sprintf( "%.2f", $total_bill );
2576 Returns the total amount of all payments.
2583 $total += $_->paid foreach $self->cust_pay;
2584 sprintf( "%.2f", $total );
2587 =item total_unapplied_credits
2589 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2590 customer. See L<FS::cust_credit/credited>.
2592 =item total_credited
2594 Old name for total_unapplied_credits. Don't use.
2598 sub total_credited {
2599 #carp "total_credited deprecated, use total_unapplied_credits";
2600 shift->total_unapplied_credits(@_);
2603 sub total_unapplied_credits {
2606 my $custnum = $self->custnum;
2608 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2611 SELECT SUM($unapplied_sql) FROM cust_credit
2612 WHERE custnum = $custnum
2615 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2619 =item total_unapplied_credits_pkgnum PKGNUM
2621 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2622 customer. See L<FS::cust_credit/credited>.
2626 sub total_unapplied_credits_pkgnum {
2627 my( $self, $pkgnum ) = @_;
2628 my $total_credit = 0;
2629 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2630 sprintf( "%.2f", $total_credit );
2634 =item total_unapplied_payments
2636 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2637 See L<FS::cust_pay/unapplied>.
2641 sub total_unapplied_payments {
2644 my $custnum = $self->custnum;
2646 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2649 SELECT SUM($unapplied_sql) FROM cust_pay
2650 WHERE custnum = $custnum
2653 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2657 =item total_unapplied_payments_pkgnum PKGNUM
2659 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2660 specific package when using experimental package balances. See
2661 L<FS::cust_pay/unapplied>.
2665 sub total_unapplied_payments_pkgnum {
2666 my( $self, $pkgnum ) = @_;
2667 my $total_unapplied = 0;
2668 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2669 sprintf( "%.2f", $total_unapplied );
2673 =item total_unapplied_refunds
2675 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2676 customer. See L<FS::cust_refund/unapplied>.
2680 sub total_unapplied_refunds {
2682 my $custnum = $self->custnum;
2684 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2687 SELECT SUM($unapplied_sql) FROM cust_refund
2688 WHERE custnum = $custnum
2691 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2697 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2698 total_unapplied_credits minus total_unapplied_payments).
2704 $self->balance_date_range;
2707 =item balance_date TIME
2709 Returns the balance for this customer, only considering invoices with date
2710 earlier than TIME (total_owed_date minus total_credited minus
2711 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2712 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2719 $self->balance_date_range(shift);
2722 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2724 Returns the balance for this customer, optionally considering invoices with
2725 date earlier than START_TIME, and not later than END_TIME
2726 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2728 Times are specified as SQL fragments or numeric
2729 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2730 L<Date::Parse> for conversion functions. The empty string can be passed
2731 to disable that time constraint completely.
2733 Accepts the same options as L<balance_date_sql>:
2737 =item unapplied_date
2739 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)
2743 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2744 time will be ignored. Note that START_TIME and END_TIME only limit the date
2745 range for invoices and I<unapplied> payments, credits, and refunds.
2751 sub balance_date_range {
2753 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2754 ') FROM cust_main WHERE custnum='. $self->custnum;
2755 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2758 =item balance_pkgnum PKGNUM
2760 Returns the balance for this customer's specific package when using
2761 experimental package balances (total_owed plus total_unrefunded, minus
2762 total_unapplied_credits minus total_unapplied_payments)
2766 sub balance_pkgnum {
2767 my( $self, $pkgnum ) = @_;
2770 $self->total_owed_pkgnum($pkgnum)
2771 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2772 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2773 - $self->total_unapplied_credits_pkgnum($pkgnum)
2774 - $self->total_unapplied_payments_pkgnum($pkgnum)
2780 Returns a hash of useful information for making a payment.
2790 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2791 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2792 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2796 For credit card transactions:
2808 For electronic check transactions:
2818 #XXX i need to be updated for 4.x+
2824 $return{balance} = $self->balance;
2826 $return{payname} = $self->payname
2827 || ( $self->first. ' '. $self->get('last') );
2829 $return{$_} = $self->bill_location->$_
2830 for qw(address1 address2 city state zip);
2832 $return{payby} = $self->payby;
2833 $return{stateid_state} = $self->stateid_state;
2835 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2836 $return{card_type} = cardtype($self->payinfo);
2837 $return{payinfo} = $self->paymask;
2839 @return{'month', 'year'} = $self->paydate_monthyear;
2843 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2844 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2845 $return{payinfo1} = $payinfo1;
2846 $return{payinfo2} = $payinfo2;
2847 $return{paytype} = $self->paytype;
2848 $return{paystate} = $self->paystate;
2852 #doubleclick protection
2854 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2862 Returns the next payment expiration date for this customer. If they have no
2863 payment methods that will expire, returns 0.
2869 # filter out the ones that individually return 0, but then return 0 if
2870 # there are no results
2871 my @epochs = grep { $_ > 0 } map { $_->paydate_epoch } $self->cust_payby;
2872 min( @epochs ) || 0;
2875 =item paydate_epoch_sql
2877 Returns an SQL expression to get the next payment expiration date for a
2878 customer. Returns 2143260000 (2037-12-01) if there are no payment expiration
2879 dates, so that it's safe to test for "will it expire before date X" for any
2884 sub paydate_epoch_sql {
2886 my $paydate = FS::cust_payby->paydate_epoch_sql;
2887 "(SELECT COALESCE(MIN($paydate), 2143260000) FROM cust_payby WHERE cust_payby.custnum = cust_main.custnum)";
2891 my( $self, $taxname ) = @_;
2893 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2894 'taxname' => $taxname,
2899 =item cust_main_exemption
2901 =item invoicing_list
2903 Returns a list of email addresses (with svcnum entries expanded), and the word
2904 'POST' if the customer receives postal invoices.
2908 sub invoicing_list {
2909 my( $self, $arrayref ) = @_;
2912 warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
2915 my @emails = $self->invoicing_list_emailonly;
2916 push @emails, 'POST' if $self->get('postal_invoice');
2921 =item check_invoicing_list ARRAYREF
2923 Checks these arguements as valid input for the invoicing_list method. If there
2924 is an error, returns the error, otherwise returns false.
2928 sub check_invoicing_list {
2929 my( $self, $arrayref ) = @_;
2931 foreach my $address ( @$arrayref ) {
2933 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2934 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2937 my $cust_main_invoice = new FS::cust_main_invoice ( {
2938 'custnum' => $self->custnum,
2941 my $error = $self->custnum
2942 ? $cust_main_invoice->check
2943 : $cust_main_invoice->checkdest
2945 return $error if $error;
2949 return "Email address required"
2950 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2951 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2958 Returns the email addresses of all accounts provisioned for this customer.
2965 foreach my $cust_pkg ( $self->all_pkgs ) {
2966 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2968 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2969 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2971 $list{$_}=1 foreach map { $_->email } @svc_acct;
2976 =item invoicing_list_addpost
2978 Adds postal invoicing to this customer. If this customer is already configured
2979 to receive postal invoices, does nothing.
2983 sub invoicing_list_addpost {
2985 if ( $self->get('postal_invoice') eq '' ) {
2986 $self->set('postal_invoice', 'Y');
2987 my $error = $self->replace;
2988 warn $error if $error; # should fail harder, but this is traditional
2992 =item invoicing_list_emailonly
2994 Returns the list of email invoice recipients (invoicing_list without non-email
2995 destinations such as POST and FAX).
2999 sub invoicing_list_emailonly {
3001 warn "$me invoicing_list_emailonly called"
3003 return () if !$self->custnum; # not yet inserted
3004 return map { $_->emailaddress }
3006 table => 'cust_contact',
3007 select => 'emailaddress',
3008 addl_from => ' JOIN contact USING (contactnum) '.
3009 ' JOIN contact_email USING (contactnum)',
3010 hashref => { 'custnum' => $self->custnum, },
3011 extra_sql => q( AND cust_contact.invoice_dest = 'Y'),
3015 =item invoicing_list_emailonly_scalar
3017 Returns the list of email invoice recipients (invoicing_list without non-email
3018 destinations such as POST and FAX) as a comma-separated scalar.
3022 sub invoicing_list_emailonly_scalar {
3024 warn "$me invoicing_list_emailonly_scalar called"
3026 join(', ', $self->invoicing_list_emailonly);
3029 =item contact_list [ CLASSNUM, DEST_FLAG... ]
3031 Returns a list of contacts (L<FS::contact> objects) for the customer.
3033 If no arguments are given, returns all contacts for the customer.
3035 Arguments may contain classnums. When classnums are specified, only
3036 contacts with a matching cust_contact.classnum are returned. When a
3037 classnum of 0 is given, contacts with a null classnum are also included.
3039 Arguments may also contain the dest flag names 'invoice' or 'message'.
3040 If given, contacts who's invoice_dest and/or message_dest flags are
3041 not set to 'Y' will be excluded.
3049 select => join(', ',(
3051 'cust_contact.invoice_dest',
3052 'cust_contact.message_dest',
3054 addl_from => ' JOIN cust_contact USING (contactnum)',
3055 extra_sql => ' WHERE cust_contact.custnum = '.$self->custnum,
3059 # Calling methods were relying on this method to use invoice_dest to
3060 # block e-mail messages. Depending on parameters, this may or may not
3061 # have actually happened.
3063 # The bug could cause this SQL to be used to filter e-mail addresses:
3066 # cust_contact.classnums IN (1,2,3)
3067 # OR cust_contact.invoice_dest = 'Y'
3070 # improperly including everybody with the opt-in flag AND everybody
3071 # in the contact classes
3073 # Possibility to introduce new bugs:
3074 # If callers of this method called it incorrectly, and didn't notice
3075 # because it seemed to send the e-mails they wanted.
3080 # cust_contact.classnum IN (1,2,3)
3082 # cust_contact.classnum IS NULL
3085 # cust_contact.invoice_dest = 'Y'
3087 # cust_contact.message_dest = 'Y'
3095 if ($_ eq 'invoice' || $_ eq 'message') {
3096 push @and_dest, " cust_contact.${_}_dest = 'Y' ";
3097 } elsif ($_ eq '0') {
3098 push @or_classnum, ' cust_contact.classnum IS NULL ';
3099 } elsif ( /^\d+$/ ) {
3100 push @classnums, $_;
3102 croak "bad classnum argument '$_'";
3106 push @or_classnum, 'cust_contact.classnum IN ('.join(',',@classnums).')'
3109 if (@or_classnum || @and_dest) { # catch, no arguments given
3110 $search->{extra_sql} .= ' AND ( ';
3113 $search->{extra_sql} .= ' ( ';
3114 $search->{extra_sql} .= join ' OR ', map {" $_ "} @or_classnum;
3115 $search->{extra_sql} .= ' ) ';
3116 $search->{extra_sql} .= ' AND ( ' if @and_dest;
3120 $search->{extra_sql} .= join ' OR ', map {" $_ "} @and_dest;
3121 $search->{extra_sql} .= ' ) ' if @or_classnum;
3124 $search->{extra_sql} .= ' ) ';
3126 warn "\$extra_sql: $search->{extra_sql} \n" if $DEBUG;
3132 =item contact_list_email [ CLASSNUM, ... ]
3134 Same as L</contact_list>, but returns email destinations instead of contact
3139 sub contact_list_email {
3141 my @contacts = $self->contact_list(@_);
3143 foreach my $contact (@contacts) {
3144 foreach my $contact_email ($contact->contact_email) {
3145 push @emails, Email::Address->new( $contact->firstlast,
3146 $contact_email->emailaddress
3153 =item referral_custnum_cust_main
3155 Returns the customer who referred this customer (or the empty string, if
3156 this customer was not referred).
3158 Note the difference with referral_cust_main method: This method,
3159 referral_custnum_cust_main returns the single customer (if any) who referred
3160 this customer, while referral_cust_main returns an array of customers referred
3165 sub referral_custnum_cust_main {
3167 return '' unless $self->referral_custnum;
3168 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3171 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3173 Returns an array of customers referred by this customer (referral_custnum set
3174 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3175 customers referred by customers referred by this customer and so on, inclusive.
3176 The default behavior is DEPTH 1 (no recursion).
3178 Note the difference with referral_custnum_cust_main method: This method,
3179 referral_cust_main, returns an array of customers referred BY this customer,
3180 while referral_custnum_cust_main returns the single customer (if any) who
3181 referred this customer.
3185 sub referral_cust_main {
3187 my $depth = @_ ? shift : 1;
3188 my $exclude = @_ ? shift : {};
3191 map { $exclude->{$_->custnum}++; $_; }
3192 grep { ! $exclude->{ $_->custnum } }
3193 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3197 map { $_->referral_cust_main($depth-1, $exclude) }
3204 =item referral_cust_main_ncancelled
3206 Same as referral_cust_main, except only returns customers with uncancelled
3211 sub referral_cust_main_ncancelled {
3213 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3216 =item referral_cust_pkg [ DEPTH ]
3218 Like referral_cust_main, except returns a flat list of all unsuspended (and
3219 uncancelled) packages for each customer. The number of items in this list may
3220 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3224 sub referral_cust_pkg {
3226 my $depth = @_ ? shift : 1;
3228 map { $_->unsuspended_pkgs }
3229 grep { $_->unsuspended_pkgs }
3230 $self->referral_cust_main($depth);
3233 =item referring_cust_main
3235 Returns the single cust_main record for the customer who referred this customer
3236 (referral_custnum), or false.
3240 sub referring_cust_main {
3242 return '' unless $self->referral_custnum;
3243 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3246 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3248 Applies a credit to this customer. If there is an error, returns the error,
3249 otherwise returns false.
3251 REASON can be a text string, an FS::reason object, or a scalar reference to
3252 a reasonnum. If a text string, it will be automatically inserted as a new
3253 reason, and a 'reason_type' option must be passed to indicate the
3254 FS::reason_type for the new reason.
3256 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3257 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3258 I<commission_pkgnum>.
3260 Any other options are passed to FS::cust_credit::insert.
3265 my( $self, $amount, $reason, %options ) = @_;
3267 my $cust_credit = new FS::cust_credit {
3268 'custnum' => $self->custnum,
3269 'amount' => $amount,
3272 if ( ref($reason) ) {
3274 if ( ref($reason) eq 'SCALAR' ) {
3275 $cust_credit->reasonnum( $$reason );
3277 $cust_credit->reasonnum( $reason->reasonnum );
3281 $cust_credit->set('reason', $reason)
3284 $cust_credit->$_( delete $options{$_} )
3285 foreach grep exists($options{$_}),
3286 qw( addlinfo eventnum ),
3287 map "commission_$_", qw( agentnum salesnum pkgnum );
3289 $cust_credit->insert(%options);
3293 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3295 Creates a one-time charge for this customer. If there is an error, returns
3296 the error, otherwise returns false.
3298 New-style, with a hashref of options:
3300 my $error = $cust_main->charge(
3304 'start_date' => str2time('7/4/2009'),
3305 'pkg' => 'Description',
3306 'comment' => 'Comment',
3307 'additional' => [], #extra invoice detail
3308 'classnum' => 1, #pkg_class
3310 'setuptax' => '', # or 'Y' for tax exempt
3312 'locationnum'=> 1234, # optional
3315 'taxclass' => 'Tax class',
3318 'taxproduct' => 2, #part_pkg_taxproduct
3319 'override' => {}, #XXX describe
3321 #will be filled in with the new object
3322 'cust_pkg_ref' => \$cust_pkg,
3324 #generate an invoice immediately
3326 'invoice_terms' => '', #with these terms
3332 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3336 #super false laziness w/quotation::charge
3339 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3340 my ( $pkg, $comment, $additional );
3341 my ( $setuptax, $taxclass ); #internal taxes
3342 my ( $taxproduct, $override ); #vendor (CCH) taxes
3344 my $separate_bill = '';
3345 my $cust_pkg_ref = '';
3346 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3348 my ( $discountnum, $discountnum_amount, $discountnum_percent ) = ( '','','' );
3349 if ( ref( $_[0] ) ) {
3350 $amount = $_[0]->{amount};
3351 $setup_cost = $_[0]->{setup_cost};
3352 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3353 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3354 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3355 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3356 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3357 : '$'. sprintf("%.2f",$amount);
3358 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3359 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3360 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3361 $additional = $_[0]->{additional} || [];
3362 $taxproduct = $_[0]->{taxproductnum};
3363 $override = { '' => $_[0]->{tax_override} };
3364 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3365 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3366 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3367 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3368 $separate_bill = $_[0]->{separate_bill} || '';
3369 $discountnum = $_[0]->{setup_discountnum};
3370 $discountnum_amount = $_[0]->{setup_discountnum_amount};
3371 $discountnum_percent = $_[0]->{setup_discountnum_percent};
3377 $pkg = @_ ? shift : 'One-time charge';
3378 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3380 $taxclass = @_ ? shift : '';
3384 local $SIG{HUP} = 'IGNORE';
3385 local $SIG{INT} = 'IGNORE';
3386 local $SIG{QUIT} = 'IGNORE';
3387 local $SIG{TERM} = 'IGNORE';
3388 local $SIG{TSTP} = 'IGNORE';
3389 local $SIG{PIPE} = 'IGNORE';
3391 my $oldAutoCommit = $FS::UID::AutoCommit;
3392 local $FS::UID::AutoCommit = 0;
3395 my $part_pkg = new FS::part_pkg ( {
3397 'comment' => $comment,
3401 'classnum' => ( $classnum ? $classnum : '' ),
3402 'setuptax' => $setuptax,
3403 'taxclass' => $taxclass,
3404 'taxproductnum' => $taxproduct,
3405 'setup_cost' => $setup_cost,
3408 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3409 ( 0 .. @$additional - 1 )
3411 'additional_count' => scalar(@$additional),
3412 'setup_fee' => $amount,
3415 my $error = $part_pkg->insert( options => \%options,
3416 tax_overrides => $override,
3419 $dbh->rollback if $oldAutoCommit;
3423 my $pkgpart = $part_pkg->pkgpart;
3424 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3425 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3426 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3427 $error = $type_pkgs->insert;
3429 $dbh->rollback if $oldAutoCommit;
3434 my $cust_pkg = new FS::cust_pkg ( {
3435 'custnum' => $self->custnum,
3436 'pkgpart' => $pkgpart,
3437 'quantity' => $quantity,
3438 'start_date' => $start_date,
3439 'no_auto' => $no_auto,
3440 'separate_bill' => $separate_bill,
3441 'locationnum' => $locationnum,
3442 'setup_discountnum' => $discountnum,
3443 'setup_discountnum_amount' => $discountnum_amount,
3444 'setup_discountnum_percent' => $discountnum_percent,
3447 $error = $cust_pkg->insert;
3449 $dbh->rollback if $oldAutoCommit;
3451 } elsif ( $cust_pkg_ref ) {
3452 ${$cust_pkg_ref} = $cust_pkg;
3456 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3457 'pkg_list' => [ $cust_pkg ],
3460 $dbh->rollback if $oldAutoCommit;
3465 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3470 #=item charge_postal_fee
3472 #Applies a one time charge this customer. If there is an error,
3473 #returns the error, returns the cust_pkg charge object or false
3474 #if there was no charge.
3478 # This should be a customer event. For that to work requires that bill
3479 # also be a customer event.
3481 sub charge_postal_fee {
3484 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3485 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3487 my $cust_pkg = new FS::cust_pkg ( {
3488 'custnum' => $self->custnum,
3489 'pkgpart' => $pkgpart,
3493 my $error = $cust_pkg->insert;
3494 $error ? $error : $cust_pkg;
3497 =item num_cust_attachment_deleted
3499 Returns the number of deleted attachments for this customer (see
3500 L<FS::num_cust_attachment>).
3504 sub num_cust_attachments_deleted {
3507 " SELECT COUNT(*) FROM cust_attachment ".
3508 " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0",
3515 Returns the most recent invnum (invoice number) for this customer.
3522 " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?",
3527 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3529 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3531 Optionally, a list or hashref of additional arguments to the qsearch call can
3538 my $opt = ref($_[0]) ? shift : { @_ };
3540 #return $self->num_cust_bill unless wantarray || keys %$opt;
3542 $opt->{'table'} = 'cust_bill';
3543 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3544 $opt->{'hashref'}{'custnum'} = $self->custnum;
3545 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3547 map { $_ } #behavior of sort undefined in scalar context
3548 sort { $a->_date <=> $b->_date }
3552 =item open_cust_bill
3554 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3559 sub open_cust_bill {
3563 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3569 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3571 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3575 sub legacy_cust_bill {
3578 #return $self->num_legacy_cust_bill unless wantarray;
3580 map { $_ } #behavior of sort undefined in scalar context
3581 sort { $a->_date <=> $b->_date }
3582 qsearch({ 'table' => 'legacy_cust_bill',
3583 'hashref' => { 'custnum' => $self->custnum, },
3584 'order_by' => 'ORDER BY _date ASC',
3588 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3590 Returns all the statements (see L<FS::cust_statement>) for this customer.
3592 Optionally, a list or hashref of additional arguments to the qsearch call can
3597 =item cust_bill_void
3599 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3603 sub cust_bill_void {
3606 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3607 sort { $a->_date <=> $b->_date }
3608 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3611 sub cust_statement {
3613 my $opt = ref($_[0]) ? shift : { @_ };
3615 #return $self->num_cust_statement unless wantarray || keys %$opt;
3617 $opt->{'table'} = 'cust_statement';
3618 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3619 $opt->{'hashref'}{'custnum'} = $self->custnum;
3620 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3622 map { $_ } #behavior of sort undefined in scalar context
3623 sort { $a->_date <=> $b->_date }
3627 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3629 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3631 Optionally, a list or hashref of additional arguments to the qsearch call can
3632 be passed following the SVCDB.
3639 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3640 warn "$me svc_x requires a svcdb";
3643 my $opt = ref($_[0]) ? shift : { @_ };
3645 $opt->{'table'} = $svcdb;
3646 $opt->{'addl_from'} =
3647 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3648 ($opt->{'addl_from'} || '');
3650 my $custnum = $self->custnum;
3651 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3652 my $where = "cust_pkg.custnum = $custnum";
3654 my $extra_sql = $opt->{'extra_sql'} || '';
3655 if ( keys %{ $opt->{'hashref'} } ) {
3656 $extra_sql = " AND $where $extra_sql";
3659 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3660 $extra_sql = "WHERE $where AND $1";
3663 $extra_sql = "WHERE $where $extra_sql";
3666 $opt->{'extra_sql'} = $extra_sql;
3671 # required for use as an eventtable;
3674 $self->svc_x('svc_acct', @_);
3679 Returns all the credits (see L<FS::cust_credit>) for this customer.
3686 #return $self->num_cust_credit unless wantarray;
3688 map { $_ } #behavior of sort undefined in scalar context
3689 sort { $a->_date <=> $b->_date }
3690 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3693 =item cust_credit_pkgnum
3695 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3696 package when using experimental package balances.
3700 sub cust_credit_pkgnum {
3701 my( $self, $pkgnum ) = @_;
3702 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3703 sort { $a->_date <=> $b->_date }
3704 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3705 'pkgnum' => $pkgnum,
3710 =item cust_credit_void
3712 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3716 sub cust_credit_void {
3719 sort { $a->_date <=> $b->_date }
3720 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3725 Returns all the payments (see L<FS::cust_pay>) for this customer.
3731 my $opt = ref($_[0]) ? shift : { @_ };
3733 return $self->num_cust_pay unless wantarray || keys %$opt;
3735 $opt->{'table'} = 'cust_pay';
3736 $opt->{'hashref'}{'custnum'} = $self->custnum;
3738 map { $_ } #behavior of sort undefined in scalar context
3739 sort { $a->_date <=> $b->_date }
3746 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3747 called automatically when the cust_pay method is used in a scalar context.
3753 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3754 my $sth = dbh->prepare($sql) or die dbh->errstr;
3755 $sth->execute($self->custnum) or die $sth->errstr;
3756 $sth->fetchrow_arrayref->[0];
3759 =item unapplied_cust_pay
3761 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3765 sub unapplied_cust_pay {
3769 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3775 =item cust_pay_pkgnum
3777 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3778 package when using experimental package balances.
3782 sub cust_pay_pkgnum {
3783 my( $self, $pkgnum ) = @_;
3784 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3785 sort { $a->_date <=> $b->_date }
3786 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3787 'pkgnum' => $pkgnum,
3794 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3800 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3801 sort { $a->_date <=> $b->_date }
3802 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3805 =item cust_pay_pending
3807 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3808 (without status "done").
3812 sub cust_pay_pending {
3814 return $self->num_cust_pay_pending unless wantarray;
3815 sort { $a->_date <=> $b->_date }
3816 qsearch( 'cust_pay_pending', {
3817 'custnum' => $self->custnum,
3818 'status' => { op=>'!=', value=>'done' },
3823 =item cust_pay_pending_attempt
3825 Returns all payment attempts / declined payments for this customer, as pending
3826 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3827 a corresponding payment (see L<FS::cust_pay>).
3831 sub cust_pay_pending_attempt {
3833 return $self->num_cust_pay_pending_attempt unless wantarray;
3834 sort { $a->_date <=> $b->_date }
3835 qsearch( 'cust_pay_pending', {
3836 'custnum' => $self->custnum,
3843 =item num_cust_pay_pending
3845 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3846 customer (without status "done"). Also called automatically when the
3847 cust_pay_pending method is used in a scalar context.
3851 sub num_cust_pay_pending {
3854 " SELECT COUNT(*) FROM cust_pay_pending ".
3855 " WHERE custnum = ? AND status != 'done' ",
3860 =item num_cust_pay_pending_attempt
3862 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3863 customer, with status "done" but without a corresp. Also called automatically when the
3864 cust_pay_pending method is used in a scalar context.
3868 sub num_cust_pay_pending_attempt {
3871 " SELECT COUNT(*) FROM cust_pay_pending ".
3872 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3879 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3885 map { $_ } #return $self->num_cust_refund unless wantarray;
3886 sort { $a->_date <=> $b->_date }
3887 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3890 =item display_custnum
3892 Returns the displayed customer number for this customer: agent_custid if
3893 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3897 sub display_custnum {
3900 return $self->agent_custid
3901 if $default_agent_custid && $self->agent_custid;
3903 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3907 sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
3908 } elsif ( $custnum_display_length ) {
3909 return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
3911 return $self->custnum;
3917 Returns a name string for this customer, either "Company (Last, First)" or
3924 my $name = $self->contact;
3925 $name = $self->company. " ($name)" if $self->company;
3929 =item batch_payment_payname
3931 Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company,
3932 based on if a company name exists and is the account being used a business account.
3936 sub batch_payment_payname {
3938 my $cust_pay_batch = shift;
3941 if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; }
3942 else { $name = $self->first .' '. $self->last; }
3944 $name = $self->company
3945 if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company);
3950 =item service_contact
3952 Returns the L<FS::contact> object for this customer that has the 'Service'
3953 contact class, or undef if there is no such contact. Deprecated; don't use
3958 sub service_contact {
3960 if ( !exists($self->{service_contact}) ) {
3961 my $classnum = $self->scalar_sql(
3962 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3963 ) || 0; #if it's zero, qsearchs will return nothing
3964 my $cust_contact = qsearchs('cust_contact', {
3965 'classnum' => $classnum,
3966 'custnum' => $self->custnum,
3968 $self->{service_contact} = $cust_contact->contact if $cust_contact;
3970 $self->{service_contact};
3975 Returns a name string for this (service/shipping) contact, either
3976 "Company (Last, First)" or "Last, First".
3983 my $name = $self->ship_contact;
3984 $name = $self->company. " ($name)" if $self->company;
3990 Returns a name string for this customer, either "Company" or "First Last".
3996 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3999 =item ship_name_short
4001 Returns a name string for this (service/shipping) contact, either "Company"
4006 sub ship_name_short {
4008 $self->service_contact
4009 ? $self->ship_contact_firstlast
4015 Returns this customer's full (billing) contact name only, "Last, First"
4021 $self->get('last'). ', '. $self->first;
4026 Returns this customer's full (shipping) contact name only, "Last, First"
4032 my $contact = $self->service_contact || $self;
4033 $contact->get('last') . ', ' . $contact->get('first');
4036 =item contact_firstlast
4038 Returns this customers full (billing) contact name only, "First Last".
4042 sub contact_firstlast {
4044 $self->first. ' '. $self->get('last');
4047 =item ship_contact_firstlast
4049 Returns this customer's full (shipping) contact name only, "First Last".
4053 sub ship_contact_firstlast {
4055 my $contact = $self->service_contact || $self;
4056 $contact->get('first') . ' '. $contact->get('last');
4059 sub bill_country_full {
4061 $self->bill_location->country_full;
4064 sub ship_country_full {
4066 $self->ship_location->country_full;
4069 =item county_state_county [ PREFIX ]
4071 Returns a string consisting of just the county, state and country.
4075 sub county_state_country {
4078 if ( @_ && $_[0] && $self->has_ship_address ) {
4079 $locationnum = $self->ship_locationnum;
4081 $locationnum = $self->bill_locationnum;
4083 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4084 $cust_location->county_state_country;
4087 =item geocode DATA_VENDOR
4089 Returns a value for the customer location as encoded by DATA_VENDOR.
4090 Currently this only makes sense for "CCH" as DATA_VENDOR.
4098 Returns a status string for this customer, currently:
4104 No packages have ever been ordered. Displayed as "No packages".
4108 Recurring packages all are new (not yet billed).
4112 One or more recurring packages is active.
4116 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
4120 All non-cancelled recurring packages are suspended.
4124 All recurring packages are cancelled.
4128 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4129 cust_main-status_module configuration option.
4133 sub status { shift->cust_status(@_); }
4137 return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4138 for my $status ( FS::cust_main->statuses() ) {
4139 my $method = $status.'_sql';
4140 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4141 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4142 $sth->execute( ($self->custnum) x $numnum )
4143 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4144 if ( $sth->fetchrow_arrayref->[0] ) {
4145 $self->hashref->{cust_status} = $status;
4151 =item is_status_delay_cancel
4153 Returns true if customer status is 'suspended'
4154 and all suspended cust_pkg return true for
4155 cust_pkg->is_status_delay_cancel.
4157 This is not a real status, this only meant for hacking display
4158 values, because otherwise treating the customer as suspended is
4159 really the whole point of the delay_cancel option.
4163 sub is_status_delay_cancel {
4165 return 0 unless $self->status eq 'suspended';
4166 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4167 return 0 unless $cust_pkg->is_status_delay_cancel;
4172 =item ucfirst_cust_status
4174 =item ucfirst_status
4176 Deprecated, use the cust_status_label method instead.
4178 Returns the status with the first character capitalized.
4182 sub ucfirst_status {
4183 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4184 local($ucfirst_nowarn) = 1;
4185 shift->ucfirst_cust_status(@_);
4188 sub ucfirst_cust_status {
4189 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4191 ucfirst($self->cust_status);
4194 =item cust_status_label
4198 Returns the display label for this status.
4202 sub status_label { shift->cust_status_label(@_); }
4204 sub cust_status_label {
4206 __PACKAGE__->statuslabels->{$self->cust_status};
4211 Returns a hex triplet color string for this customer's status.
4215 sub statuscolor { shift->cust_statuscolor(@_); }
4217 sub cust_statuscolor {
4219 __PACKAGE__->statuscolors->{$self->cust_status};
4222 =item tickets [ STATUS ]
4224 Returns an array of hashes representing the customer's RT tickets.
4226 An optional status (or arrayref or hashref of statuses) may be specified.
4232 my $status = ( @_ && $_[0] ) ? shift : '';
4234 my $num = $conf->config('cust_main-max_tickets') || 10;
4237 if ( $conf->config('ticket_system') ) {
4238 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4240 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4249 foreach my $priority (
4250 $conf->config('ticket_system-custom_priority_field-values'), ''
4252 last if scalar(@tickets) >= $num;
4254 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4255 $num - scalar(@tickets),
4266 =item appointments [ STATUS ]
4268 Returns an array of hashes representing the customer's RT tickets which
4275 my $status = ( @_ && $_[0] ) ? shift : '';
4277 return () unless $conf->config('ticket_system');
4279 my $queueid = $conf->config('ticket_system-appointment-queueid');
4281 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4290 # Return services representing svc_accts in customer support packages
4291 sub support_services {
4293 my %packages = map { $_ => 1 } $conf->config('support_packages');
4295 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4296 grep { $_->part_svc->svcdb eq 'svc_acct' }
4297 map { $_->cust_svc }
4298 grep { exists $packages{ $_->pkgpart } }
4299 $self->ncancelled_pkgs;
4303 # Return a list of latitude/longitude for one of the services (if any)
4304 sub service_coordinates {
4308 grep { $_->latitude && $_->longitude }
4310 map { $_->cust_svc }
4311 $self->ncancelled_pkgs;
4313 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4318 Returns a masked version of the named field
4323 my ($self,$field) = @_;
4327 'x'x(length($self->getfield($field))-4).
4328 substr($self->getfield($field), (length($self->getfield($field))-4));
4332 =item payment_history
4334 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4335 cust_credit and cust_refund objects. Each hashref has the following fields:
4337 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4339 I<date> - value of _date field, unix timestamp
4341 I<date_pretty> - user-friendly date
4343 I<description> - user-friendly description of item
4345 I<amount> - impact of item on user's balance
4346 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4347 Not to be confused with the native 'amount' field in cust_credit, see below.
4349 I<amount_pretty> - includes money char
4351 I<balance> - customer balance, chronologically as of this item
4353 I<balance_pretty> - includes money char
4355 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4357 I<paid> - amount paid for cust_pay records, undef for other types
4359 I<credit> - amount credited for cust_credit records, undef for other types.
4360 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4362 I<refund> - amount refunded for cust_refund records, undef for other types
4364 The four table-specific keys always have positive values, whether they reflect charges or payments.
4366 The following options may be passed to this method:
4368 I<line_items> - if true, returns charges ('Line item') rather than invoices
4370 I<start_date> - unix timestamp, only include records on or after.
4371 If specified, an item of type 'Previous' will also be included.
4372 It does not have table-specific fields.
4374 I<end_date> - unix timestamp, only include records before
4376 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4378 I<conf> - optional already-loaded FS::Conf object.
4382 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4383 # and also for sending customer statements, which should both be kept customer-friendly.
4384 # If you add anything that shouldn't be passed on through the API or exposed
4385 # to customers, add a new option to include it, don't include it by default
4386 sub payment_history {
4388 my $opt = ref($_[0]) ? $_[0] : { @_ };
4390 my $conf = $$opt{'conf'} || new FS::Conf;
4391 my $money_char = $conf->config("money_char") || '$',
4393 #first load entire history,
4394 #need previous to calculate previous balance
4395 #loading after end_date shouldn't hurt too much?
4397 if ( $$opt{'line_items'} ) {
4399 foreach my $cust_bill ( $self->cust_bill ) {
4402 'type' => 'Line item',
4403 'description' => $_->desc( $self->locale ).
4404 ( $_->sdate && $_->edate
4405 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4406 ' To '. time2str('%d-%b-%Y', $_->edate)
4409 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4410 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4411 'date' => $cust_bill->_date,
4412 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4414 foreach $cust_bill->cust_bill_pkg;
4421 'type' => 'Invoice',
4422 'description' => 'Invoice #'. $_->display_invnum,
4423 'amount' => sprintf('%.2f', $_->charged ),
4424 'charged' => sprintf('%.2f', $_->charged ),
4425 'date' => $_->_date,
4426 'date_pretty' => $self->time2str_local('short', $_->_date ),
4428 foreach $self->cust_bill;
4433 'type' => 'Payment',
4434 'description' => 'Payment', #XXX type
4435 'amount' => sprintf('%.2f', 0 - $_->paid ),
4436 'paid' => sprintf('%.2f', $_->paid ),
4437 'date' => $_->_date,
4438 'date_pretty' => $self->time2str_local('short', $_->_date ),
4440 foreach $self->cust_pay;
4444 'description' => 'Credit', #more info?
4445 'amount' => sprintf('%.2f', 0 -$_->amount ),
4446 'credit' => sprintf('%.2f', $_->amount ),
4447 'date' => $_->_date,
4448 'date_pretty' => $self->time2str_local('short', $_->_date ),
4450 foreach $self->cust_credit;
4454 'description' => 'Refund', #more info? type, like payment?
4455 'amount' => $_->refund,
4456 'refund' => $_->refund,
4457 'date' => $_->_date,
4458 'date_pretty' => $self->time2str_local('short', $_->_date ),
4460 foreach $self->cust_refund;
4462 #put it all in chronological order
4463 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4465 #calculate balance, filter items outside date range
4469 foreach my $item (@history) {
4470 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4471 $balance += $$item{'amount'};
4472 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4473 $previous += $$item{'amount'};
4476 $$item{'balance'} = sprintf("%.2f",$balance);
4477 foreach my $key ( qw(amount balance) ) {
4478 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4483 # start with previous balance, if there was one
4486 'type' => 'Previous',
4487 'description' => 'Previous balance',
4488 'amount' => sprintf("%.2f",$previous),
4489 'balance' => sprintf("%.2f",$previous),
4490 'date' => $$opt{'start_date'},
4491 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4493 #false laziness with above
4494 foreach my $key ( qw(amount balance) ) {
4495 $$item{$key.'_pretty'} = $$item{$key};
4496 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4498 unshift(@out,$item);
4501 @out = reverse @history if $$opt{'reverse_sort'};
4506 =item save_cust_payby
4508 Saves a new cust_payby for this customer, replacing an existing entry only
4509 in select circumstances. Does not validate input.
4511 If auto is specified, marks this as the customer's primary method, or the
4512 specified weight. Existing payment methods have their weight incremented as
4515 If bill_location is specified with auto, also sets location in cust_main.
4517 Will not insert complete duplicates of existing records, or records in which the
4518 only difference from an existing record is to turn off automatic payment (will
4519 return without error.) Will replace existing records in which the only difference
4520 is to add a value to a previously empty preserved field and/or turn on automatic payment.
4521 Fields marked as preserved are optional, and existing values will not be overwritten with
4522 blanks when replacing.
4524 Accepts the following named parameters:
4534 save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
4538 optional, set higher than 1 for secondary, etc.
4546 optional, but should be specified for anything that might be tokenized, will be preserved when replacing
4554 optional, will be preserved when replacing
4562 CARD only, required, FS::cust_location object
4564 =item paystart_month
4566 CARD only, optional, will be preserved when replacing
4570 CARD only, optional, will be preserved when replacing
4574 CARD only, optional, will be preserved when replacing
4578 CARD only, only used if conf cvv-save is set appropriately
4588 =item saved_cust_payby
4590 scalar reference, for returning saved object
4596 #The code for this option is in place, but it's not currently used
4600 # existing cust_payby object to be replaced (must match custnum)
4602 # stateid/stateid_state/ss are not currently supported in cust_payby,
4603 # might not even work properly in 4.x, but will need to work here if ever added
4605 sub save_cust_payby {
4609 my $old = $opt{'replace'};
4610 my $new = new FS::cust_payby { $old ? $old->hash : () };
4611 return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum;
4612 $new->set( 'custnum' => $self->custnum );
4614 my $payby = $opt{'payment_payby'};
4615 return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK'));
4617 # don't allow turning off auto when replacing
4618 $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/;
4620 my @check_existing; # payby relevant to this payment_payby
4622 # set payby based on auto
4623 if ( $payby eq 'CARD' ) {
4624 $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) );
4625 @check_existing = qw( CARD DCRD );
4626 } elsif ( $payby eq 'CHEK' ) {
4627 $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) );
4628 @check_existing = qw( CHEK DCHK );
4631 $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' );
4634 $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized
4635 $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask
4636 $new->set( 'payname' => $opt{'payname'} );
4637 $new->set( 'payip' => $opt{'payip'} ); # will be preserved below
4639 my $conf = new FS::Conf;
4641 # compare to FS::cust_main::realtime_bop - check both to make sure working correctly
4642 if ( $payby eq 'CARD' &&
4643 ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save'))
4644 || $conf->exists('business-onlinepayment-verification')
4647 $new->set( 'paycvv' => $opt{'paycvv'} );
4649 $new->set( 'paycvv' => '');
4652 local $SIG{HUP} = 'IGNORE';
4653 local $SIG{INT} = 'IGNORE';
4654 local $SIG{QUIT} = 'IGNORE';
4655 local $SIG{TERM} = 'IGNORE';
4656 local $SIG{TSTP} = 'IGNORE';
4657 local $SIG{PIPE} = 'IGNORE';
4659 my $oldAutoCommit = $FS::UID::AutoCommit;
4660 local $FS::UID::AutoCommit = 0;
4663 # set fields specific to payment_payby
4664 if ( $payby eq 'CARD' ) {
4665 if ($opt{'bill_location'}) {
4666 $opt{'bill_location'}->set('custnum' => $self->custnum);
4667 my $error = $opt{'bill_location'}->find_or_insert;
4669 $dbh->rollback if $oldAutoCommit;
4672 $new->set( 'locationnum' => $opt{'bill_location'}->locationnum );
4674 foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) {
4675 $new->set( $field => $opt{$field} );
4678 foreach my $field ( qw(paytype paystate) ) {
4679 $new->set( $field => $opt{$field} );
4683 # other cust_payby to compare this to
4684 my @existing = $self->cust_payby(@check_existing);
4686 # fields that can overwrite blanks with values, but not values with blanks
4687 my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip );
4689 my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby
4691 # generally, we don't want to overwrite existing cust_payby with this,
4692 # but we can replace if we're only marking it auto or adding a preserved field
4693 # and we can avoid saving a total duplicate or merely turning off auto
4695 foreach my $cust_payby (@existing) {
4696 # check fields that absolutely should not change
4697 foreach my $field ($new->fields) {
4698 next if grep(/^$field$/, qw( custpaybynum payby weight ) );
4699 next if grep(/^$field$/, @preserve );
4700 next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
4701 # check if paymask exists, if so stop and don't save, no need for a duplicate.
4702 return '' if $new->get('paymask') eq $cust_payby->get('paymask');
4704 # now check fields that can replace if one value is blank
4706 foreach my $field (@preserve) {
4708 ( $new->get($field) and !$cust_payby->get($field) ) or
4709 ( $cust_payby->get($field) and !$new->get($field) )
4711 # prevention of overwriting values with blanks happens farther below
4713 } elsif ( $new->get($field) ne $cust_payby->get($field) ) {
4717 unless ( $replace ) {
4718 # nearly identical, now check weight
4719 if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) {
4720 # ignore identical cust_payby, and ignore attempts to turn off auto
4721 # no need to save or re-weight cust_payby (but still need to update/commit $self)
4722 $skip_cust_payby = 1;
4725 # otherwise, only change is to mark this as primary
4727 # if we got this far, we're definitely replacing
4734 $new->set( 'custpaybynum' => $old->custpaybynum );
4735 # don't turn off automatic payment (but allow it to be turned on)
4736 if ($new->payby =~ /^D/ and $new->payby ne $old->payby) {
4738 $new->set( 'payby' => $old->payby );
4739 $new->set( 'weight' => 1 );
4741 # make sure we're not overwriting values with blanks
4742 foreach my $field (@preserve) {
4743 if ( $old->get($field) and !$new->get($field) ) {
4744 $new->set( $field => $old->get($field) );
4749 # only overwrite cust_main bill_location if auto
4750 if ($opt{'auto'} && $opt{'bill_location'}) {
4751 $self->set('bill_location' => $opt{'bill_location'});
4752 my $error = $self->replace;
4754 $dbh->rollback if $oldAutoCommit;
4759 # done with everything except reweighting and saving cust_payby
4760 # still need to commit changes to cust_main and cust_location
4761 if ($skip_cust_payby) {
4762 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4766 # re-weight existing primary cust_pay for this payby
4768 foreach my $cust_payby (@existing) {
4769 # relies on cust_payby return order
4770 last unless $cust_payby->payby !~ /^D/;
4771 last if $cust_payby->weight > 1;
4772 next if $new->custpaybynum eq $cust_payby->custpaybynum;
4773 next if $cust_payby->weight < ($opt{'weight'} || 1);
4774 $cust_payby->weight( $cust_payby->weight + 1 );
4775 my $error = $cust_payby->replace;
4777 $dbh->rollback if $oldAutoCommit;
4778 return "Error reweighting cust_payby: $error";
4783 # finally, save cust_payby
4784 my $error = $old ? $new->replace($old) : $new->insert;
4786 $dbh->rollback if $oldAutoCommit;
4790 ${$opt{'saved_cust_payby'}} = $new
4791 if $opt{'saved_cust_payby'};
4793 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4798 =item remove_cvv_from_cust_payby PAYINFO
4800 Removes paycvv from associated cust_payby with matching PAYINFO.
4804 sub remove_cvv_from_cust_payby {
4805 my ($self,$payinfo) = @_;
4807 my $oldAutoCommit = $FS::UID::AutoCommit;
4808 local $FS::UID::AutoCommit = 0;
4811 foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) {
4812 next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo
4813 $cust_payby->paycvv('');
4814 my $error = $cust_payby->replace;
4816 $dbh->rollback if $oldAutoCommit;
4821 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4827 =head1 CLASS METHODS
4833 Class method that returns the list of possible status strings for customers
4834 (see L<the status method|/status>). For example:
4836 @statuses = FS::cust_main->statuses();
4842 keys %{ $self->statuscolors };
4845 =item cust_status_sql
4847 Returns an SQL fragment to determine the status of a cust_main record, as a
4852 sub cust_status_sql {
4854 for my $status ( FS::cust_main->statuses() ) {
4855 my $method = $status.'_sql';
4856 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4865 Returns an SQL expression identifying prospective cust_main records (customers
4866 with no packages ever ordered)
4870 use vars qw($select_count_pkgs);
4871 $select_count_pkgs =
4872 "SELECT COUNT(*) FROM cust_pkg
4873 WHERE cust_pkg.custnum = cust_main.custnum";
4875 sub select_count_pkgs_sql {
4880 " 0 = ( $select_count_pkgs ) ";
4885 Returns an SQL expression identifying ordered cust_main records (customers with
4886 no active packages, but recurring packages not yet setup or one time charges
4892 FS::cust_main->none_active_sql.
4893 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4898 Returns an SQL expression identifying active cust_main records (customers with
4899 active recurring packages).
4904 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4907 =item none_active_sql
4909 Returns an SQL expression identifying cust_main records with no active
4910 recurring packages. This includes customers of status prospect, ordered,
4911 inactive, and suspended.
4915 sub none_active_sql {
4916 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4921 Returns an SQL expression identifying inactive cust_main records (customers with
4922 no active recurring packages, but otherwise unsuspended/uncancelled).
4927 FS::cust_main->none_active_sql.
4928 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4934 Returns an SQL expression identifying suspended cust_main records.
4939 sub suspended_sql { susp_sql(@_); }
4941 FS::cust_main->none_active_sql.
4942 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4948 Returns an SQL expression identifying cancelled cust_main records.
4952 sub cancel_sql { shift->cancelled_sql(@_); }
4955 =item uncancelled_sql
4957 Returns an SQL expression identifying un-cancelled cust_main records.
4961 sub uncancelled_sql { uncancel_sql(@_); }
4964 "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
4969 Returns an SQL fragment to retreive the balance.
4974 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4975 WHERE cust_bill.custnum = cust_main.custnum )
4976 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4977 WHERE cust_pay.custnum = cust_main.custnum )
4978 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4979 WHERE cust_credit.custnum = cust_main.custnum )
4980 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4981 WHERE cust_refund.custnum = cust_main.custnum )
4984 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4986 Returns an SQL fragment to retreive the balance for this customer, optionally
4987 considering invoices with date earlier than START_TIME, and not
4988 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4989 total_unapplied_payments).
4991 Times are specified as SQL fragments or numeric
4992 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4993 L<Date::Parse> for conversion functions. The empty string can be passed
4994 to disable that time constraint completely.
4996 Available options are:
5000 =item unapplied_date
5002 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)
5007 set to true to remove all customer comparison clauses, for totals
5012 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5017 JOIN clause (typically used with the total option)
5021 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
5022 time will be ignored. Note that START_TIME and END_TIME only limit the date
5023 range for invoices and I<unapplied> payments, credits, and refunds.
5029 sub balance_date_sql {
5030 my( $class, $start, $end, %opt ) = @_;
5032 my $cutoff = $opt{'cutoff'};
5034 my $owed = FS::cust_bill->owed_sql($cutoff);
5035 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
5036 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
5037 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5039 my $j = $opt{'join'} || '';
5041 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5042 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5043 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5044 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5046 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5047 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5048 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5049 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5054 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
5056 Returns an SQL fragment to retreive the total unapplied payments for this
5057 customer, only considering payments with date earlier than START_TIME, and
5058 optionally not later than END_TIME.
5060 Times are specified as SQL fragments or numeric
5061 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5062 L<Date::Parse> for conversion functions. The empty string can be passed
5063 to disable that time constraint completely.
5065 Available options are:
5069 sub unapplied_payments_date_sql {
5070 my( $class, $start, $end, %opt ) = @_;
5072 my $cutoff = $opt{'cutoff'};
5074 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5076 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
5077 'unapplied_date'=>1 );
5079 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
5082 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5084 Helper method for balance_date_sql; name (and usage) subject to change
5085 (suggestions welcome).
5087 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5088 cust_refund, cust_credit or cust_pay).
5090 If TABLE is "cust_bill" or the unapplied_date option is true, only
5091 considers records with date earlier than START_TIME, and optionally not
5092 later than END_TIME .
5096 sub _money_table_where {
5097 my( $class, $table, $start, $end, %opt ) = @_;
5100 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5101 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5102 push @where, "$table._date <= $start" if defined($start) && length($start);
5103 push @where, "$table._date > $end" if defined($end) && length($end);
5105 push @where, @{$opt{'where'}} if $opt{'where'};
5106 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5112 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5113 use FS::cust_main::Search;
5116 FS::cust_main::Search->search(@_);
5125 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5127 Generates a templated notification to the customer (see L<Text::Template>).
5129 OPTIONS is a hash and may include
5131 I<extra_fields> - a hashref of name/value pairs which will be substituted
5132 into the template. These values may override values mentioned below
5133 and those from the customer record.
5135 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5137 The following variables are available in the template instead of or in addition
5138 to the fields of the customer record.
5140 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5144 # a lot like cust_bill::print_latex
5145 sub generate_letter {
5146 my ($self, $template, %options) = @_;
5148 warn "Template $template does not exist" && return
5149 unless $conf->exists($template) || $options{'template_text'};
5151 my $template_source = $options{'template_text'}
5152 ? [ $options{'template_text'} ]
5153 : [ map "$_\n", $conf->config($template) ];
5155 my $letter_template = new Text::Template
5157 SOURCE => $template_source,
5158 DELIMITERS => [ '[@--', '--@]' ],
5160 or die "can't create new Text::Template object: Text::Template::ERROR";
5162 $letter_template->compile()
5163 or die "can't compile template: Text::Template::ERROR";
5165 my %letter_data = map { $_ => $self->$_ } $self->fields;
5167 for (keys %{$options{extra_fields}}){
5168 $letter_data{$_} = $options{extra_fields}->{$_};
5171 unless(exists($letter_data{returnaddress})){
5172 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5173 $self->agent_template)
5175 if ( length($retadd) ) {
5176 $letter_data{returnaddress} = $retadd;
5177 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5178 $letter_data{returnaddress} =
5179 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5183 ( $conf->config('company_name', $self->agentnum),
5184 $conf->config('company_address', $self->agentnum),
5188 $letter_data{returnaddress} = '~';
5192 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5194 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5196 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5198 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5202 ) or die "can't open temp file: $!\n";
5203 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5204 or die "can't write temp file: $!\n";
5206 $letter_data{'logo_file'} = $lh->filename;
5208 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5212 ) or die "can't open temp file: $!\n";
5214 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5216 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5217 return ($1, $letter_data{'logo_file'});
5221 =item print_ps TEMPLATE
5223 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5229 my($file, $lfile) = $self->generate_letter(@_);
5230 my $ps = FS::Misc::generate_ps($file);
5231 unlink($file.'.tex');
5237 =item print TEMPLATE
5239 Prints the filled in template.
5241 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5245 sub queueable_print {
5248 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5249 or die "invalid customer number: " . $opt{custnum};
5251 #do not backport this change to 3.x
5252 # my $error = $self->print( { 'template' => $opt{template} } );
5253 my $error = $self->print( $opt{'template'} );
5254 die $error if $error;
5258 my ($self, $template) = (shift, shift);
5260 [ $self->print_ps($template) ],
5261 'agentnum' => $self->agentnum,
5265 #these three subs should just go away once agent stuff is all config overrides
5267 sub agent_template {
5269 $self->_agent_plandata('agent_templatename');
5272 sub agent_invoice_from {
5274 $self->_agent_plandata('agent_invoice_from');
5277 sub _agent_plandata {
5278 my( $self, $option ) = @_;
5280 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5281 #agent-specific Conf
5283 use FS::part_event::Condition;
5285 my $agentnum = $self->agentnum;
5287 my $regexp = regexp_sql();
5289 my $part_event_option =
5291 'select' => 'part_event_option.*',
5292 'table' => 'part_event_option',
5294 LEFT JOIN part_event USING ( eventpart )
5295 LEFT JOIN part_event_option AS peo_agentnum
5296 ON ( part_event.eventpart = peo_agentnum.eventpart
5297 AND peo_agentnum.optionname = 'agentnum'
5298 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5300 LEFT JOIN part_event_condition
5301 ON ( part_event.eventpart = part_event_condition.eventpart
5302 AND part_event_condition.conditionname = 'cust_bill_age'
5304 LEFT JOIN part_event_condition_option
5305 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5306 AND part_event_condition_option.optionname = 'age'
5309 #'hashref' => { 'optionname' => $option },
5310 #'hashref' => { 'part_event_option.optionname' => $option },
5312 " WHERE part_event_option.optionname = ". dbh->quote($option).
5313 " AND action = 'cust_bill_send_agent' ".
5314 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5315 " AND peo_agentnum.optionname = 'agentnum' ".
5316 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5318 CASE WHEN part_event_condition_option.optionname IS NULL
5320 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5322 , part_event.weight".
5326 unless ( $part_event_option ) {
5327 return $self->agent->invoice_template || ''
5328 if $option eq 'agent_templatename';
5332 $part_event_option->optionvalue;
5336 sub process_o2m_qsearch {
5339 return qsearch($table, @_) unless $table eq 'contact';
5341 my $hashref = shift;
5342 my %hash = %$hashref;
5343 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5344 or die 'guru meditation #4343';
5346 qsearch({ 'table' => 'contact',
5347 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5348 'hashref' => \%hash,
5349 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5350 " cust_contact.custnum = $custnum "
5354 sub process_o2m_qsearchs {
5357 return qsearchs($table, @_) unless $table eq 'contact';
5359 my $hashref = shift;
5360 my %hash = %$hashref;
5361 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5362 or die 'guru meditation #2121';
5364 qsearchs({ 'table' => 'contact',
5365 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5366 'hashref' => \%hash,
5367 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5368 " cust_contact.custnum = $custnum "
5372 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5374 Subroutine (not a method), designed to be called from the queue.
5376 Takes a list of options and values.
5378 Pulls up the customer record via the custnum option and calls bill_and_collect.
5383 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5385 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5386 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5388 #without this errors don't get rolled back
5389 $args{'fatal'} = 1; # runs from job queue, will be caught
5391 $cust_main->bill_and_collect( %args );
5394 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5396 Like queued_bill, but instead of C<bill_and_collect>, just runs the
5397 C<collect> part. This is used in batch tax calculation, where invoice
5398 generation and collection events have to be completely separated.
5402 sub queued_collect {
5404 my $cust_main = FS::cust_main->by_key($args{'custnum'});
5406 $cust_main->collect(%args);
5409 sub process_bill_and_collect {
5412 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5413 or die "custnum '$param->{custnum}' not found!\n";
5414 $param->{'job'} = $job;
5415 $param->{'fatal'} = 1; # runs from job queue, will be caught
5416 $param->{'retry'} = 1;
5419 eval { $cust_main->bill_and_collect( %$param) };
5421 die $@ =~ /cancel_pkgs cannot be run inside a transaction/
5422 ? "Bill Now unavailable for customer with pending package expiration\n"
5427 =item pending_invoice_count
5429 Return number of cust_bill with pending=Y for this customer
5433 sub pending_invoice_count {
5434 FS::cust_bill->count( 'custnum = '.shift->custnum."AND pending = 'Y'" );
5437 =item cust_locations_missing_district
5439 Always returns empty list, unless tax_district_method eq 'wa_sales'
5441 Return cust_location rows for this customer, associated with active
5442 customer packages, where tax district column is empty. Presense of
5443 these rows should block billing, because invoice would be generated
5444 with incorrect taxes
5448 sub cust_locations_missing_district {
5451 my $tax_district_method = FS::Conf->new->config('tax_district_method');
5454 unless $tax_district_method
5455 && $tax_district_method eq 'wa_sales';
5458 table => 'cust_location',
5459 select => 'cust_location.*',
5461 LEFT JOIN cust_main USING (custnum)
5462 LEFT JOIN cust_pkg ON cust_location.locationnum = cust_pkg.locationnum
5464 extra_sql => sprintf(q{
5465 WHERE cust_location.state = 'WA'
5466 AND cust_location.custnum = %s
5468 cust_location.district IS NULL
5469 or cust_location.district = ''
5471 AND cust_pkg.pkgnum IS NOT NULL
5473 cust_pkg.cancel > %s
5474 OR cust_pkg.cancel IS NULL
5477 $self->custnum, time()
5482 #starting to take quite a while for big dbs
5483 # (JRNL: journaled so it only happens once per database)
5484 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5485 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5486 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5487 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5488 # JRNL leading/trailing spaces in first, last, company
5489 # JRNL migrate to cust_payby
5490 # - otaker upgrade? journal and call it good? (double check to make sure
5491 # we're not still setting otaker here)
5493 #only going to get worse with new location stuff...
5495 sub _upgrade_data { #class method
5496 my ($class, %opts) = @_;
5498 my @statements = ();
5500 #this seems to be the only expensive one.. why does it take so long?
5501 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5503 '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';
5504 FS::upgrade_journal->set_done('cust_main__signupdate');
5508 foreach my $sql ( @statements ) {
5509 my $sth = dbh->prepare($sql) or die dbh->errstr;
5510 $sth->execute or die $sth->errstr;
5511 #warn ( (time - $t). " seconds\n" );
5515 local($ignore_expired_card) = 1;
5516 local($ignore_banned_card) = 1;
5517 local($skip_fuzzyfiles) = 1;
5518 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5520 FS::cust_main::Location->_upgrade_data(%opts);
5522 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5524 foreach my $cust_main ( qsearch({
5525 'table' => 'cust_main',
5527 'extra_sql' => 'WHERE '.
5529 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5530 qw( first last company )
5533 my $error = $cust_main->replace;
5534 die $error if $error;
5537 FS::upgrade_journal->set_done('cust_main__trimspaces');
5541 $class->_upgrade_otaker(%opts);
5543 # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
5544 # existing records will be encrypted in queueable_upgrade (below)
5545 unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
5546 eval "use FS::Setup";
5548 FS::Setup::enable_encryption();
5553 sub queueable_upgrade {
5556 ### encryption gets turned on in _upgrade_data, above
5558 eval "use FS::upgrade_journal";
5561 # prior to 2013 (commit f16665c9) payinfo was stored in history if not
5562 # encrypted, clear that out before encrypting/tokenizing anything else
5563 if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
5564 foreach my $table (qw(
5565 cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
5568 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
5569 my $sth = dbh->prepare($sql) or die dbh->errstr;
5570 $sth->execute or die $sth->errstr;
5572 FS::upgrade_journal->set_done('clear_payinfo_history');
5575 # fix Tokenized paycardtype and encrypt old records
5576 if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
5577 || ! FS::upgrade_journal->is_done('encryption_check')
5581 # allow replacement of closed cust_pay/cust_refund records
5582 local $FS::payinfo_Mixin::allow_closed_replace = 1;
5584 # because it looks like nothing's changing
5585 local $FS::Record::no_update_diff = 1;
5587 # commit everything immediately
5588 local $FS::UID::AutoCommit = 1;
5590 # encrypt what's there
5591 foreach my $table (qw(
5592 cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
5594 my $tclass = 'FS::'.$table;
5598 my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)
5600 my $record = $tclass->by_key($recnum);
5601 next unless $record; # small chance it's been deleted, that's ok
5602 next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
5603 # window for possible conflict is practically nonexistant,
5604 # but just in case...
5605 $record = $record->select_for_update;
5606 if (!$record->custnum && $table eq 'cust_pay_pending') {
5607 $record->set('custnum_pending',1);
5609 $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
5611 local($ignore_expired_card) = 1;
5612 local($ignore_banned_card) = 1;
5613 local($skip_fuzzyfiles) = 1;
5614 local($import) = 1;#prevent automatic geocoding (need its own variable?)
5616 my $error = $record->replace;
5617 die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
5621 FS::upgrade_journal->set_done('paycardtype_Tokenized');
5622 FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
5625 # now that everything's encrypted, tokenize...
5626 FS::cust_main::Billing_Realtime::token_check(@_);
5629 # not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
5630 # cust_payby might get deleted while this runs
5632 sub _upgrade_next_recnum {
5633 my ($dbh,$table,$lastrecnum,$recnums) = @_;
5634 my $recnum = shift @$recnums;
5635 return $recnum if $recnum;
5636 my $tclass = 'FS::'.$table;
5637 my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : '';
5638 my $sql = 'SELECT '.$tclass->primary_key.
5640 ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
5641 " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
5642 " AND ( length(payinfo) < 80$paycardtypecheck ) ".
5643 ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
5644 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
5645 $sth->execute() or die $sth->errstr;
5647 while (my $rec = $sth->fetchrow_hashref) {
5648 push @$recnums, $rec->{$tclass->primary_key};
5651 $$lastrecnum = $$recnums[-1];
5652 return shift @$recnums;
5661 The delete method should possibly take an FS::cust_main object reference
5662 instead of a scalar customer number.
5664 Bill and collect options should probably be passed as references instead of a
5667 There should probably be a configuration file with a list of allowed credit
5670 No multiple currency support (probably a larger project than just this module).
5672 Birthdates rely on negative epoch values.
5674 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5678 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5679 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5680 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.