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;
83 # 1 is mostly method/subroutine entry and options
84 # 2 traces progress of some operations
85 # 3 is even more information including possibly sensitive data
87 our $me = '[FS::cust_main]';
90 our $ignore_expired_card = 0;
91 our $ignore_banned_card = 0;
92 our $ignore_invalid_card = 0;
94 our $skip_fuzzyfiles = 0;
96 our $ucfirst_nowarn = 0;
98 #this info is in cust_payby as of 4.x
99 #this and the fields themselves can be removed in 5.x
100 our @encrypted_fields = ('payinfo', 'paycvv');
101 sub nohistory_fields { ('payinfo', 'paycvv'); }
104 our $default_agent_custid;
105 our $custnum_display_length;
106 #ask FS::UID to run this stuff for us later
107 #$FS::UID::callback{'FS::cust_main'} = sub {
108 install_callback FS::UID sub {
109 $conf = new FS::Conf;
110 $ignore_invalid_card = $conf->exists('allow_invalid_cards');
111 $default_agent_custid = $conf->exists('cust_main-default_agent_custid');
112 $custnum_display_length = $conf->config('cust_main-custnum-display_length');
117 my ( $hashref, $cache ) = @_;
118 if ( exists $hashref->{'pkgnum'} ) {
119 #@{ $self->{'_pkgnum'} } = ();
120 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
121 $self->{'_pkgnum'} = $subcache;
122 #push @{ $self->{'_pkgnum'} },
123 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
129 FS::cust_main - Object methods for cust_main records
135 $record = new FS::cust_main \%hash;
136 $record = new FS::cust_main { 'column' => 'value' };
138 $error = $record->insert;
140 $error = $new_record->replace($old_record);
142 $error = $record->delete;
144 $error = $record->check;
146 @cust_pkg = $record->all_pkgs;
148 @cust_pkg = $record->ncancelled_pkgs;
150 @cust_pkg = $record->suspended_pkgs;
152 $error = $record->bill;
153 $error = $record->bill %options;
154 $error = $record->bill 'time' => $time;
156 $error = $record->collect;
157 $error = $record->collect %options;
158 $error = $record->collect 'invoice_time' => $time,
163 An FS::cust_main object represents a customer. FS::cust_main inherits from
164 FS::Record. The following fields are currently supported:
170 Primary key (assigned automatically for new customers)
174 Agent (see L<FS::agent>)
178 Advertising source (see L<FS::part_referral>)
190 Cocial security number (optional)
214 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
218 Payment Information (See L<FS::payinfo_Mixin> for data format)
222 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
226 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
230 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
234 Start date month (maestro/solo cards only)
238 Start date year (maestro/solo cards only)
242 Issue number (maestro/solo cards only)
246 Name on card or billing name
250 IP address from which payment information was received
254 Tax exempt, empty or `Y'
258 Order taker (see L<FS::access_user>)
264 =item referral_custnum
266 Referring customer number
270 Enable individual CDR spooling, empty or `Y'
274 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
278 Discourage individual CDR printing, empty or `Y'
282 Allow self-service editing of ticket subjects, empty or 'Y'
284 =item calling_list_exempt
286 Do not call, empty or 'Y'
288 =item invoice_ship_address
290 Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
300 Creates a new customer. To add the customer to the database, see L<"insert">.
302 Note that this stores the hash reference, not a distinct copy of the hash it
303 points to. You can ask the object for a copy with the I<hash> method.
307 sub table { 'cust_main'; }
309 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
311 Adds this customer to the database. If there is an error, returns the error,
312 otherwise returns false.
314 Usually the customer's location will not yet exist in the database, and
315 the C<bill_location> and C<ship_location> pseudo-fields must be set to
316 uninserted L<FS::cust_location> objects. These will be inserted and linked
317 (in both directions) to the new customer record. If they're references
318 to the same object, they will become the same location.
320 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
321 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
322 are inserted atomicly, or the transaction is rolled back. Passing an empty
323 hash reference is equivalent to not supplying this parameter. There should be
324 a better explanation of this, but until then, here's an example:
327 tie %hash, 'Tie::RefHash'; #this part is important
329 $cust_pkg => [ $svc_acct ],
332 $cust_main->insert( \%hash );
334 INVOICING_LIST_ARYREF: No longer supported.
336 Currently available options are: I<depend_jobnum>, I<noexport>,
337 I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
339 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
340 on the supplied jobnum (they will not run until the specific job completes).
341 This can be used to defer provisioning until some action completes (such
342 as running the customer's credit card successfully).
344 The I<noexport> option is deprecated. If I<noexport> is set true, no
345 provisioning jobs (exports) are scheduled. (You can schedule them later with
346 the B<reexport> method.)
348 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
349 of tax names and exemption numbers. FS::cust_main_exemption records will be
350 created and inserted.
352 If I<prospectnum> is set, moves contacts and locations from that prospect.
354 If I<contact> is set to an arrayref of FS::contact objects, those will be
357 If I<contact_params> is set to a hashref of CGI parameters (and I<contact> is
358 unset), inserts those new contacts with this new customer. Handles CGI
359 paramaters for an "m2" multiple entry field as passed by edit/cust_main.cgi
361 If I<cust_payby_params> is set to a hashref o fCGI parameters, inserts those
362 new stored payment records with this new customer. Handles CGI parameters
363 for an "m2" multiple entry field as passed by edit/cust_main.cgi
369 my $cust_pkgs = @_ ? shift : {};
371 if ( $_[0] and ref($_[0]) eq 'ARRAY' ) {
372 warn "cust_main::insert using deprecated invoicing list argument";
373 $invoicing_list = shift;
376 warn "$me insert called with options ".
377 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
380 local $SIG{HUP} = 'IGNORE';
381 local $SIG{INT} = 'IGNORE';
382 local $SIG{QUIT} = 'IGNORE';
383 local $SIG{TERM} = 'IGNORE';
384 local $SIG{TSTP} = 'IGNORE';
385 local $SIG{PIPE} = 'IGNORE';
387 my $oldAutoCommit = $FS::UID::AutoCommit;
388 local $FS::UID::AutoCommit = 0;
391 my $prepay_identifier = '';
392 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
394 if ( $self->payby eq 'PREPAY' ) {
396 $self->payby(''); #'BILL');
397 $prepay_identifier = $self->payinfo;
400 warn " looking up prepaid card $prepay_identifier\n"
403 my $error = $self->get_prepay( $prepay_identifier,
404 'amount_ref' => \$amount,
405 'seconds_ref' => \$seconds,
406 'upbytes_ref' => \$upbytes,
407 'downbytes_ref' => \$downbytes,
408 'totalbytes_ref' => \$totalbytes,
411 $dbh->rollback if $oldAutoCommit;
412 #return "error applying prepaid card (transaction rolled back): $error";
416 $payby = 'PREP' if $amount;
418 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
421 $self->payby(''); #'BILL');
422 $amount = $self->paid;
427 foreach my $l (qw(bill_location ship_location)) {
429 my $loc = delete $self->hashref->{$l} or next;
431 if ( !$loc->locationnum ) {
432 # warn the location that we're going to insert it with no custnum
433 $loc->set(custnum_pending => 1);
434 warn " inserting $l\n"
436 my $error = $loc->insert;
438 $dbh->rollback if $oldAutoCommit;
439 my $label = $l eq 'ship_location' ? 'service' : 'billing';
440 return "$error (in $label location)";
443 } elsif ( $loc->prospectnum ) {
445 $loc->prospectnum('');
446 $loc->set(custnum_pending => 1);
447 my $error = $loc->replace;
449 $dbh->rollback if $oldAutoCommit;
450 my $label = $l eq 'ship_location' ? 'service' : 'billing';
451 return "$error (moving $label location)";
454 } elsif ( ($loc->custnum || 0) > 0 ) {
455 # then it somehow belongs to another customer--shouldn't happen
456 $dbh->rollback if $oldAutoCommit;
457 return "$l belongs to customer ".$loc->custnum;
459 # else it already belongs to this customer
460 # (happens when ship_location is identical to bill_location)
462 $self->set($l.'num', $loc->locationnum);
464 if ( $self->get($l.'num') eq '' ) {
465 $dbh->rollback if $oldAutoCommit;
470 warn " inserting $self\n"
473 $self->signupdate(time) unless $self->signupdate;
475 $self->auto_agent_custid()
476 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
478 my $error = $self->check_payinfo_cardtype
479 || $self->SUPER::insert;
481 $dbh->rollback if $oldAutoCommit;
482 #return "inserting cust_main record (transaction rolled back): $error";
486 # now set cust_location.custnum
487 foreach my $l (qw(bill_location ship_location)) {
488 warn " setting $l.custnum\n"
490 my $loc = $self->$l or next;
491 unless ( $loc->custnum ) {
492 $loc->set(custnum => $self->custnum);
493 $error ||= $loc->replace;
497 $dbh->rollback if $oldAutoCommit;
498 return "error setting $l custnum: $error";
502 warn " setting customer tags\n"
505 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
506 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
507 'custnum' => $self->custnum };
508 my $error = $cust_tag->insert;
510 $dbh->rollback if $oldAutoCommit;
515 my $prospectnum = delete $options{'prospectnum'};
516 if ( $prospectnum ) {
518 warn " moving contacts and locations from prospect $prospectnum\n"
522 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
523 unless ( $prospect_main ) {
524 $dbh->rollback if $oldAutoCommit;
525 return "Unknown prospectnum $prospectnum";
527 $prospect_main->custnum($self->custnum);
528 $prospect_main->disabled('Y');
529 my $error = $prospect_main->replace;
531 $dbh->rollback if $oldAutoCommit;
535 foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
536 my $cust_contact = new FS::cust_contact {
537 'custnum' => $self->custnum,
538 'invoice_dest' => 'Y', # invoice_dest currently not set for prospect contacts
539 map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
541 my $error = $cust_contact->insert
542 || $prospect_contact->delete;
544 $dbh->rollback if $oldAutoCommit;
549 my @cust_location = $prospect_main->cust_location;
550 my @qual = $prospect_main->qual;
552 foreach my $r ( @cust_location, @qual ) {
554 $r->custnum($self->custnum);
555 my $error = $r->replace;
557 $dbh->rollback if $oldAutoCommit;
561 # since we set invoice_dest on all migrated prospect contacts (for now),
562 # don't process invoicing_list.
563 delete $options{'invoicing_list'};
564 $invoicing_list = undef;
567 warn " setting contacts\n"
570 $invoicing_list ||= $options{'invoicing_list'};
571 if ( $invoicing_list ) {
573 $invoicing_list = [ $invoicing_list ] if !ref($invoicing_list);
576 foreach my $dest (@$invoicing_list ) {
577 if ($dest eq 'POST') {
578 $self->set('postal_invoice', 'Y');
581 my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
582 if ( $contact_email ) {
583 my $cust_contact = FS::cust_contact->new({
584 contactnum => $contact_email->contactnum,
585 custnum => $self->custnum,
587 $cust_contact->set('invoice_dest', 'Y');
588 my $error = $cust_contact->insert;
590 $dbh->rollback if $oldAutoCommit;
591 return "$error (linking to email address $dest)";
595 # this email address is not yet linked to any contact
596 $email .= ',' if length($email);
604 my $contact = FS::contact->new({
605 'custnum' => $self->get('custnum'),
606 'last' => $self->get('last'),
607 'first' => $self->get('first'),
608 'emailaddress' => $email,
609 'invoice_dest' => 'Y', # yes, you can set this via the contact
611 my $error = $contact->insert;
613 $dbh->rollback if $oldAutoCommit;
621 if ( my $contact = delete $options{'contact'} ) {
623 foreach my $c ( @$contact ) {
624 $c->custnum($self->custnum);
625 my $error = $c->insert;
627 $dbh->rollback if $oldAutoCommit;
633 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
635 my $error = $self->process_o2m( 'table' => 'contact',
636 'fields' => FS::contact->cgi_contact_fields,
637 'params' => $contact_params,
640 $dbh->rollback if $oldAutoCommit;
645 warn " setting cust_payby\n"
648 if ( $options{cust_payby} ) {
650 foreach my $cust_payby ( @{ $options{cust_payby} } ) {
651 $cust_payby->custnum($self->custnum);
652 my $error = $cust_payby->insert;
654 $dbh->rollback if $oldAutoCommit;
659 } elsif ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
661 my $error = $self->process_o2m(
662 'table' => 'cust_payby',
663 'fields' => FS::cust_payby->cgi_cust_payby_fields,
664 'params' => $cust_payby_params,
665 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
668 $dbh->rollback if $oldAutoCommit;
674 warn " setting cust_main_exemption\n"
677 my $tax_exemption = delete $options{'tax_exemption'};
678 if ( $tax_exemption ) {
680 $tax_exemption = { map { $_ => '' } @$tax_exemption }
681 if ref($tax_exemption) eq 'ARRAY';
683 foreach my $taxname ( keys %$tax_exemption ) {
684 my $cust_main_exemption = new FS::cust_main_exemption {
685 'custnum' => $self->custnum,
686 'taxname' => $taxname,
687 'exempt_number' => $tax_exemption->{$taxname},
689 my $error = $cust_main_exemption->insert;
691 $dbh->rollback if $oldAutoCommit;
692 return "inserting cust_main_exemption (transaction rolled back): $error";
697 warn " ordering packages\n"
700 $error = $self->order_pkgs( $cust_pkgs,
702 'seconds_ref' => \$seconds,
703 'upbytes_ref' => \$upbytes,
704 'downbytes_ref' => \$downbytes,
705 'totalbytes_ref' => \$totalbytes,
708 $dbh->rollback if $oldAutoCommit;
713 $dbh->rollback if $oldAutoCommit;
714 return "No svc_acct record to apply pre-paid time";
716 if ( $upbytes || $downbytes || $totalbytes ) {
717 $dbh->rollback if $oldAutoCommit;
718 return "No svc_acct record to apply pre-paid data";
722 warn " inserting initial $payby payment of $amount\n"
724 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
726 $dbh->rollback if $oldAutoCommit;
727 return "inserting payment (transaction rolled back): $error";
731 unless ( $import || $skip_fuzzyfiles ) {
732 warn " queueing fuzzyfiles update\n"
734 $error = $self->queue_fuzzyfiles_update;
736 $dbh->rollback if $oldAutoCommit;
737 return "updating fuzzy search cache: $error";
741 # FS::geocode_Mixin::after_insert or something?
742 if ( $conf->config('tax_district_method') and !$import ) {
743 # if anything non-empty, try to look it up
744 my $queue = new FS::queue {
745 'job' => 'FS::geocode_Mixin::process_district_update',
746 'custnum' => $self->custnum,
748 my $error = $queue->insert( ref($self), $self->custnum );
750 $dbh->rollback if $oldAutoCommit;
751 return "queueing tax district update: $error";
756 warn " exporting\n" if $DEBUG > 1;
758 my $export_args = $options{'export_args'} || [];
761 map qsearch( 'part_export', {exportnum=>$_} ),
762 $conf->config('cust_main-exports'); #, $agentnum
764 foreach my $part_export ( @part_export ) {
765 my $error = $part_export->export_insert($self, @$export_args);
767 $dbh->rollback if $oldAutoCommit;
768 return "exporting to ". $part_export->exporttype.
769 " (transaction rolled back): $error";
773 #foreach my $depend_jobnum ( @$depend_jobnums ) {
774 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
776 # foreach my $jobnum ( @jobnums ) {
777 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
778 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
780 # my $error = $queue->depend_insert($depend_jobnum);
782 # $dbh->rollback if $oldAutoCommit;
783 # return "error queuing job dependancy: $error";
790 #if ( exists $options{'jobnums'} ) {
791 # push @{ $options{'jobnums'} }, @jobnums;
794 warn " insert complete; committing transaction\n"
797 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
802 use File::CounterFile;
803 sub auto_agent_custid {
806 my $format = $conf->config('cust_main-auto_agent_custid');
808 if ( $format eq '1YMMXXXXXXXX' ) {
810 my $counter = new File::CounterFile 'cust_main.agent_custid';
813 my $ym = 100000000000 + time2str('%y%m00000000', time);
814 if ( $ym > $counter->value ) {
815 $counter->{'value'} = $agent_custid = $ym;
816 $counter->{'updated'} = 1;
818 $agent_custid = $counter->inc;
824 die "Unknown cust_main-auto_agent_custid format: $format";
827 $self->agent_custid($agent_custid);
831 =item PACKAGE METHODS
833 Documentation on customer package methods has been moved to
834 L<FS::cust_main::Packages>.
836 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
838 Recharges this (existing) customer with the specified prepaid card (see
839 L<FS::prepay_credit>), specified either by I<identifier> or as an
840 FS::prepay_credit object. If there is an error, returns the error, otherwise
843 Optionally, five scalar references can be passed as well. They will have their
844 values filled in with the amount, number of seconds, and number of upload,
845 download, and total bytes applied by this prepaid card.
849 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
850 #the only place that uses these args
851 sub recharge_prepay {
852 my( $self, $prepay_credit, $amountref, $secondsref,
853 $upbytesref, $downbytesref, $totalbytesref ) = @_;
855 local $SIG{HUP} = 'IGNORE';
856 local $SIG{INT} = 'IGNORE';
857 local $SIG{QUIT} = 'IGNORE';
858 local $SIG{TERM} = 'IGNORE';
859 local $SIG{TSTP} = 'IGNORE';
860 local $SIG{PIPE} = 'IGNORE';
862 my $oldAutoCommit = $FS::UID::AutoCommit;
863 local $FS::UID::AutoCommit = 0;
866 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
868 my $error = $self->get_prepay( $prepay_credit,
869 'amount_ref' => \$amount,
870 'seconds_ref' => \$seconds,
871 'upbytes_ref' => \$upbytes,
872 'downbytes_ref' => \$downbytes,
873 'totalbytes_ref' => \$totalbytes,
875 || $self->increment_seconds($seconds)
876 || $self->increment_upbytes($upbytes)
877 || $self->increment_downbytes($downbytes)
878 || $self->increment_totalbytes($totalbytes)
879 || $self->insert_cust_pay_prepay( $amount,
881 ? $prepay_credit->identifier
886 $dbh->rollback if $oldAutoCommit;
890 if ( defined($amountref) ) { $$amountref = $amount; }
891 if ( defined($secondsref) ) { $$secondsref = $seconds; }
892 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
893 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
894 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
896 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
901 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
903 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
904 specified either by I<identifier> or as an FS::prepay_credit object.
906 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
907 incremented by the values of the prepaid card.
909 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
910 check or set this customer's I<agentnum>.
912 If there is an error, returns the error, otherwise returns false.
918 my( $self, $prepay_credit, %opt ) = @_;
920 local $SIG{HUP} = 'IGNORE';
921 local $SIG{INT} = 'IGNORE';
922 local $SIG{QUIT} = 'IGNORE';
923 local $SIG{TERM} = 'IGNORE';
924 local $SIG{TSTP} = 'IGNORE';
925 local $SIG{PIPE} = 'IGNORE';
927 my $oldAutoCommit = $FS::UID::AutoCommit;
928 local $FS::UID::AutoCommit = 0;
931 unless ( ref($prepay_credit) ) {
933 my $identifier = $prepay_credit;
935 $prepay_credit = qsearchs(
937 { 'identifier' => $identifier },
942 unless ( $prepay_credit ) {
943 $dbh->rollback if $oldAutoCommit;
944 return "Invalid prepaid card: ". $identifier;
949 if ( $prepay_credit->agentnum ) {
950 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
951 $dbh->rollback if $oldAutoCommit;
952 return "prepaid card not valid for agent ". $self->agentnum;
954 $self->agentnum($prepay_credit->agentnum);
957 my $error = $prepay_credit->delete;
959 $dbh->rollback if $oldAutoCommit;
960 return "removing prepay_credit (transaction rolled back): $error";
963 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
964 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
966 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
971 =item increment_upbytes SECONDS
973 Updates this customer's single or primary account (see L<FS::svc_acct>) by
974 the specified number of upbytes. If there is an error, returns the error,
975 otherwise returns false.
979 sub increment_upbytes {
980 _increment_column( shift, 'upbytes', @_);
983 =item increment_downbytes SECONDS
985 Updates this customer's single or primary account (see L<FS::svc_acct>) by
986 the specified number of downbytes. If there is an error, returns the error,
987 otherwise returns false.
991 sub increment_downbytes {
992 _increment_column( shift, 'downbytes', @_);
995 =item increment_totalbytes SECONDS
997 Updates this customer's single or primary account (see L<FS::svc_acct>) by
998 the specified number of totalbytes. If there is an error, returns the error,
999 otherwise returns false.
1003 sub increment_totalbytes {
1004 _increment_column( shift, 'totalbytes', @_);
1007 =item increment_seconds SECONDS
1009 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1010 the specified number of seconds. If there is an error, returns the error,
1011 otherwise returns false.
1015 sub increment_seconds {
1016 _increment_column( shift, 'seconds', @_);
1019 =item _increment_column AMOUNT
1021 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1022 the specified number of seconds or bytes. If there is an error, returns
1023 the error, otherwise returns false.
1027 sub _increment_column {
1028 my( $self, $column, $amount ) = @_;
1029 warn "$me increment_column called: $column, $amount\n"
1032 return '' unless $amount;
1034 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1035 $self->ncancelled_pkgs;
1037 if ( ! @cust_pkg ) {
1038 return 'No packages with primary or single services found'.
1039 ' to apply pre-paid time';
1040 } elsif ( scalar(@cust_pkg) > 1 ) {
1041 #maybe have a way to specify the package/account?
1042 return 'Multiple packages found to apply pre-paid time';
1045 my $cust_pkg = $cust_pkg[0];
1046 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1050 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1052 if ( ! @cust_svc ) {
1053 return 'No account found to apply pre-paid time';
1054 } elsif ( scalar(@cust_svc) > 1 ) {
1055 return 'Multiple accounts found to apply pre-paid time';
1058 my $svc_acct = $cust_svc[0]->svc_x;
1059 warn " found service svcnum ". $svc_acct->pkgnum.
1060 ' ('. $svc_acct->email. ")\n"
1063 $column = "increment_$column";
1064 $svc_acct->$column($amount);
1068 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1070 Inserts a prepayment in the specified amount for this customer. An optional
1071 second argument can specify the prepayment identifier for tracking purposes.
1072 If there is an error, returns the error, otherwise returns false.
1076 sub insert_cust_pay_prepay {
1077 shift->insert_cust_pay('PREP', @_);
1080 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1082 Inserts a cash payment in the specified amount for this customer. An optional
1083 second argument can specify the payment identifier for tracking purposes.
1084 If there is an error, returns the error, otherwise returns false.
1088 sub insert_cust_pay_cash {
1089 shift->insert_cust_pay('CASH', @_);
1092 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1094 Inserts a Western Union payment in the specified amount for this customer. An
1095 optional second argument can specify the prepayment identifier for tracking
1096 purposes. If there is an error, returns the error, otherwise returns false.
1100 sub insert_cust_pay_west {
1101 shift->insert_cust_pay('WEST', @_);
1104 sub insert_cust_pay {
1105 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1106 my $payinfo = scalar(@_) ? shift : '';
1108 my $cust_pay = new FS::cust_pay {
1109 'custnum' => $self->custnum,
1110 'paid' => sprintf('%.2f', $amount),
1111 #'_date' => #date the prepaid card was purchased???
1113 'payinfo' => $payinfo,
1119 =item delete [ OPTION => VALUE ... ]
1121 This deletes the customer. If there is an error, returns the error, otherwise
1124 This will completely remove all traces of the customer record. This is not
1125 what you want when a customer cancels service; for that, cancel all of the
1126 customer's packages (see L</cancel>).
1128 If the customer has any uncancelled packages, you need to pass a new (valid)
1129 customer number for those packages to be transferred to, as the "new_customer"
1130 option. Cancelled packages will be deleted. Did I mention that this is NOT
1131 what you want when a customer cancels service and that you really should be
1132 looking at L<FS::cust_pkg/cancel>?
1134 You can't delete a customer with invoices (see L<FS::cust_bill>),
1135 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1136 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1137 set the "delete_financials" option to a true value.
1142 my( $self, %opt ) = @_;
1144 local $SIG{HUP} = 'IGNORE';
1145 local $SIG{INT} = 'IGNORE';
1146 local $SIG{QUIT} = 'IGNORE';
1147 local $SIG{TERM} = 'IGNORE';
1148 local $SIG{TSTP} = 'IGNORE';
1149 local $SIG{PIPE} = 'IGNORE';
1151 my $oldAutoCommit = $FS::UID::AutoCommit;
1152 local $FS::UID::AutoCommit = 0;
1155 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1156 $dbh->rollback if $oldAutoCommit;
1157 return "Can't delete a master agent customer";
1160 #use FS::access_user
1161 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1162 $dbh->rollback if $oldAutoCommit;
1163 return "Can't delete a master employee customer";
1166 tie my %financial_tables, 'Tie::IxHash',
1167 'cust_bill' => 'invoices',
1168 'cust_statement' => 'statements',
1169 'cust_credit' => 'credits',
1170 'cust_pay' => 'payments',
1171 'cust_refund' => 'refunds',
1174 foreach my $table ( keys %financial_tables ) {
1176 my @records = $self->$table();
1178 if ( @records && ! $opt{'delete_financials'} ) {
1179 $dbh->rollback if $oldAutoCommit;
1180 return "Can't delete a customer with ". $financial_tables{$table};
1183 foreach my $record ( @records ) {
1184 my $error = $record->delete;
1186 $dbh->rollback if $oldAutoCommit;
1187 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1193 my @cust_pkg = $self->ncancelled_pkgs;
1195 my $new_custnum = $opt{'new_custnum'};
1196 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1197 $dbh->rollback if $oldAutoCommit;
1198 return "Invalid new customer number: $new_custnum";
1200 foreach my $cust_pkg ( @cust_pkg ) {
1201 my %hash = $cust_pkg->hash;
1202 $hash{'custnum'} = $new_custnum;
1203 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1204 my $error = $new_cust_pkg->replace($cust_pkg,
1205 options => { $cust_pkg->options },
1208 $dbh->rollback if $oldAutoCommit;
1213 my @cancelled_cust_pkg = $self->all_pkgs;
1214 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1215 my $error = $cust_pkg->delete;
1217 $dbh->rollback if $oldAutoCommit;
1222 #cust_tax_adjustment in financials?
1223 #cust_pay_pending? ouch
1224 foreach my $table (qw(
1225 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1226 cust_payby cust_location cust_main_note cust_tax_adjustment
1227 cust_pay_void cust_pay_batch queue cust_tax_exempt
1229 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1230 my $error = $record->delete;
1232 $dbh->rollback if $oldAutoCommit;
1238 my $sth = $dbh->prepare(
1239 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1241 my $errstr = $dbh->errstr;
1242 $dbh->rollback if $oldAutoCommit;
1245 $sth->execute($self->custnum) or do {
1246 my $errstr = $sth->errstr;
1247 $dbh->rollback if $oldAutoCommit;
1253 my $ticket_dbh = '';
1254 if ($conf->config('ticket_system') eq 'RT_Internal') {
1256 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1257 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1258 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1259 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1262 if ( $ticket_dbh ) {
1264 my $ticket_sth = $ticket_dbh->prepare(
1265 'DELETE FROM Links WHERE Target = ?'
1267 my $errstr = $ticket_dbh->errstr;
1268 $dbh->rollback if $oldAutoCommit;
1271 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1273 my $errstr = $ticket_sth->errstr;
1274 $dbh->rollback if $oldAutoCommit;
1278 #check and see if the customer is the only link on the ticket, and
1279 #if so, set the ticket to deleted status in RT?
1280 #maybe someday, for now this will at least fix tickets not displaying
1284 #delete the customer record
1286 my $error = $self->SUPER::delete;
1288 $dbh->rollback if $oldAutoCommit;
1292 # cust_main exports!
1294 #my $export_args = $options{'export_args'} || [];
1297 map qsearch( 'part_export', {exportnum=>$_} ),
1298 $conf->config('cust_main-exports'); #, $agentnum
1300 foreach my $part_export ( @part_export ) {
1301 my $error = $part_export->export_delete( $self ); #, @$export_args);
1303 $dbh->rollback if $oldAutoCommit;
1304 return "exporting to ". $part_export->exporttype.
1305 " (transaction rolled back): $error";
1309 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1314 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1316 Replaces the OLD_RECORD with this one in the database. If there is an error,
1317 returns the error, otherwise returns false.
1319 To change the customer's address, set the pseudo-fields C<bill_location> and
1320 C<ship_location>. The address will still only change if at least one of the
1321 address fields differs from the existing values.
1323 INVOICING_LIST_ARYREF: If you pass an arrayref to this method, it will be
1324 set as the contact email address for a default contact with the same name as
1327 Currently available options are: I<tax_exemption>, I<cust_payby_params>,
1328 I<contact_params>, I<invoicing_list>, and I<move_pkgs>.
1330 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1331 of tax names and exemption numbers. FS::cust_main_exemption records will be
1332 deleted and inserted as appropriate.
1334 I<cust_payby_params> and I<contact_params> can be hashrefs of named parameter
1335 groups (describing the customer's payment methods and contacts, respectively)
1336 in the style supported by L<FS::o2m_Common/process_o2m>. See L<FS::cust_payby>
1337 and L<FS::contact> for the fields these can contain.
1339 I<invoicing_list> is a synonym for the INVOICING_LIST_ARYREF parameter, and
1340 should be used instead if possible.
1342 If I<move_pkgs> is an arrayref, it will override the list of packages
1343 to be moved to the new address (see L<FS::cust_location/move_pkgs>.)
1350 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1352 : $self->replace_old;
1356 warn "$me replace called\n"
1359 my $curuser = $FS::CurrentUser::CurrentUser;
1360 return "You are not permitted to create complimentary accounts."
1361 if $self->complimentary eq 'Y'
1362 && $self->complimentary ne $old->complimentary
1363 && ! $curuser->access_right('Complimentary customer');
1365 local($ignore_expired_card) = 1
1366 if $old->payby =~ /^(CARD|DCRD)$/
1367 && $self->payby =~ /^(CARD|DCRD)$/
1368 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1370 local($ignore_banned_card) = 1
1371 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1372 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1373 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1375 if ( $self->payby =~ /^(CARD|DCRD)$/
1376 && $old->payinfo ne $self->payinfo
1377 && $old->paymask ne $self->paymask )
1379 my $error = $self->check_payinfo_cardtype;
1380 return $error if $error;
1383 return "Invoicing locale is required"
1386 && $conf->exists('cust_main-require_locale');
1388 local $SIG{HUP} = 'IGNORE';
1389 local $SIG{INT} = 'IGNORE';
1390 local $SIG{QUIT} = 'IGNORE';
1391 local $SIG{TERM} = 'IGNORE';
1392 local $SIG{TSTP} = 'IGNORE';
1393 local $SIG{PIPE} = 'IGNORE';
1395 my $oldAutoCommit = $FS::UID::AutoCommit;
1396 local $FS::UID::AutoCommit = 0;
1399 for my $l (qw(bill_location ship_location)) {
1400 #my $old_loc = $old->$l;
1401 my $new_loc = $self->$l or next;
1403 # find the existing location if there is one
1404 $new_loc->set('custnum' => $self->custnum);
1405 my $error = $new_loc->find_or_insert;
1407 $dbh->rollback if $oldAutoCommit;
1410 $self->set($l.'num', $new_loc->locationnum);
1414 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1415 warn "cust_main::replace: using deprecated invoicing list argument";
1416 $invoicing_list = shift @param;
1419 my %options = @param;
1421 $invoicing_list ||= $options{invoicing_list};
1423 my @contacts = map { $_->contact } $self->cust_contact;
1424 # find a contact that matches the customer's name
1425 my ($implicit_contact) = grep { $_->first eq $old->get('first')
1426 and $_->last eq $old->get('last') }
1428 $implicit_contact ||= FS::contact->new({
1429 'custnum' => $self->custnum,
1430 'locationnum' => $self->get('bill_locationnum'),
1433 # for any of these that are already contact emails, link to the existing
1435 if ( $invoicing_list ) {
1438 # kind of like process_m2m on these, except:
1439 # - the other side is two tables in a join
1440 # - and we might have to create new contact_emails
1441 # - and possibly a new contact
1443 # Find existing invoice emails that aren't on the implicit contact.
1444 # Any of these that are not on the new invoicing list will be removed.
1445 my %old_email_cust_contact;
1446 foreach my $cust_contact ($self->cust_contact) {
1447 next if !$cust_contact->invoice_dest;
1448 next if $cust_contact->contactnum == ($implicit_contact->contactnum || 0);
1450 foreach my $contact_email ($cust_contact->contact->contact_email) {
1451 $old_email_cust_contact{ $contact_email->emailaddress } = $cust_contact;
1455 foreach my $dest (@$invoicing_list) {
1457 if ($dest eq 'POST') {
1459 $self->set('postal_invoice', 'Y');
1461 } elsif ( exists($old_email_cust_contact{$dest}) ) {
1463 delete $old_email_cust_contact{$dest}; # don't need to remove it, then
1467 # See if it belongs to some other contact; if so, link it.
1468 my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
1470 and $contact_email->contactnum != ($implicit_contact->contactnum || 0) ) {
1471 my $cust_contact = qsearchs('cust_contact', {
1472 contactnum => $contact_email->contactnum,
1473 custnum => $self->custnum,
1474 }) || FS::cust_contact->new({
1475 contactnum => $contact_email->contactnum,
1476 custnum => $self->custnum,
1478 $cust_contact->set('invoice_dest', 'Y');
1479 my $error = $cust_contact->custcontactnum ?
1480 $cust_contact->replace : $cust_contact->insert;
1482 $dbh->rollback if $oldAutoCommit;
1483 return "$error (linking to email address $dest)";
1487 # This email address is not yet linked to any contact, so it will
1488 # be added to the implicit contact.
1489 $email .= ',' if length($email);
1495 foreach my $remove_dest (keys %old_email_cust_contact) {
1496 my $cust_contact = $old_email_cust_contact{$remove_dest};
1497 # These were not in the list of requested destinations, so take them off.
1498 $cust_contact->set('invoice_dest', '');
1499 my $error = $cust_contact->replace;
1501 $dbh->rollback if $oldAutoCommit;
1502 return "$error (unlinking email address $remove_dest)";
1506 # make sure it keeps up with the changed customer name, if any
1507 $implicit_contact->set('last', $self->get('last'));
1508 $implicit_contact->set('first', $self->get('first'));
1509 $implicit_contact->set('emailaddress', $email);
1510 $implicit_contact->set('invoice_dest', 'Y');
1511 $implicit_contact->set('custnum', $self->custnum);
1512 my $i_cust_contact =
1513 qsearchs('cust_contact', {
1514 contactnum => $implicit_contact->contactnum,
1515 custnum => $self->custnum,
1518 $implicit_contact->set($_, $i_cust_contact->$_)
1519 foreach qw( classnum selfservice_access comment );
1522 if ( $implicit_contact->contactnum ) {
1523 $error = $implicit_contact->replace;
1524 } elsif ( length($email) ) { # don't create a new contact if not needed
1525 $error = $implicit_contact->insert;
1529 $dbh->rollback if $oldAutoCommit;
1530 return "$error (adding email address $email)";
1535 # replace the customer record
1536 my $error = $self->SUPER::replace($old);
1539 $dbh->rollback if $oldAutoCommit;
1543 # now move packages to the new service location
1544 $self->set('ship_location', ''); #flush cache
1545 if ( $old->ship_locationnum and # should only be null during upgrade...
1546 $old->ship_locationnum != $self->ship_locationnum ) {
1547 $error = $old->ship_location->move_to($self->ship_location, move_pkgs => $options{'move_pkgs'});
1549 $dbh->rollback if $oldAutoCommit;
1553 # don't move packages based on the billing location, but
1554 # disable it if it's no longer in use
1555 if ( $old->bill_locationnum and
1556 $old->bill_locationnum != $self->bill_locationnum ) {
1557 $error = $old->bill_location->disable_if_unused;
1559 $dbh->rollback if $oldAutoCommit;
1564 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1566 #this could be more efficient than deleting and re-inserting, if it matters
1567 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1568 my $error = $cust_tag->delete;
1570 $dbh->rollback if $oldAutoCommit;
1574 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1575 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1576 'custnum' => $self->custnum };
1577 my $error = $cust_tag->insert;
1579 $dbh->rollback if $oldAutoCommit;
1586 my $tax_exemption = delete $options{'tax_exemption'};
1587 if ( $tax_exemption ) {
1589 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1590 if ref($tax_exemption) eq 'ARRAY';
1592 my %cust_main_exemption =
1593 map { $_->taxname => $_ }
1594 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1596 foreach my $taxname ( keys %$tax_exemption ) {
1598 if ( $cust_main_exemption{$taxname} &&
1599 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1602 delete $cust_main_exemption{$taxname};
1606 my $cust_main_exemption = new FS::cust_main_exemption {
1607 'custnum' => $self->custnum,
1608 'taxname' => $taxname,
1609 'exempt_number' => $tax_exemption->{$taxname},
1611 my $error = $cust_main_exemption->insert;
1613 $dbh->rollback if $oldAutoCommit;
1614 return "inserting cust_main_exemption (transaction rolled back): $error";
1618 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1619 my $error = $cust_main_exemption->delete;
1621 $dbh->rollback if $oldAutoCommit;
1622 return "deleting cust_main_exemption (transaction rolled back): $error";
1628 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1630 my $error = $self->process_o2m(
1631 'table' => 'cust_payby',
1632 'fields' => FS::cust_payby->cgi_cust_payby_fields,
1633 'params' => $cust_payby_params,
1634 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1637 $dbh->rollback if $oldAutoCommit;
1643 if ( my $contact_params = delete $options{'contact_params'} ) {
1645 # this can potentially replace contacts that were created by the
1646 # invoicing list argument, but the UI shouldn't allow both of them
1649 my $error = $self->process_o2m(
1650 'table' => 'contact',
1651 'fields' => FS::contact->cgi_contact_fields,
1652 'params' => $contact_params,
1655 $dbh->rollback if $oldAutoCommit;
1661 unless ( $import || $skip_fuzzyfiles ) {
1662 $error = $self->queue_fuzzyfiles_update;
1664 $dbh->rollback if $oldAutoCommit;
1665 return "updating fuzzy search cache: $error";
1669 # tax district update in cust_location
1671 # cust_main exports!
1673 my $export_args = $options{'export_args'} || [];
1676 map qsearch( 'part_export', {exportnum=>$_} ),
1677 $conf->config('cust_main-exports'); #, $agentnum
1679 foreach my $part_export ( @part_export ) {
1680 my $error = $part_export->export_replace( $self, $old, @$export_args);
1682 $dbh->rollback if $oldAutoCommit;
1683 return "exporting to ". $part_export->exporttype.
1684 " (transaction rolled back): $error";
1688 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1693 =item queue_fuzzyfiles_update
1695 Used by insert & replace to update the fuzzy search cache
1699 use FS::cust_main::Search;
1700 sub queue_fuzzyfiles_update {
1703 local $SIG{HUP} = 'IGNORE';
1704 local $SIG{INT} = 'IGNORE';
1705 local $SIG{QUIT} = 'IGNORE';
1706 local $SIG{TERM} = 'IGNORE';
1707 local $SIG{TSTP} = 'IGNORE';
1708 local $SIG{PIPE} = 'IGNORE';
1710 my $oldAutoCommit = $FS::UID::AutoCommit;
1711 local $FS::UID::AutoCommit = 0;
1714 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1715 my $queue = new FS::queue {
1716 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1718 my @args = "cust_main.$field", $self->get($field);
1719 my $error = $queue->insert( @args );
1721 $dbh->rollback if $oldAutoCommit;
1722 return "queueing job (transaction rolled back): $error";
1727 push @locations, $self->bill_location if $self->bill_locationnum;
1728 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1729 foreach my $location (@locations) {
1730 my $queue = new FS::queue {
1731 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1733 my @args = 'cust_location.address1', $location->address1;
1734 my $error = $queue->insert( @args );
1736 $dbh->rollback if $oldAutoCommit;
1737 return "queueing job (transaction rolled back): $error";
1741 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1748 Checks all fields to make sure this is a valid customer record. If there is
1749 an error, returns the error, otherwise returns false. Called by the insert
1750 and replace methods.
1757 warn "$me check BEFORE: \n". $self->_dump
1761 $self->ut_numbern('custnum')
1762 || $self->ut_number('agentnum')
1763 || $self->ut_textn('agent_custid')
1764 || $self->ut_number('refnum')
1765 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1766 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1767 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1768 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1769 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1770 || $self->ut_textn('custbatch')
1771 || $self->ut_name('last')
1772 || $self->ut_name('first')
1773 || $self->ut_snumbern('signupdate')
1774 || $self->ut_snumbern('birthdate')
1775 || $self->ut_namen('spouse_last')
1776 || $self->ut_namen('spouse_first')
1777 || $self->ut_snumbern('spouse_birthdate')
1778 || $self->ut_snumbern('anniversary_date')
1779 || $self->ut_textn('company')
1780 || $self->ut_textn('ship_company')
1781 || $self->ut_anything('comments')
1782 || $self->ut_numbern('referral_custnum')
1783 || $self->ut_textn('stateid')
1784 || $self->ut_textn('stateid_state')
1785 || $self->ut_textn('invoice_terms')
1786 || $self->ut_floatn('cdr_termination_percentage')
1787 || $self->ut_floatn('credit_limit')
1788 || $self->ut_numbern('billday')
1789 || $self->ut_numbern('prorate_day')
1790 || $self->ut_flag('force_prorate_day')
1791 || $self->ut_flag('edit_subject')
1792 || $self->ut_flag('calling_list_exempt')
1793 || $self->ut_flag('invoice_noemail')
1794 || $self->ut_flag('message_noemail')
1795 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1796 || $self->ut_currencyn('currency')
1797 || $self->ut_textn('po_number')
1798 || $self->ut_enum('complimentary', [ '', 'Y' ])
1799 || $self->ut_flag('invoice_ship_address')
1800 || $self->ut_flag('invoice_dest')
1803 foreach (qw(company ship_company)) {
1804 my $company = $self->get($_);
1805 $company =~ s/^\s+//;
1806 $company =~ s/\s+$//;
1807 $company =~ s/\s+/ /g;
1808 $self->set($_, $company);
1811 #barf. need message catalogs. i18n. etc.
1812 $error .= "Please select an advertising source."
1813 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1814 return $error if $error;
1816 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1817 or return "Unknown agent";
1819 if ( $self->currency ) {
1820 my $agent_currency = qsearchs( 'agent_currency', {
1821 'agentnum' => $agent->agentnum,
1822 'currency' => $self->currency,
1824 or return "Agent ". $agent->agent.
1825 " not permitted to offer ". $self->currency. " invoicing";
1828 return "Unknown refnum"
1829 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1831 return "Unknown referring custnum: ". $self->referral_custnum
1832 unless ! $self->referral_custnum
1833 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1835 if ( $self->ss eq '' ) {
1840 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1841 or return "Illegal social security number: ". $self->ss;
1842 $self->ss("$1-$2-$3");
1845 #turn off invoice_ship_address if ship & bill are the same
1846 if ($self->bill_locationnum eq $self->ship_locationnum) {
1847 $self->invoice_ship_address('');
1850 # cust_main_county verification now handled by cust_location check
1853 $self->ut_phonen('daytime', $self->country)
1854 || $self->ut_phonen('night', $self->country)
1855 || $self->ut_phonen('fax', $self->country)
1856 || $self->ut_phonen('mobile', $self->country)
1858 return $error if $error;
1860 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1862 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1865 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1867 : FS::Msgcat::_gettext('daytime');
1868 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1870 : FS::Msgcat::_gettext('night');
1872 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1874 : FS::Msgcat::_gettext('mobile');
1876 return "$daytime_label, $night_label or $mobile_label is required"
1880 return "Please select an invoicing locale"
1883 && $conf->exists('cust_main-require_locale');
1885 return "Please select a customer class"
1886 if ! $self->classnum
1887 && $conf->exists('cust_main-require_classnum');
1889 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1890 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1894 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1896 warn "$me check AFTER: \n". $self->_dump
1899 $self->SUPER::check;
1902 sub check_payinfo_cardtype {
1905 return '' unless $self->payby =~ /^(CARD|DCRD)$/;
1907 my $payinfo = $self->payinfo;
1908 $payinfo =~ s/\D//g;
1910 return '' if $self->tokenized($payinfo); #token
1912 my %bop_card_types = map { $_=>1 } values %{ card_types() };
1913 my $cardtype = cardtype($payinfo);
1915 return "$cardtype not accepted" unless $bop_card_types{$cardtype};
1923 Additional checks for replace only.
1928 my ($new,$old) = @_;
1929 #preserve old value if global config is set
1930 if ($old && $conf->exists('invoice-ship_address')) {
1931 $new->invoice_ship_address($old->invoice_ship_address);
1938 Returns a list of fields which have ship_ duplicates.
1943 qw( last first company
1945 address1 address2 city county state zip country
1947 daytime night fax mobile
1951 =item has_ship_address
1953 Returns true if this customer record has a separate shipping address.
1957 sub has_ship_address {
1959 $self->bill_locationnum != $self->ship_locationnum;
1964 Returns a list of key/value pairs, with the following keys: address1,
1965 adddress2, city, county, state, zip, country, district, and geocode. The
1966 shipping address is used if present.
1972 $self->ship_location->location_hash;
1977 Returns all locations (see L<FS::cust_location>) for this customer.
1984 'table' => 'cust_location',
1985 'hashref' => { 'custnum' => $self->custnum,
1986 'prospectnum' => '',
1988 'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
1994 Returns all contact associations (see L<FS::cust_contact>) for this customer.
2000 qsearch('cust_contact', { 'custnum' => $self->custnum } );
2003 =item cust_payby PAYBY
2005 Returns all payment methods (see L<FS::cust_payby>) for this customer.
2007 If one or more PAYBY are specified, returns only payment methods for specified PAYBY.
2008 Does not validate PAYBY.
2016 'table' => 'cust_payby',
2017 'hashref' => { 'custnum' => $self->custnum },
2018 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
2020 $search->{'extra_sql'} = ' AND payby IN ( '.
2021 join(',', map dbh->quote($_), @payby).
2028 =item has_cust_payby_auto
2030 Returns true if customer has an automatic payment method ('CARD' or 'CHEK')
2034 sub has_cust_payby_auto {
2037 'table' => 'cust_payby',
2038 'hashref' => { 'custnum' => $self->custnum, },
2039 'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ",
2040 'order_by' => 'LIMIT 1',
2047 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2048 and L<FS::cust_pkg>) for this customer, except those on hold.
2050 Returns a list: an empty list on success or a list of errors.
2056 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2061 Unsuspends all suspended packages in the on-hold state (those without setup
2062 dates) for this customer.
2068 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2073 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2075 Returns a list: an empty list on success or a list of errors.
2081 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2084 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2086 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2087 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2088 of a list of pkgparts; the hashref has the following keys:
2092 =item pkgparts - listref of pkgparts
2094 =item (other options are passed to the suspend method)
2099 Returns a list: an empty list on success or a list of errors.
2103 sub suspend_if_pkgpart {
2105 my (@pkgparts, %opt);
2106 if (ref($_[0]) eq 'HASH'){
2107 @pkgparts = @{$_[0]{pkgparts}};
2112 grep { $_->suspend(%opt) }
2113 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2114 $self->unsuspended_pkgs;
2117 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2119 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2120 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2121 instead of a list of pkgparts; the hashref has the following keys:
2125 =item pkgparts - listref of pkgparts
2127 =item (other options are passed to the suspend method)
2131 Returns a list: an empty list on success or a list of errors.
2135 sub suspend_unless_pkgpart {
2137 my (@pkgparts, %opt);
2138 if (ref($_[0]) eq 'HASH'){
2139 @pkgparts = @{$_[0]{pkgparts}};
2144 grep { $_->suspend(%opt) }
2145 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2146 $self->unsuspended_pkgs;
2149 =item cancel [ OPTION => VALUE ... ]
2151 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2152 The cancellation time will be now.
2156 Always returns a list: an empty list on success or a list of errors.
2163 warn "$me cancel called on customer ". $self->custnum. " with options ".
2164 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2166 my @pkgs = $self->ncancelled_pkgs;
2168 $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
2171 =item cancel_pkgs OPTIONS
2173 Cancels a specified list of packages. OPTIONS can include:
2177 =item cust_pkg - an arrayref of the packages. Required.
2179 =item time - the cancellation time, used to calculate final bills and
2180 unused-time credits if any. Will be passed through to the bill() and
2181 FS::cust_pkg::cancel() methods.
2183 =item quiet - can be set true to supress email cancellation notices.
2185 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a
2186 reasonnum of an existing reason, or passing a hashref will create a new reason.
2187 The hashref should have the following keys:
2188 typenum - Reason type (see L<FS::reason_type>)
2189 reason - Text of the new reason.
2191 =item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
2192 for the individual packages, parallel to the C<cust_pkg> argument. The
2193 reason and reason_otaker arguments will be taken from those objects.
2195 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2197 =item nobill - can be set true to skip billing if it might otherwise be done.
2202 my( $self, %opt ) = @_;
2204 # we're going to cancel services, which is not reversible
2205 die "cancel_pkgs cannot be run inside a transaction"
2206 if $FS::UID::AutoCommit == 0;
2208 local $FS::UID::AutoCommit = 0;
2210 return ( 'access denied' )
2211 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2213 if ( $opt{'ban'} ) {
2215 foreach my $cust_payby ( $self->cust_payby ) {
2217 #well, if they didn't get decrypted on search, then we don't have to
2218 # try again... queue a job for the server that does have decryption
2219 # capability if we're in a paranoid multi-server implementation?
2220 return ( "Can't (yet) ban encrypted credit cards" )
2221 if $cust_payby->is_encrypted($cust_payby->payinfo);
2223 my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2224 my $error = $ban->insert;
2234 my @pkgs = @{ delete $opt{'cust_pkg'} };
2235 my $cancel_time = $opt{'time'} || time;
2237 # bill all packages first, so we don't lose usage, service counts for
2238 # bulk billing, etc.
2239 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2241 my $error = $self->bill( 'pkg_list' => [ @pkgs ],
2243 'time' => $cancel_time );
2245 warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
2247 return ( "Error billing during cancellation: $error" );
2253 # try to cancel each service, the same way we would for individual packages,
2254 # but in cancel weight order.
2255 my @cust_svc = map { $_->cust_svc } @pkgs;
2256 my @sorted_cust_svc =
2258 sort { $a->[1] <=> $b->[1] }
2259 map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc
2261 warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
2264 foreach my $cust_svc (@sorted_cust_svc) {
2265 my $part_svc = $cust_svc->part_svc;
2266 next if ( defined($part_svc) and $part_svc->preserve );
2267 # immediate cancel, no date option
2268 # transactionize individually
2269 my $error = try { $cust_svc->cancel } catch { $_ };
2272 push @errors, $error;
2281 warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
2282 $self->custnum. "\n"
2286 if ($opt{'cust_pkg_reason'}) {
2287 @cprs = @{ delete $opt{'cust_pkg_reason'} };
2293 my $cpr = shift @cprs;
2295 $lopt{'reason'} = $cpr->reasonnum;
2296 $lopt{'reason_otaker'} = $cpr->otaker;
2298 warn "no reason found when canceling package ".$_->pkgnum."\n";
2299 # we're not actually required to pass a reason to cust_pkg::cancel,
2300 # but if we're getting to this point, something has gone awry.
2301 $null_reason ||= FS::reason->new_or_existing(
2302 reason => 'unknown reason',
2303 type => 'Cancel Reason',
2306 $lopt{'reason'} = $null_reason->reasonnum;
2307 $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username;
2310 my $error = $_->cancel(%lopt);
2313 push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
2322 sub _banned_pay_hashref {
2323 die 'cust_main->_banned_pay_hashref deprecated';
2335 'payby' => $payby2ban{$self->payby},
2336 'payinfo' => $self->payinfo,
2337 #don't ever *search* on reason! #'reason' =>
2343 Returns all notes (see L<FS::cust_main_note>) for this customer.
2348 my($self,$orderby_classnum) = (shift,shift);
2349 my $orderby = "sticky DESC, _date DESC";
2350 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2351 qsearch( 'cust_main_note',
2352 { 'custnum' => $self->custnum },
2354 "ORDER BY $orderby",
2360 Returns the agent (see L<FS::agent>) for this customer.
2364 Returns the agent name (see L<FS::agent>) for this customer.
2370 $self->agent->agent;
2375 Returns any tags associated with this customer, as FS::cust_tag objects,
2376 or an empty list if there are no tags.
2380 Returns any tags associated with this customer, as FS::part_tag objects,
2381 or an empty list if there are no tags.
2387 map $_->part_tag, $self->cust_tag;
2393 Returns the customer class, as an FS::cust_class object, or the empty string
2394 if there is no customer class.
2398 Returns the customer category name, or the empty string if there is no customer
2405 my $cust_class = $self->cust_class;
2407 ? $cust_class->categoryname
2413 Returns the customer class name, or the empty string if there is no customer
2420 my $cust_class = $self->cust_class;
2422 ? $cust_class->classname
2428 Returns the external tax status, as an FS::tax_status object, or the empty
2429 string if there is no tax status.
2435 if ( $self->taxstatusnum ) {
2436 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2444 Returns the tax status code if there is one.
2450 my $tax_status = $self->tax_status;
2452 ? $tax_status->taxstatus
2456 =item BILLING METHODS
2458 Documentation on billing methods has been moved to
2459 L<FS::cust_main::Billing>.
2461 =item REALTIME BILLING METHODS
2463 Documentation on realtime billing methods has been moved to
2464 L<FS::cust_main::Billing_Realtime>.
2468 Removes the I<paycvv> field from the database directly.
2470 If there is an error, returns the error, otherwise returns false.
2472 DEPRECATED. Use L</remove_cvv_from_cust_payby> instead.
2477 die 'cust_main->remove_cvv deprecated';
2479 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2480 or return dbh->errstr;
2481 $sth->execute($self->custnum)
2482 or return $sth->errstr;
2489 Returns the total owed for this customer on all invoices
2490 (see L<FS::cust_bill/owed>).
2496 $self->total_owed_date(2145859200); #12/31/2037
2499 =item total_owed_date TIME
2501 Returns the total owed for this customer on all invoices with date earlier than
2502 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2503 see L<Time::Local> and L<Date::Parse> for conversion functions.
2507 sub total_owed_date {
2511 my $custnum = $self->custnum;
2513 my $owed_sql = FS::cust_bill->owed_sql;
2516 SELECT SUM($owed_sql) FROM cust_bill
2517 WHERE custnum = $custnum
2521 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2525 =item total_owed_pkgnum PKGNUM
2527 Returns the total owed on all invoices for this customer's specific package
2528 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2532 sub total_owed_pkgnum {
2533 my( $self, $pkgnum ) = @_;
2534 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2537 =item total_owed_date_pkgnum TIME PKGNUM
2539 Returns the total owed for this customer's specific package when using
2540 experimental package balances on all invoices with date earlier than
2541 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2542 see L<Time::Local> and L<Date::Parse> for conversion functions.
2546 sub total_owed_date_pkgnum {
2547 my( $self, $time, $pkgnum ) = @_;
2550 foreach my $cust_bill (
2551 grep { $_->_date <= $time }
2552 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2554 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2556 sprintf( "%.2f", $total_bill );
2562 Returns the total amount of all payments.
2569 $total += $_->paid foreach $self->cust_pay;
2570 sprintf( "%.2f", $total );
2573 =item total_unapplied_credits
2575 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2576 customer. See L<FS::cust_credit/credited>.
2578 =item total_credited
2580 Old name for total_unapplied_credits. Don't use.
2584 sub total_credited {
2585 #carp "total_credited deprecated, use total_unapplied_credits";
2586 shift->total_unapplied_credits(@_);
2589 sub total_unapplied_credits {
2592 my $custnum = $self->custnum;
2594 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2597 SELECT SUM($unapplied_sql) FROM cust_credit
2598 WHERE custnum = $custnum
2601 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2605 =item total_unapplied_credits_pkgnum PKGNUM
2607 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2608 customer. See L<FS::cust_credit/credited>.
2612 sub total_unapplied_credits_pkgnum {
2613 my( $self, $pkgnum ) = @_;
2614 my $total_credit = 0;
2615 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2616 sprintf( "%.2f", $total_credit );
2620 =item total_unapplied_payments
2622 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2623 See L<FS::cust_pay/unapplied>.
2627 sub total_unapplied_payments {
2630 my $custnum = $self->custnum;
2632 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2635 SELECT SUM($unapplied_sql) FROM cust_pay
2636 WHERE custnum = $custnum
2639 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2643 =item total_unapplied_payments_pkgnum PKGNUM
2645 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2646 specific package when using experimental package balances. See
2647 L<FS::cust_pay/unapplied>.
2651 sub total_unapplied_payments_pkgnum {
2652 my( $self, $pkgnum ) = @_;
2653 my $total_unapplied = 0;
2654 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2655 sprintf( "%.2f", $total_unapplied );
2659 =item total_unapplied_refunds
2661 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2662 customer. See L<FS::cust_refund/unapplied>.
2666 sub total_unapplied_refunds {
2668 my $custnum = $self->custnum;
2670 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2673 SELECT SUM($unapplied_sql) FROM cust_refund
2674 WHERE custnum = $custnum
2677 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2683 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2684 total_unapplied_credits minus total_unapplied_payments).
2690 $self->balance_date_range;
2693 =item balance_date TIME
2695 Returns the balance for this customer, only considering invoices with date
2696 earlier than TIME (total_owed_date minus total_credited minus
2697 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2698 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2705 $self->balance_date_range(shift);
2708 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2710 Returns the balance for this customer, optionally considering invoices with
2711 date earlier than START_TIME, and not later than END_TIME
2712 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2714 Times are specified as SQL fragments or numeric
2715 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2716 L<Date::Parse> for conversion functions. The empty string can be passed
2717 to disable that time constraint completely.
2719 Accepts the same options as L<balance_date_sql>:
2723 =item unapplied_date
2725 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)
2729 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2730 time will be ignored. Note that START_TIME and END_TIME only limit the date
2731 range for invoices and I<unapplied> payments, credits, and refunds.
2737 sub balance_date_range {
2739 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2740 ') FROM cust_main WHERE custnum='. $self->custnum;
2741 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2744 =item balance_pkgnum PKGNUM
2746 Returns the balance for this customer's specific package when using
2747 experimental package balances (total_owed plus total_unrefunded, minus
2748 total_unapplied_credits minus total_unapplied_payments)
2752 sub balance_pkgnum {
2753 my( $self, $pkgnum ) = @_;
2756 $self->total_owed_pkgnum($pkgnum)
2757 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2758 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2759 - $self->total_unapplied_credits_pkgnum($pkgnum)
2760 - $self->total_unapplied_payments_pkgnum($pkgnum)
2766 Returns a hash of useful information for making a payment.
2776 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2777 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2778 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2782 For credit card transactions:
2794 For electronic check transactions:
2804 #XXX i need to be updated for 4.x+
2810 $return{balance} = $self->balance;
2812 $return{payname} = $self->payname
2813 || ( $self->first. ' '. $self->get('last') );
2815 $return{$_} = $self->bill_location->$_
2816 for qw(address1 address2 city state zip);
2818 $return{payby} = $self->payby;
2819 $return{stateid_state} = $self->stateid_state;
2821 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2822 $return{card_type} = cardtype($self->payinfo);
2823 $return{payinfo} = $self->paymask;
2825 @return{'month', 'year'} = $self->paydate_monthyear;
2829 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2830 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2831 $return{payinfo1} = $payinfo1;
2832 $return{payinfo2} = $payinfo2;
2833 $return{paytype} = $self->paytype;
2834 $return{paystate} = $self->paystate;
2838 #doubleclick protection
2840 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2848 Returns the next payment expiration date for this customer. If they have no
2849 payment methods that will expire, returns 0.
2855 # filter out the ones that individually return 0, but then return 0 if
2856 # there are no results
2857 my @epochs = grep { $_ > 0 } map { $_->paydate_epoch } $self->cust_payby;
2858 min( @epochs ) || 0;
2861 =item paydate_epoch_sql
2863 Returns an SQL expression to get the next payment expiration date for a
2864 customer. Returns 2143260000 (2037-12-01) if there are no payment expiration
2865 dates, so that it's safe to test for "will it expire before date X" for any
2870 sub paydate_epoch_sql {
2872 my $paydate = FS::cust_payby->paydate_epoch_sql;
2873 "(SELECT COALESCE(MIN($paydate), 2143260000) FROM cust_payby WHERE cust_payby.custnum = cust_main.custnum)";
2877 my( $self, $taxname ) = @_;
2879 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2880 'taxname' => $taxname,
2885 =item cust_main_exemption
2887 =item invoicing_list
2889 Returns a list of email addresses (with svcnum entries expanded), and the word
2890 'POST' if the customer receives postal invoices.
2894 sub invoicing_list {
2895 my( $self, $arrayref ) = @_;
2898 warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
2901 my @emails = $self->invoicing_list_emailonly;
2902 push @emails, 'POST' if $self->get('postal_invoice');
2907 =item check_invoicing_list ARRAYREF
2909 Checks these arguements as valid input for the invoicing_list method. If there
2910 is an error, returns the error, otherwise returns false.
2914 sub check_invoicing_list {
2915 my( $self, $arrayref ) = @_;
2917 foreach my $address ( @$arrayref ) {
2919 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2920 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2923 my $cust_main_invoice = new FS::cust_main_invoice ( {
2924 'custnum' => $self->custnum,
2927 my $error = $self->custnum
2928 ? $cust_main_invoice->check
2929 : $cust_main_invoice->checkdest
2931 return $error if $error;
2935 return "Email address required"
2936 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2937 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2944 Returns the email addresses of all accounts provisioned for this customer.
2951 foreach my $cust_pkg ( $self->all_pkgs ) {
2952 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2954 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2955 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2957 $list{$_}=1 foreach map { $_->email } @svc_acct;
2962 =item invoicing_list_addpost
2964 Adds postal invoicing to this customer. If this customer is already configured
2965 to receive postal invoices, does nothing.
2969 sub invoicing_list_addpost {
2971 if ( $self->get('postal_invoice') eq '' ) {
2972 $self->set('postal_invoice', 'Y');
2973 my $error = $self->replace;
2974 warn $error if $error; # should fail harder, but this is traditional
2978 =item invoicing_list_emailonly
2980 Returns the list of email invoice recipients (invoicing_list without non-email
2981 destinations such as POST and FAX).
2985 sub invoicing_list_emailonly {
2987 warn "$me invoicing_list_emailonly called"
2989 return () if !$self->custnum; # not yet inserted
2990 return map { $_->emailaddress }
2992 table => 'cust_contact',
2993 select => 'emailaddress',
2994 addl_from => ' JOIN contact USING (contactnum) '.
2995 ' JOIN contact_email USING (contactnum)',
2996 hashref => { 'custnum' => $self->custnum, },
2997 extra_sql => q( AND cust_contact.invoice_dest = 'Y'),
3001 =item invoicing_list_emailonly_scalar
3003 Returns the list of email invoice recipients (invoicing_list without non-email
3004 destinations such as POST and FAX) as a comma-separated scalar.
3008 sub invoicing_list_emailonly_scalar {
3010 warn "$me invoicing_list_emailonly_scalar called"
3012 join(', ', $self->invoicing_list_emailonly);
3015 =item contact_list [ CLASSNUM, ... ]
3017 Returns a list of contacts (L<FS::contact> objects) for the customer. If
3018 a list of contact classnums is given, returns only contacts in those
3019 classes. If the pseudo-classnum 'invoice' is given, returns contacts that
3020 are marked as invoice destinations. If '0' is given, also returns contacts
3023 If no arguments are given, returns all contacts for the customer.
3031 select => 'contact.*, cust_contact.invoice_dest',
3032 addl_from => ' JOIN cust_contact USING (contactnum)',
3033 extra_sql => ' WHERE cust_contact.custnum = '.$self->custnum,
3039 if ( $_ eq 'invoice' ) {
3040 push @orwhere, 'cust_contact.invoice_dest = \'Y\'';
3041 } elsif ( $_ eq '0' ) {
3042 push @orwhere, 'cust_contact.classnum is null';
3043 } elsif ( /^\d+$/ ) {
3044 push @classnums, $_;
3046 die "bad classnum argument '$_'";
3051 push @orwhere, 'cust_contact.classnum IN ('.join(',', @classnums).')';
3054 $search->{extra_sql} .= ' AND (' .
3055 join(' OR ', map "( $_ )", @orwhere) .
3062 =item contact_list_email [ CLASSNUM, ... ]
3064 Same as L</contact_list>, but returns email destinations instead of contact
3069 sub contact_list_email {
3071 my @contacts = $self->contact_list(@_);
3073 foreach my $contact (@contacts) {
3074 foreach my $contact_email ($contact->contact_email) {
3075 push @emails, Email::Address->new( $contact->firstlast,
3076 $contact_email->emailaddress
3083 =item referral_custnum_cust_main
3085 Returns the customer who referred this customer (or the empty string, if
3086 this customer was not referred).
3088 Note the difference with referral_cust_main method: This method,
3089 referral_custnum_cust_main returns the single customer (if any) who referred
3090 this customer, while referral_cust_main returns an array of customers referred
3095 sub referral_custnum_cust_main {
3097 return '' unless $self->referral_custnum;
3098 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3101 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3103 Returns an array of customers referred by this customer (referral_custnum set
3104 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3105 customers referred by customers referred by this customer and so on, inclusive.
3106 The default behavior is DEPTH 1 (no recursion).
3108 Note the difference with referral_custnum_cust_main method: This method,
3109 referral_cust_main, returns an array of customers referred BY this customer,
3110 while referral_custnum_cust_main returns the single customer (if any) who
3111 referred this customer.
3115 sub referral_cust_main {
3117 my $depth = @_ ? shift : 1;
3118 my $exclude = @_ ? shift : {};
3121 map { $exclude->{$_->custnum}++; $_; }
3122 grep { ! $exclude->{ $_->custnum } }
3123 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3127 map { $_->referral_cust_main($depth-1, $exclude) }
3134 =item referral_cust_main_ncancelled
3136 Same as referral_cust_main, except only returns customers with uncancelled
3141 sub referral_cust_main_ncancelled {
3143 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3146 =item referral_cust_pkg [ DEPTH ]
3148 Like referral_cust_main, except returns a flat list of all unsuspended (and
3149 uncancelled) packages for each customer. The number of items in this list may
3150 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3154 sub referral_cust_pkg {
3156 my $depth = @_ ? shift : 1;
3158 map { $_->unsuspended_pkgs }
3159 grep { $_->unsuspended_pkgs }
3160 $self->referral_cust_main($depth);
3163 =item referring_cust_main
3165 Returns the single cust_main record for the customer who referred this customer
3166 (referral_custnum), or false.
3170 sub referring_cust_main {
3172 return '' unless $self->referral_custnum;
3173 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3176 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3178 Applies a credit to this customer. If there is an error, returns the error,
3179 otherwise returns false.
3181 REASON can be a text string, an FS::reason object, or a scalar reference to
3182 a reasonnum. If a text string, it will be automatically inserted as a new
3183 reason, and a 'reason_type' option must be passed to indicate the
3184 FS::reason_type for the new reason.
3186 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3187 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3188 I<commission_pkgnum>.
3190 Any other options are passed to FS::cust_credit::insert.
3195 my( $self, $amount, $reason, %options ) = @_;
3197 my $cust_credit = new FS::cust_credit {
3198 'custnum' => $self->custnum,
3199 'amount' => $amount,
3202 if ( ref($reason) ) {
3204 if ( ref($reason) eq 'SCALAR' ) {
3205 $cust_credit->reasonnum( $$reason );
3207 $cust_credit->reasonnum( $reason->reasonnum );
3211 $cust_credit->set('reason', $reason)
3214 $cust_credit->$_( delete $options{$_} )
3215 foreach grep exists($options{$_}),
3216 qw( addlinfo eventnum ),
3217 map "commission_$_", qw( agentnum salesnum pkgnum );
3219 $cust_credit->insert(%options);
3223 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3225 Creates a one-time charge for this customer. If there is an error, returns
3226 the error, otherwise returns false.
3228 New-style, with a hashref of options:
3230 my $error = $cust_main->charge(
3234 'start_date' => str2time('7/4/2009'),
3235 'pkg' => 'Description',
3236 'comment' => 'Comment',
3237 'additional' => [], #extra invoice detail
3238 'classnum' => 1, #pkg_class
3240 'setuptax' => '', # or 'Y' for tax exempt
3242 'locationnum'=> 1234, # optional
3245 'taxclass' => 'Tax class',
3248 'taxproduct' => 2, #part_pkg_taxproduct
3249 'override' => {}, #XXX describe
3251 #will be filled in with the new object
3252 'cust_pkg_ref' => \$cust_pkg,
3254 #generate an invoice immediately
3256 'invoice_terms' => '', #with these terms
3262 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3266 #super false laziness w/quotation::charge
3269 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3270 my ( $pkg, $comment, $additional );
3271 my ( $setuptax, $taxclass ); #internal taxes
3272 my ( $taxproduct, $override ); #vendor (CCH) taxes
3274 my $separate_bill = '';
3275 my $cust_pkg_ref = '';
3276 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3278 my ( $discountnum, $discountnum_amount, $discountnum_percent ) = ( '','','' );
3279 if ( ref( $_[0] ) ) {
3280 $amount = $_[0]->{amount};
3281 $setup_cost = $_[0]->{setup_cost};
3282 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3283 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3284 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3285 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3286 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3287 : '$'. sprintf("%.2f",$amount);
3288 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3289 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3290 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3291 $additional = $_[0]->{additional} || [];
3292 $taxproduct = $_[0]->{taxproductnum};
3293 $override = { '' => $_[0]->{tax_override} };
3294 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3295 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3296 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3297 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3298 $separate_bill = $_[0]->{separate_bill} || '';
3299 $discountnum = $_[0]->{setup_discountnum};
3300 $discountnum_amount = $_[0]->{setup_discountnum_amount};
3301 $discountnum_percent = $_[0]->{setup_discountnum_percent};
3307 $pkg = @_ ? shift : 'One-time charge';
3308 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3310 $taxclass = @_ ? shift : '';
3314 local $SIG{HUP} = 'IGNORE';
3315 local $SIG{INT} = 'IGNORE';
3316 local $SIG{QUIT} = 'IGNORE';
3317 local $SIG{TERM} = 'IGNORE';
3318 local $SIG{TSTP} = 'IGNORE';
3319 local $SIG{PIPE} = 'IGNORE';
3321 my $oldAutoCommit = $FS::UID::AutoCommit;
3322 local $FS::UID::AutoCommit = 0;
3325 my $part_pkg = new FS::part_pkg ( {
3327 'comment' => $comment,
3331 'classnum' => ( $classnum ? $classnum : '' ),
3332 'setuptax' => $setuptax,
3333 'taxclass' => $taxclass,
3334 'taxproductnum' => $taxproduct,
3335 'setup_cost' => $setup_cost,
3338 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3339 ( 0 .. @$additional - 1 )
3341 'additional_count' => scalar(@$additional),
3342 'setup_fee' => $amount,
3345 my $error = $part_pkg->insert( options => \%options,
3346 tax_overrides => $override,
3349 $dbh->rollback if $oldAutoCommit;
3353 my $pkgpart = $part_pkg->pkgpart;
3354 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3355 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3356 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3357 $error = $type_pkgs->insert;
3359 $dbh->rollback if $oldAutoCommit;
3364 my $cust_pkg = new FS::cust_pkg ( {
3365 'custnum' => $self->custnum,
3366 'pkgpart' => $pkgpart,
3367 'quantity' => $quantity,
3368 'start_date' => $start_date,
3369 'no_auto' => $no_auto,
3370 'separate_bill' => $separate_bill,
3371 'locationnum' => $locationnum,
3372 'setup_discountnum' => $discountnum,
3373 'setup_discountnum_amount' => $discountnum_amount,
3374 'setup_discountnum_percent' => $discountnum_percent,
3377 $error = $cust_pkg->insert;
3379 $dbh->rollback if $oldAutoCommit;
3381 } elsif ( $cust_pkg_ref ) {
3382 ${$cust_pkg_ref} = $cust_pkg;
3386 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3387 'pkg_list' => [ $cust_pkg ],
3390 $dbh->rollback if $oldAutoCommit;
3395 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3400 #=item charge_postal_fee
3402 #Applies a one time charge this customer. If there is an error,
3403 #returns the error, returns the cust_pkg charge object or false
3404 #if there was no charge.
3408 # This should be a customer event. For that to work requires that bill
3409 # also be a customer event.
3411 sub charge_postal_fee {
3414 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3415 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3417 my $cust_pkg = new FS::cust_pkg ( {
3418 'custnum' => $self->custnum,
3419 'pkgpart' => $pkgpart,
3423 my $error = $cust_pkg->insert;
3424 $error ? $error : $cust_pkg;
3427 =item num_cust_attachment_deleted
3429 Returns the number of deleted attachments for this customer (see
3430 L<FS::num_cust_attachment>).
3434 sub num_cust_attachments_deleted {
3437 " SELECT COUNT(*) FROM cust_attachment ".
3438 " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0",
3445 Returns the most recent invnum (invoice number) for this customer.
3452 " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?",
3457 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3459 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3461 Optionally, a list or hashref of additional arguments to the qsearch call can
3468 my $opt = ref($_[0]) ? shift : { @_ };
3470 #return $self->num_cust_bill unless wantarray || keys %$opt;
3472 $opt->{'table'} = 'cust_bill';
3473 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3474 $opt->{'hashref'}{'custnum'} = $self->custnum;
3475 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3477 map { $_ } #behavior of sort undefined in scalar context
3478 sort { $a->_date <=> $b->_date }
3482 =item open_cust_bill
3484 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3489 sub open_cust_bill {
3493 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3499 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3501 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3505 sub legacy_cust_bill {
3508 #return $self->num_legacy_cust_bill unless wantarray;
3510 map { $_ } #behavior of sort undefined in scalar context
3511 sort { $a->_date <=> $b->_date }
3512 qsearch({ 'table' => 'legacy_cust_bill',
3513 'hashref' => { 'custnum' => $self->custnum, },
3514 'order_by' => 'ORDER BY _date ASC',
3518 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3520 Returns all the statements (see L<FS::cust_statement>) for this customer.
3522 Optionally, a list or hashref of additional arguments to the qsearch call can
3527 =item cust_bill_void
3529 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3533 sub cust_bill_void {
3536 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3537 sort { $a->_date <=> $b->_date }
3538 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3541 sub cust_statement {
3543 my $opt = ref($_[0]) ? shift : { @_ };
3545 #return $self->num_cust_statement unless wantarray || keys %$opt;
3547 $opt->{'table'} = 'cust_statement';
3548 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3549 $opt->{'hashref'}{'custnum'} = $self->custnum;
3550 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3552 map { $_ } #behavior of sort undefined in scalar context
3553 sort { $a->_date <=> $b->_date }
3557 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3559 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3561 Optionally, a list or hashref of additional arguments to the qsearch call can
3562 be passed following the SVCDB.
3569 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3570 warn "$me svc_x requires a svcdb";
3573 my $opt = ref($_[0]) ? shift : { @_ };
3575 $opt->{'table'} = $svcdb;
3576 $opt->{'addl_from'} =
3577 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3578 ($opt->{'addl_from'} || '');
3580 my $custnum = $self->custnum;
3581 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3582 my $where = "cust_pkg.custnum = $custnum";
3584 my $extra_sql = $opt->{'extra_sql'} || '';
3585 if ( keys %{ $opt->{'hashref'} } ) {
3586 $extra_sql = " AND $where $extra_sql";
3589 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3590 $extra_sql = "WHERE $where AND $1";
3593 $extra_sql = "WHERE $where $extra_sql";
3596 $opt->{'extra_sql'} = $extra_sql;
3601 # required for use as an eventtable;
3604 $self->svc_x('svc_acct', @_);
3609 Returns all the credits (see L<FS::cust_credit>) for this customer.
3616 #return $self->num_cust_credit unless wantarray;
3618 map { $_ } #behavior of sort undefined in scalar context
3619 sort { $a->_date <=> $b->_date }
3620 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3623 =item cust_credit_pkgnum
3625 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3626 package when using experimental package balances.
3630 sub cust_credit_pkgnum {
3631 my( $self, $pkgnum ) = @_;
3632 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3633 sort { $a->_date <=> $b->_date }
3634 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3635 'pkgnum' => $pkgnum,
3640 =item cust_credit_void
3642 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3646 sub cust_credit_void {
3649 sort { $a->_date <=> $b->_date }
3650 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3655 Returns all the payments (see L<FS::cust_pay>) for this customer.
3661 my $opt = ref($_[0]) ? shift : { @_ };
3663 return $self->num_cust_pay unless wantarray || keys %$opt;
3665 $opt->{'table'} = 'cust_pay';
3666 $opt->{'hashref'}{'custnum'} = $self->custnum;
3668 map { $_ } #behavior of sort undefined in scalar context
3669 sort { $a->_date <=> $b->_date }
3676 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3677 called automatically when the cust_pay method is used in a scalar context.
3683 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3684 my $sth = dbh->prepare($sql) or die dbh->errstr;
3685 $sth->execute($self->custnum) or die $sth->errstr;
3686 $sth->fetchrow_arrayref->[0];
3689 =item unapplied_cust_pay
3691 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3695 sub unapplied_cust_pay {
3699 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3705 =item cust_pay_pkgnum
3707 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3708 package when using experimental package balances.
3712 sub cust_pay_pkgnum {
3713 my( $self, $pkgnum ) = @_;
3714 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3715 sort { $a->_date <=> $b->_date }
3716 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3717 'pkgnum' => $pkgnum,
3724 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3730 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3731 sort { $a->_date <=> $b->_date }
3732 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3735 =item cust_pay_pending
3737 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3738 (without status "done").
3742 sub cust_pay_pending {
3744 return $self->num_cust_pay_pending unless wantarray;
3745 sort { $a->_date <=> $b->_date }
3746 qsearch( 'cust_pay_pending', {
3747 'custnum' => $self->custnum,
3748 'status' => { op=>'!=', value=>'done' },
3753 =item cust_pay_pending_attempt
3755 Returns all payment attempts / declined payments for this customer, as pending
3756 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3757 a corresponding payment (see L<FS::cust_pay>).
3761 sub cust_pay_pending_attempt {
3763 return $self->num_cust_pay_pending_attempt unless wantarray;
3764 sort { $a->_date <=> $b->_date }
3765 qsearch( 'cust_pay_pending', {
3766 'custnum' => $self->custnum,
3773 =item num_cust_pay_pending
3775 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3776 customer (without status "done"). Also called automatically when the
3777 cust_pay_pending method is used in a scalar context.
3781 sub num_cust_pay_pending {
3784 " SELECT COUNT(*) FROM cust_pay_pending ".
3785 " WHERE custnum = ? AND status != 'done' ",
3790 =item num_cust_pay_pending_attempt
3792 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3793 customer, with status "done" but without a corresp. Also called automatically when the
3794 cust_pay_pending method is used in a scalar context.
3798 sub num_cust_pay_pending_attempt {
3801 " SELECT COUNT(*) FROM cust_pay_pending ".
3802 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3809 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3815 map { $_ } #return $self->num_cust_refund unless wantarray;
3816 sort { $a->_date <=> $b->_date }
3817 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3820 =item display_custnum
3822 Returns the displayed customer number for this customer: agent_custid if
3823 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3827 sub display_custnum {
3830 return $self->agent_custid
3831 if $default_agent_custid && $self->agent_custid;
3833 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3837 sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
3838 } elsif ( $custnum_display_length ) {
3839 return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
3841 return $self->custnum;
3847 Returns a name string for this customer, either "Company (Last, First)" or
3854 my $name = $self->contact;
3855 $name = $self->company. " ($name)" if $self->company;
3859 =item service_contact
3861 Returns the L<FS::contact> object for this customer that has the 'Service'
3862 contact class, or undef if there is no such contact. Deprecated; don't use
3867 sub service_contact {
3869 if ( !exists($self->{service_contact}) ) {
3870 my $classnum = $self->scalar_sql(
3871 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3872 ) || 0; #if it's zero, qsearchs will return nothing
3873 my $cust_contact = qsearchs('cust_contact', {
3874 'classnum' => $classnum,
3875 'custnum' => $self->custnum,
3877 $self->{service_contact} = $cust_contact->contact if $cust_contact;
3879 $self->{service_contact};
3884 Returns a name string for this (service/shipping) contact, either
3885 "Company (Last, First)" or "Last, First".
3892 my $name = $self->ship_contact;
3893 $name = $self->company. " ($name)" if $self->company;
3899 Returns a name string for this customer, either "Company" or "First Last".
3905 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3908 =item ship_name_short
3910 Returns a name string for this (service/shipping) contact, either "Company"
3915 sub ship_name_short {
3917 $self->service_contact
3918 ? $self->ship_contact_firstlast
3924 Returns this customer's full (billing) contact name only, "Last, First"
3930 $self->get('last'). ', '. $self->first;
3935 Returns this customer's full (shipping) contact name only, "Last, First"
3941 my $contact = $self->service_contact || $self;
3942 $contact->get('last') . ', ' . $contact->get('first');
3945 =item contact_firstlast
3947 Returns this customers full (billing) contact name only, "First Last".
3951 sub contact_firstlast {
3953 $self->first. ' '. $self->get('last');
3956 =item ship_contact_firstlast
3958 Returns this customer's full (shipping) contact name only, "First Last".
3962 sub ship_contact_firstlast {
3964 my $contact = $self->service_contact || $self;
3965 $contact->get('first') . ' '. $contact->get('last');
3968 sub bill_country_full {
3970 $self->bill_location->country_full;
3973 sub ship_country_full {
3975 $self->ship_location->country_full;
3978 =item county_state_county [ PREFIX ]
3980 Returns a string consisting of just the county, state and country.
3984 sub county_state_country {
3987 if ( @_ && $_[0] && $self->has_ship_address ) {
3988 $locationnum = $self->ship_locationnum;
3990 $locationnum = $self->bill_locationnum;
3992 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
3993 $cust_location->county_state_country;
3996 =item geocode DATA_VENDOR
3998 Returns a value for the customer location as encoded by DATA_VENDOR.
3999 Currently this only makes sense for "CCH" as DATA_VENDOR.
4007 Returns a status string for this customer, currently:
4013 No packages have ever been ordered. Displayed as "No packages".
4017 Recurring packages all are new (not yet billed).
4021 One or more recurring packages is active.
4025 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
4029 All non-cancelled recurring packages are suspended.
4033 All recurring packages are cancelled.
4037 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4038 cust_main-status_module configuration option.
4042 sub status { shift->cust_status(@_); }
4046 return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4047 for my $status ( FS::cust_main->statuses() ) {
4048 my $method = $status.'_sql';
4049 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4050 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4051 $sth->execute( ($self->custnum) x $numnum )
4052 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4053 if ( $sth->fetchrow_arrayref->[0] ) {
4054 $self->hashref->{cust_status} = $status;
4060 =item is_status_delay_cancel
4062 Returns true if customer status is 'suspended'
4063 and all suspended cust_pkg return true for
4064 cust_pkg->is_status_delay_cancel.
4066 This is not a real status, this only meant for hacking display
4067 values, because otherwise treating the customer as suspended is
4068 really the whole point of the delay_cancel option.
4072 sub is_status_delay_cancel {
4074 return 0 unless $self->status eq 'suspended';
4075 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4076 return 0 unless $cust_pkg->is_status_delay_cancel;
4081 =item ucfirst_cust_status
4083 =item ucfirst_status
4085 Deprecated, use the cust_status_label method instead.
4087 Returns the status with the first character capitalized.
4091 sub ucfirst_status {
4092 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4093 local($ucfirst_nowarn) = 1;
4094 shift->ucfirst_cust_status(@_);
4097 sub ucfirst_cust_status {
4098 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4100 ucfirst($self->cust_status);
4103 =item cust_status_label
4107 Returns the display label for this status.
4111 sub status_label { shift->cust_status_label(@_); }
4113 sub cust_status_label {
4115 __PACKAGE__->statuslabels->{$self->cust_status};
4120 Returns a hex triplet color string for this customer's status.
4124 sub statuscolor { shift->cust_statuscolor(@_); }
4126 sub cust_statuscolor {
4128 __PACKAGE__->statuscolors->{$self->cust_status};
4131 =item tickets [ STATUS ]
4133 Returns an array of hashes representing the customer's RT tickets.
4135 An optional status (or arrayref or hashref of statuses) may be specified.
4141 my $status = ( @_ && $_[0] ) ? shift : '';
4143 my $num = $conf->config('cust_main-max_tickets') || 10;
4146 if ( $conf->config('ticket_system') ) {
4147 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4149 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4158 foreach my $priority (
4159 $conf->config('ticket_system-custom_priority_field-values'), ''
4161 last if scalar(@tickets) >= $num;
4163 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4164 $num - scalar(@tickets),
4175 =item appointments [ STATUS ]
4177 Returns an array of hashes representing the customer's RT tickets which
4184 my $status = ( @_ && $_[0] ) ? shift : '';
4186 return () unless $conf->config('ticket_system');
4188 my $queueid = $conf->config('ticket_system-appointment-queueid');
4190 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4199 # Return services representing svc_accts in customer support packages
4200 sub support_services {
4202 my %packages = map { $_ => 1 } $conf->config('support_packages');
4204 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4205 grep { $_->part_svc->svcdb eq 'svc_acct' }
4206 map { $_->cust_svc }
4207 grep { exists $packages{ $_->pkgpart } }
4208 $self->ncancelled_pkgs;
4212 # Return a list of latitude/longitude for one of the services (if any)
4213 sub service_coordinates {
4217 grep { $_->latitude && $_->longitude }
4219 map { $_->cust_svc }
4220 $self->ncancelled_pkgs;
4222 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4227 Returns a masked version of the named field
4232 my ($self,$field) = @_;
4236 'x'x(length($self->getfield($field))-4).
4237 substr($self->getfield($field), (length($self->getfield($field))-4));
4241 =item payment_history
4243 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4244 cust_credit and cust_refund objects. Each hashref has the following fields:
4246 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4248 I<date> - value of _date field, unix timestamp
4250 I<date_pretty> - user-friendly date
4252 I<description> - user-friendly description of item
4254 I<amount> - impact of item on user's balance
4255 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4256 Not to be confused with the native 'amount' field in cust_credit, see below.
4258 I<amount_pretty> - includes money char
4260 I<balance> - customer balance, chronologically as of this item
4262 I<balance_pretty> - includes money char
4264 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4266 I<paid> - amount paid for cust_pay records, undef for other types
4268 I<credit> - amount credited for cust_credit records, undef for other types.
4269 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4271 I<refund> - amount refunded for cust_refund records, undef for other types
4273 The four table-specific keys always have positive values, whether they reflect charges or payments.
4275 The following options may be passed to this method:
4277 I<line_items> - if true, returns charges ('Line item') rather than invoices
4279 I<start_date> - unix timestamp, only include records on or after.
4280 If specified, an item of type 'Previous' will also be included.
4281 It does not have table-specific fields.
4283 I<end_date> - unix timestamp, only include records before
4285 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4287 I<conf> - optional already-loaded FS::Conf object.
4291 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4292 # and also for sending customer statements, which should both be kept customer-friendly.
4293 # If you add anything that shouldn't be passed on through the API or exposed
4294 # to customers, add a new option to include it, don't include it by default
4295 sub payment_history {
4297 my $opt = ref($_[0]) ? $_[0] : { @_ };
4299 my $conf = $$opt{'conf'} || new FS::Conf;
4300 my $money_char = $conf->config("money_char") || '$',
4302 #first load entire history,
4303 #need previous to calculate previous balance
4304 #loading after end_date shouldn't hurt too much?
4306 if ( $$opt{'line_items'} ) {
4308 foreach my $cust_bill ( $self->cust_bill ) {
4311 'type' => 'Line item',
4312 'description' => $_->desc( $self->locale ).
4313 ( $_->sdate && $_->edate
4314 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4315 ' To '. time2str('%d-%b-%Y', $_->edate)
4318 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4319 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4320 'date' => $cust_bill->_date,
4321 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4323 foreach $cust_bill->cust_bill_pkg;
4330 'type' => 'Invoice',
4331 'description' => 'Invoice #'. $_->display_invnum,
4332 'amount' => sprintf('%.2f', $_->charged ),
4333 'charged' => sprintf('%.2f', $_->charged ),
4334 'date' => $_->_date,
4335 'date_pretty' => $self->time2str_local('short', $_->_date ),
4337 foreach $self->cust_bill;
4342 'type' => 'Payment',
4343 'description' => 'Payment', #XXX type
4344 'amount' => sprintf('%.2f', 0 - $_->paid ),
4345 'paid' => sprintf('%.2f', $_->paid ),
4346 'date' => $_->_date,
4347 'date_pretty' => $self->time2str_local('short', $_->_date ),
4349 foreach $self->cust_pay;
4353 'description' => 'Credit', #more info?
4354 'amount' => sprintf('%.2f', 0 -$_->amount ),
4355 'credit' => sprintf('%.2f', $_->amount ),
4356 'date' => $_->_date,
4357 'date_pretty' => $self->time2str_local('short', $_->_date ),
4359 foreach $self->cust_credit;
4363 'description' => 'Refund', #more info? type, like payment?
4364 'amount' => $_->refund,
4365 'refund' => $_->refund,
4366 'date' => $_->_date,
4367 'date_pretty' => $self->time2str_local('short', $_->_date ),
4369 foreach $self->cust_refund;
4371 #put it all in chronological order
4372 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4374 #calculate balance, filter items outside date range
4378 foreach my $item (@history) {
4379 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4380 $balance += $$item{'amount'};
4381 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4382 $previous += $$item{'amount'};
4385 $$item{'balance'} = sprintf("%.2f",$balance);
4386 foreach my $key ( qw(amount balance) ) {
4387 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4392 # start with previous balance, if there was one
4395 'type' => 'Previous',
4396 'description' => 'Previous balance',
4397 'amount' => sprintf("%.2f",$previous),
4398 'balance' => sprintf("%.2f",$previous),
4399 'date' => $$opt{'start_date'},
4400 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4402 #false laziness with above
4403 foreach my $key ( qw(amount balance) ) {
4404 $$item{$key.'_pretty'} = $$item{$key};
4405 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4407 unshift(@out,$item);
4410 @out = reverse @history if $$opt{'reverse_sort'};
4415 =item save_cust_payby
4417 Saves a new cust_payby for this customer, replacing an existing entry only
4418 in select circumstances. Does not validate input.
4420 If auto is specified, marks this as the customer's primary method, or the
4421 specified weight. Existing payment methods have their weight incremented as
4424 If bill_location is specified with auto, also sets location in cust_main.
4426 Will not insert complete duplicates of existing records, or records in which the
4427 only difference from an existing record is to turn off automatic payment (will
4428 return without error.) Will replace existing records in which the only difference
4429 is to add a value to a previously empty preserved field and/or turn on automatic payment.
4430 Fields marked as preserved are optional, and existing values will not be overwritten with
4431 blanks when replacing.
4433 Accepts the following named parameters:
4443 save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
4447 optional, set higher than 1 for secondary, etc.
4455 optional, but should be specified for anything that might be tokenized, will be preserved when replacing
4463 optional, will be preserved when replacing
4471 CARD only, required, FS::cust_location object
4473 =item paystart_month
4475 CARD only, optional, will be preserved when replacing
4479 CARD only, optional, will be preserved when replacing
4483 CARD only, optional, will be preserved when replacing
4487 CARD only, only used if conf cvv-save is set appropriately
4497 =item saved_cust_payby
4499 scalar reference, for returning saved object
4505 #The code for this option is in place, but it's not currently used
4509 # existing cust_payby object to be replaced (must match custnum)
4511 # stateid/stateid_state/ss are not currently supported in cust_payby,
4512 # might not even work properly in 4.x, but will need to work here if ever added
4514 sub save_cust_payby {
4518 my $old = $opt{'replace'};
4519 my $new = new FS::cust_payby { $old ? $old->hash : () };
4520 return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum;
4521 $new->set( 'custnum' => $self->custnum );
4523 my $payby = $opt{'payment_payby'};
4524 return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK'));
4526 # don't allow turning off auto when replacing
4527 $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/;
4529 my @check_existing; # payby relevant to this payment_payby
4531 # set payby based on auto
4532 if ( $payby eq 'CARD' ) {
4533 $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) );
4534 @check_existing = qw( CARD DCRD );
4535 } elsif ( $payby eq 'CHEK' ) {
4536 $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) );
4537 @check_existing = qw( CHEK DCHK );
4540 $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' );
4543 $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized
4544 $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask
4545 $new->set( 'payname' => $opt{'payname'} );
4546 $new->set( 'payip' => $opt{'payip'} ); # will be preserved below
4548 my $conf = new FS::Conf;
4550 # compare to FS::cust_main::realtime_bop - check both to make sure working correctly
4551 if ( $payby eq 'CARD' &&
4552 ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save'))
4553 || $conf->exists('business-onlinepayment-verification')
4556 $new->set( 'paycvv' => $opt{'paycvv'} );
4558 $new->set( 'paycvv' => '');
4561 local $SIG{HUP} = 'IGNORE';
4562 local $SIG{INT} = 'IGNORE';
4563 local $SIG{QUIT} = 'IGNORE';
4564 local $SIG{TERM} = 'IGNORE';
4565 local $SIG{TSTP} = 'IGNORE';
4566 local $SIG{PIPE} = 'IGNORE';
4568 my $oldAutoCommit = $FS::UID::AutoCommit;
4569 local $FS::UID::AutoCommit = 0;
4572 # set fields specific to payment_payby
4573 if ( $payby eq 'CARD' ) {
4574 if ($opt{'bill_location'}) {
4575 $opt{'bill_location'}->set('custnum' => $self->custnum);
4576 my $error = $opt{'bill_location'}->find_or_insert;
4578 $dbh->rollback if $oldAutoCommit;
4581 $new->set( 'locationnum' => $opt{'bill_location'}->locationnum );
4583 foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) {
4584 $new->set( $field => $opt{$field} );
4587 foreach my $field ( qw(paytype paystate) ) {
4588 $new->set( $field => $opt{$field} );
4592 # other cust_payby to compare this to
4593 my @existing = $self->cust_payby(@check_existing);
4595 # fields that can overwrite blanks with values, but not values with blanks
4596 my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip );
4598 my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby
4600 # generally, we don't want to overwrite existing cust_payby with this,
4601 # but we can replace if we're only marking it auto or adding a preserved field
4602 # and we can avoid saving a total duplicate or merely turning off auto
4604 foreach my $cust_payby (@existing) {
4605 # check fields that absolutely should not change
4606 foreach my $field ($new->fields) {
4607 next if grep(/^$field$/, qw( custpaybynum payby weight ) );
4608 next if grep(/^$field$/, @preserve );
4609 next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
4611 # now check fields that can replace if one value is blank
4613 foreach my $field (@preserve) {
4615 ( $new->get($field) and !$cust_payby->get($field) ) or
4616 ( $cust_payby->get($field) and !$new->get($field) )
4618 # prevention of overwriting values with blanks happens farther below
4620 } elsif ( $new->get($field) ne $cust_payby->get($field) ) {
4624 unless ( $replace ) {
4625 # nearly identical, now check weight
4626 if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) {
4627 # ignore identical cust_payby, and ignore attempts to turn off auto
4628 # no need to save or re-weight cust_payby (but still need to update/commit $self)
4629 $skip_cust_payby = 1;
4632 # otherwise, only change is to mark this as primary
4634 # if we got this far, we're definitely replacing
4641 $new->set( 'custpaybynum' => $old->custpaybynum );
4642 # don't turn off automatic payment (but allow it to be turned on)
4643 if ($new->payby =~ /^D/ and $new->payby ne $old->payby) {
4645 $new->set( 'payby' => $old->payby );
4646 $new->set( 'weight' => 1 );
4648 # make sure we're not overwriting values with blanks
4649 foreach my $field (@preserve) {
4650 if ( $old->get($field) and !$new->get($field) ) {
4651 $new->set( $field => $old->get($field) );
4656 # only overwrite cust_main bill_location if auto
4657 if ($opt{'auto'} && $opt{'bill_location'}) {
4658 $self->set('bill_location' => $opt{'bill_location'});
4659 my $error = $self->replace;
4661 $dbh->rollback if $oldAutoCommit;
4666 # done with everything except reweighting and saving cust_payby
4667 # still need to commit changes to cust_main and cust_location
4668 if ($skip_cust_payby) {
4669 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4673 # re-weight existing primary cust_pay for this payby
4675 foreach my $cust_payby (@existing) {
4676 # relies on cust_payby return order
4677 last unless $cust_payby->payby !~ /^D/;
4678 last if $cust_payby->weight > 1;
4679 next if $new->custpaybynum eq $cust_payby->custpaybynum;
4680 next if $cust_payby->weight < ($opt{'weight'} || 1);
4681 $cust_payby->weight( $cust_payby->weight + 1 );
4682 my $error = $cust_payby->replace;
4684 $dbh->rollback if $oldAutoCommit;
4685 return "Error reweighting cust_payby: $error";
4690 # finally, save cust_payby
4691 my $error = $old ? $new->replace($old) : $new->insert;
4693 $dbh->rollback if $oldAutoCommit;
4697 ${$opt{'saved_cust_payby'}} = $new
4698 if $opt{'saved_cust_payby'};
4700 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4705 =item remove_cvv_from_cust_payby PAYINFO
4707 Removes paycvv from associated cust_payby with matching PAYINFO.
4711 sub remove_cvv_from_cust_payby {
4712 my ($self,$payinfo) = @_;
4714 my $oldAutoCommit = $FS::UID::AutoCommit;
4715 local $FS::UID::AutoCommit = 0;
4718 foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) {
4719 next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo
4720 $cust_payby->paycvv('');
4721 my $error = $cust_payby->replace;
4723 $dbh->rollback if $oldAutoCommit;
4728 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4734 =head1 CLASS METHODS
4740 Class method that returns the list of possible status strings for customers
4741 (see L<the status method|/status>). For example:
4743 @statuses = FS::cust_main->statuses();
4749 keys %{ $self->statuscolors };
4752 =item cust_status_sql
4754 Returns an SQL fragment to determine the status of a cust_main record, as a
4759 sub cust_status_sql {
4761 for my $status ( FS::cust_main->statuses() ) {
4762 my $method = $status.'_sql';
4763 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4772 Returns an SQL expression identifying prospective cust_main records (customers
4773 with no packages ever ordered)
4777 use vars qw($select_count_pkgs);
4778 $select_count_pkgs =
4779 "SELECT COUNT(*) FROM cust_pkg
4780 WHERE cust_pkg.custnum = cust_main.custnum";
4782 sub select_count_pkgs_sql {
4787 " 0 = ( $select_count_pkgs ) ";
4792 Returns an SQL expression identifying ordered cust_main records (customers with
4793 no active packages, but recurring packages not yet setup or one time charges
4799 FS::cust_main->none_active_sql.
4800 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4805 Returns an SQL expression identifying active cust_main records (customers with
4806 active recurring packages).
4811 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4814 =item none_active_sql
4816 Returns an SQL expression identifying cust_main records with no active
4817 recurring packages. This includes customers of status prospect, ordered,
4818 inactive, and suspended.
4822 sub none_active_sql {
4823 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4828 Returns an SQL expression identifying inactive cust_main records (customers with
4829 no active recurring packages, but otherwise unsuspended/uncancelled).
4834 FS::cust_main->none_active_sql.
4835 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4841 Returns an SQL expression identifying suspended cust_main records.
4846 sub suspended_sql { susp_sql(@_); }
4848 FS::cust_main->none_active_sql.
4849 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4855 Returns an SQL expression identifying cancelled cust_main records.
4859 sub cancel_sql { shift->cancelled_sql(@_); }
4862 =item uncancelled_sql
4864 Returns an SQL expression identifying un-cancelled cust_main records.
4868 sub uncancelled_sql { uncancel_sql(@_); }
4871 "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
4876 Returns an SQL fragment to retreive the balance.
4881 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4882 WHERE cust_bill.custnum = cust_main.custnum )
4883 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4884 WHERE cust_pay.custnum = cust_main.custnum )
4885 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4886 WHERE cust_credit.custnum = cust_main.custnum )
4887 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4888 WHERE cust_refund.custnum = cust_main.custnum )
4891 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4893 Returns an SQL fragment to retreive the balance for this customer, optionally
4894 considering invoices with date earlier than START_TIME, and not
4895 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4896 total_unapplied_payments).
4898 Times are specified as SQL fragments or numeric
4899 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4900 L<Date::Parse> for conversion functions. The empty string can be passed
4901 to disable that time constraint completely.
4903 Available options are:
4907 =item unapplied_date
4909 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)
4914 set to true to remove all customer comparison clauses, for totals
4919 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4924 JOIN clause (typically used with the total option)
4928 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4929 time will be ignored. Note that START_TIME and END_TIME only limit the date
4930 range for invoices and I<unapplied> payments, credits, and refunds.
4936 sub balance_date_sql {
4937 my( $class, $start, $end, %opt ) = @_;
4939 my $cutoff = $opt{'cutoff'};
4941 my $owed = FS::cust_bill->owed_sql($cutoff);
4942 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4943 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4944 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4946 my $j = $opt{'join'} || '';
4948 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4949 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4950 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4951 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4953 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4954 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4955 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4956 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4961 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4963 Returns an SQL fragment to retreive the total unapplied payments for this
4964 customer, only considering payments with date earlier than START_TIME, and
4965 optionally not later than END_TIME.
4967 Times are specified as SQL fragments or numeric
4968 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4969 L<Date::Parse> for conversion functions. The empty string can be passed
4970 to disable that time constraint completely.
4972 Available options are:
4976 sub unapplied_payments_date_sql {
4977 my( $class, $start, $end, %opt ) = @_;
4979 my $cutoff = $opt{'cutoff'};
4981 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4983 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4984 'unapplied_date'=>1 );
4986 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4989 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4991 Helper method for balance_date_sql; name (and usage) subject to change
4992 (suggestions welcome).
4994 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4995 cust_refund, cust_credit or cust_pay).
4997 If TABLE is "cust_bill" or the unapplied_date option is true, only
4998 considers records with date earlier than START_TIME, and optionally not
4999 later than END_TIME .
5003 sub _money_table_where {
5004 my( $class, $table, $start, $end, %opt ) = @_;
5007 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5008 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5009 push @where, "$table._date <= $start" if defined($start) && length($start);
5010 push @where, "$table._date > $end" if defined($end) && length($end);
5012 push @where, @{$opt{'where'}} if $opt{'where'};
5013 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5019 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5020 use FS::cust_main::Search;
5023 FS::cust_main::Search->search(@_);
5032 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5034 Generates a templated notification to the customer (see L<Text::Template>).
5036 OPTIONS is a hash and may include
5038 I<extra_fields> - a hashref of name/value pairs which will be substituted
5039 into the template. These values may override values mentioned below
5040 and those from the customer record.
5042 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5044 The following variables are available in the template instead of or in addition
5045 to the fields of the customer record.
5047 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5051 # a lot like cust_bill::print_latex
5052 sub generate_letter {
5053 my ($self, $template, %options) = @_;
5055 warn "Template $template does not exist" && return
5056 unless $conf->exists($template) || $options{'template_text'};
5058 my $template_source = $options{'template_text'}
5059 ? [ $options{'template_text'} ]
5060 : [ map "$_\n", $conf->config($template) ];
5062 my $letter_template = new Text::Template
5064 SOURCE => $template_source,
5065 DELIMITERS => [ '[@--', '--@]' ],
5067 or die "can't create new Text::Template object: Text::Template::ERROR";
5069 $letter_template->compile()
5070 or die "can't compile template: Text::Template::ERROR";
5072 my %letter_data = map { $_ => $self->$_ } $self->fields;
5074 for (keys %{$options{extra_fields}}){
5075 $letter_data{$_} = $options{extra_fields}->{$_};
5078 unless(exists($letter_data{returnaddress})){
5079 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5080 $self->agent_template)
5082 if ( length($retadd) ) {
5083 $letter_data{returnaddress} = $retadd;
5084 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5085 $letter_data{returnaddress} =
5086 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5090 ( $conf->config('company_name', $self->agentnum),
5091 $conf->config('company_address', $self->agentnum),
5095 $letter_data{returnaddress} = '~';
5099 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5101 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5103 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5105 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5109 ) or die "can't open temp file: $!\n";
5110 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5111 or die "can't write temp file: $!\n";
5113 $letter_data{'logo_file'} = $lh->filename;
5115 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5119 ) or die "can't open temp file: $!\n";
5121 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5123 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5124 return ($1, $letter_data{'logo_file'});
5128 =item print_ps TEMPLATE
5130 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5136 my($file, $lfile) = $self->generate_letter(@_);
5137 my $ps = FS::Misc::generate_ps($file);
5138 unlink($file.'.tex');
5144 =item print TEMPLATE
5146 Prints the filled in template.
5148 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5152 sub queueable_print {
5155 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5156 or die "invalid customer number: " . $opt{custnum};
5158 #do not backport this change to 3.x
5159 # my $error = $self->print( { 'template' => $opt{template} } );
5160 my $error = $self->print( $opt{'template'} );
5161 die $error if $error;
5165 my ($self, $template) = (shift, shift);
5167 [ $self->print_ps($template) ],
5168 'agentnum' => $self->agentnum,
5172 #these three subs should just go away once agent stuff is all config overrides
5174 sub agent_template {
5176 $self->_agent_plandata('agent_templatename');
5179 sub agent_invoice_from {
5181 $self->_agent_plandata('agent_invoice_from');
5184 sub _agent_plandata {
5185 my( $self, $option ) = @_;
5187 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5188 #agent-specific Conf
5190 use FS::part_event::Condition;
5192 my $agentnum = $self->agentnum;
5194 my $regexp = regexp_sql();
5196 my $part_event_option =
5198 'select' => 'part_event_option.*',
5199 'table' => 'part_event_option',
5201 LEFT JOIN part_event USING ( eventpart )
5202 LEFT JOIN part_event_option AS peo_agentnum
5203 ON ( part_event.eventpart = peo_agentnum.eventpart
5204 AND peo_agentnum.optionname = 'agentnum'
5205 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5207 LEFT JOIN part_event_condition
5208 ON ( part_event.eventpart = part_event_condition.eventpart
5209 AND part_event_condition.conditionname = 'cust_bill_age'
5211 LEFT JOIN part_event_condition_option
5212 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5213 AND part_event_condition_option.optionname = 'age'
5216 #'hashref' => { 'optionname' => $option },
5217 #'hashref' => { 'part_event_option.optionname' => $option },
5219 " WHERE part_event_option.optionname = ". dbh->quote($option).
5220 " AND action = 'cust_bill_send_agent' ".
5221 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5222 " AND peo_agentnum.optionname = 'agentnum' ".
5223 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5225 CASE WHEN part_event_condition_option.optionname IS NULL
5227 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5229 , part_event.weight".
5233 unless ( $part_event_option ) {
5234 return $self->agent->invoice_template || ''
5235 if $option eq 'agent_templatename';
5239 $part_event_option->optionvalue;
5243 sub process_o2m_qsearch {
5246 return qsearch($table, @_) unless $table eq 'contact';
5248 my $hashref = shift;
5249 my %hash = %$hashref;
5250 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5251 or die 'guru meditation #4343';
5253 qsearch({ 'table' => 'contact',
5254 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5255 'hashref' => \%hash,
5256 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5257 " cust_contact.custnum = $custnum "
5261 sub process_o2m_qsearchs {
5264 return qsearchs($table, @_) unless $table eq 'contact';
5266 my $hashref = shift;
5267 my %hash = %$hashref;
5268 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5269 or die 'guru meditation #2121';
5271 qsearchs({ 'table' => 'contact',
5272 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5273 'hashref' => \%hash,
5274 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5275 " cust_contact.custnum = $custnum "
5279 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5281 Subroutine (not a method), designed to be called from the queue.
5283 Takes a list of options and values.
5285 Pulls up the customer record via the custnum option and calls bill_and_collect.
5290 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5292 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5293 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5295 #without this errors don't get rolled back
5296 $args{'fatal'} = 1; # runs from job queue, will be caught
5298 $cust_main->bill_and_collect( %args );
5301 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5303 Like queued_bill, but instead of C<bill_and_collect>, just runs the
5304 C<collect> part. This is used in batch tax calculation, where invoice
5305 generation and collection events have to be completely separated.
5309 sub queued_collect {
5311 my $cust_main = FS::cust_main->by_key($args{'custnum'});
5313 $cust_main->collect(%args);
5316 sub process_bill_and_collect {
5319 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5320 or die "custnum '$param->{custnum}' not found!\n";
5321 $param->{'job'} = $job;
5322 $param->{'fatal'} = 1; # runs from job queue, will be caught
5323 $param->{'retry'} = 1;
5325 $cust_main->bill_and_collect( %$param );
5328 #starting to take quite a while for big dbs
5329 # (JRNL: journaled so it only happens once per database)
5330 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5331 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5332 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5333 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5334 # JRNL leading/trailing spaces in first, last, company
5335 # JRNL migrate to cust_payby
5336 # - otaker upgrade? journal and call it good? (double check to make sure
5337 # we're not still setting otaker here)
5339 #only going to get worse with new location stuff...
5341 sub _upgrade_data { #class method
5342 my ($class, %opts) = @_;
5344 my @statements = ();
5346 #this seems to be the only expensive one.. why does it take so long?
5347 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5349 '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';
5350 FS::upgrade_journal->set_done('cust_main__signupdate');
5354 foreach my $sql ( @statements ) {
5355 my $sth = dbh->prepare($sql) or die dbh->errstr;
5356 $sth->execute or die $sth->errstr;
5357 #warn ( (time - $t). " seconds\n" );
5361 local($ignore_expired_card) = 1;
5362 local($ignore_banned_card) = 1;
5363 local($skip_fuzzyfiles) = 1;
5364 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5366 FS::cust_main::Location->_upgrade_data(%opts);
5368 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5370 foreach my $cust_main ( qsearch({
5371 'table' => 'cust_main',
5373 'extra_sql' => 'WHERE '.
5375 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5376 qw( first last company )
5379 my $error = $cust_main->replace;
5380 die $error if $error;
5383 FS::upgrade_journal->set_done('cust_main__trimspaces');
5387 $class->_upgrade_otaker(%opts);
5389 # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
5390 # existing records will be encrypted in queueable_upgrade (below)
5391 unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
5392 eval "use FS::Setup";
5394 FS::Setup::enable_encryption();
5399 sub queueable_upgrade {
5402 ### encryption gets turned on in _upgrade_data, above
5404 eval "use FS::upgrade_journal";
5407 # prior to 2013 (commit f16665c9) payinfo was stored in history if not
5408 # encrypted, clear that out before encrypting/tokenizing anything else
5409 if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
5410 foreach my $table (qw(
5411 cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
5414 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
5415 my $sth = dbh->prepare($sql) or die dbh->errstr;
5416 $sth->execute or die $sth->errstr;
5418 FS::upgrade_journal->set_done('clear_payinfo_history');
5421 # fix Tokenized paycardtype and encrypt old records
5422 if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
5423 || ! FS::upgrade_journal->is_done('encryption_check')
5427 # allow replacement of closed cust_pay/cust_refund records
5428 local $FS::payinfo_Mixin::allow_closed_replace = 1;
5430 # because it looks like nothing's changing
5431 local $FS::Record::no_update_diff = 1;
5433 # commit everything immediately
5434 local $FS::UID::AutoCommit = 1;
5436 # encrypt what's there
5437 foreach my $table (qw(
5438 cust_payby cust_pay_pending cust_pay cust_pay_void cust_refund
5440 my $tclass = 'FS::'.$table;
5444 my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)
5446 my $record = $tclass->by_key($recnum);
5447 next unless $record; # small chance it's been deleted, that's ok
5448 next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
5449 # window for possible conflict is practically nonexistant,
5450 # but just in case...
5451 $record = $record->select_for_update;
5452 if (!$record->custnum && $table eq 'cust_pay_pending') {
5453 $record->set('custnum_pending',1);
5455 $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
5457 local($ignore_expired_card) = 1;
5458 local($ignore_banned_card) = 1;
5459 local($skip_fuzzyfiles) = 1;
5460 local($import) = 1;#prevent automatic geocoding (need its own variable?)
5462 my $error = $record->replace;
5463 die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
5467 FS::upgrade_journal->set_done('paycardtype_Tokenized');
5468 FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
5471 # now that everything's encrypted, tokenize...
5472 FS::cust_main::Billing_Realtime::token_check(@_);
5475 # not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
5476 # cust_payby might get deleted while this runs
5478 sub _upgrade_next_recnum {
5479 my ($dbh,$table,$lastrecnum,$recnums) = @_;
5480 my $recnum = shift @$recnums;
5481 return $recnum if $recnum;
5482 my $tclass = 'FS::'.$table;
5483 my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : '';
5484 my $sql = 'SELECT '.$tclass->primary_key.
5486 ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
5487 " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
5488 " AND ( length(payinfo) < 80$paycardtypecheck ) ".
5489 ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
5490 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
5491 $sth->execute() or die $sth->errstr;
5493 while (my $rec = $sth->fetchrow_hashref) {
5494 push @$recnums, $rec->{$tclass->primary_key};
5497 $$lastrecnum = $$recnums[-1];
5498 return shift @$recnums;
5507 The delete method should possibly take an FS::cust_main object reference
5508 instead of a scalar customer number.
5510 Bill and collect options should probably be passed as references instead of a
5513 There should probably be a configuration file with a list of allowed credit
5516 No multiple currency support (probably a larger project than just this module).
5518 Birthdates rely on negative epoch values.
5520 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5524 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5525 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5526 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.