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::payinfo_Mixin FS::cust_main_Mixin
15 FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
24 use Scalar::Util qw( blessed );
25 use List::Util qw(min);
27 use File::Temp; #qw( tempfile );
29 use Time::Local qw(timelocal);
33 use Business::CreditCard 0.28;
34 use FS::UID qw( dbh driver_name );
35 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
37 use FS::Misc qw( generate_ps do_print money_pretty card_types );
38 use FS::Msgcat qw(gettext);
45 use FS::cust_bill_void;
46 use FS::legacy_cust_bill;
48 use FS::cust_pay_pending;
49 use FS::cust_pay_void;
50 use FS::cust_pay_batch;
53 use FS::part_referral;
54 use FS::cust_main_county;
55 use FS::cust_location;
58 use FS::cust_main_exemption;
59 use FS::cust_tax_adjustment;
60 use FS::cust_tax_location;
61 use FS::agent_currency;
62 use FS::cust_main_invoice;
64 use FS::prepay_credit;
70 use FS::payment_gateway;
71 use FS::agent_payment_gateway;
73 use FS::cust_main_note;
74 use FS::cust_attachment;
77 use FS::upgrade_journal;
82 use FS::Misc::Savepoint;
84 # 1 is mostly method/subroutine entry and options
85 # 2 traces progress of some operations
86 # 3 is even more information including possibly sensitive data
88 our $me = '[FS::cust_main]';
91 our $ignore_expired_card = 0;
92 our $ignore_banned_card = 0;
93 our $ignore_invalid_card = 0;
95 our $skip_fuzzyfiles = 0;
97 our $ucfirst_nowarn = 0;
99 #this info is in cust_payby as of 4.x
100 #this and the fields themselves can be removed in 5.x
101 our @encrypted_fields = ('payinfo', 'paycvv');
102 sub nohistory_fields { ('payinfo', 'paycvv'); }
105 our $default_agent_custid;
106 our $custnum_display_length;
107 #ask FS::UID to run this stuff for us later
108 #$FS::UID::callback{'FS::cust_main'} = sub {
109 install_callback FS::UID sub {
110 $conf = new FS::Conf;
111 $ignore_invalid_card = $conf->exists('allow_invalid_cards');
112 $default_agent_custid = $conf->exists('cust_main-default_agent_custid');
113 $custnum_display_length = $conf->config('cust_main-custnum-display_length');
118 my ( $hashref, $cache ) = @_;
119 if ( exists $hashref->{'pkgnum'} ) {
120 #@{ $self->{'_pkgnum'} } = ();
121 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
122 $self->{'_pkgnum'} = $subcache;
123 #push @{ $self->{'_pkgnum'} },
124 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
130 FS::cust_main - Object methods for cust_main records
136 $record = new FS::cust_main \%hash;
137 $record = new FS::cust_main { 'column' => 'value' };
139 $error = $record->insert;
141 $error = $new_record->replace($old_record);
143 $error = $record->delete;
145 $error = $record->check;
147 @cust_pkg = $record->all_pkgs;
149 @cust_pkg = $record->ncancelled_pkgs;
151 @cust_pkg = $record->suspended_pkgs;
153 $error = $record->bill;
154 $error = $record->bill %options;
155 $error = $record->bill 'time' => $time;
157 $error = $record->collect;
158 $error = $record->collect %options;
159 $error = $record->collect 'invoice_time' => $time,
164 An FS::cust_main object represents a customer. FS::cust_main inherits from
165 FS::Record. The following fields are currently supported:
171 Primary key (assigned automatically for new customers)
175 Agent (see L<FS::agent>)
179 Advertising source (see L<FS::part_referral>)
191 Cocial security number (optional)
215 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
219 Payment Information (See L<FS::payinfo_Mixin> for data format)
223 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
227 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
231 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
235 Start date month (maestro/solo cards only)
239 Start date year (maestro/solo cards only)
243 Issue number (maestro/solo cards only)
247 Name on card or billing name
251 IP address from which payment information was received
255 Tax exempt, empty or `Y'
259 Order taker (see L<FS::access_user>)
265 =item referral_custnum
267 Referring customer number
271 Enable individual CDR spooling, empty or `Y'
275 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
279 Discourage individual CDR printing, empty or `Y'
283 Allow self-service editing of ticket subjects, empty or 'Y'
285 =item calling_list_exempt
287 Do not call, empty or 'Y'
289 =item invoice_ship_address
291 Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
301 Creates a new customer. To add the customer to the database, see L<"insert">.
303 Note that this stores the hash reference, not a distinct copy of the hash it
304 points to. You can ask the object for a copy with the I<hash> method.
308 sub table { 'cust_main'; }
310 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
312 Adds this customer to the database. If there is an error, returns the error,
313 otherwise returns false.
315 Usually the customer's location will not yet exist in the database, and
316 the C<bill_location> and C<ship_location> pseudo-fields must be set to
317 uninserted L<FS::cust_location> objects. These will be inserted and linked
318 (in both directions) to the new customer record. If they're references
319 to the same object, they will become the same location.
321 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
322 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
323 are inserted atomicly, or the transaction is rolled back. Passing an empty
324 hash reference is equivalent to not supplying this parameter. There should be
325 a better explanation of this, but until then, here's an example:
328 tie %hash, 'Tie::RefHash'; #this part is important
330 $cust_pkg => [ $svc_acct ],
333 $cust_main->insert( \%hash );
335 INVOICING_LIST_ARYREF: No longer supported.
337 Currently available options are: I<depend_jobnum>, I<noexport>,
338 I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
340 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
341 on the supplied jobnum (they will not run until the specific job completes).
342 This can be used to defer provisioning until some action completes (such
343 as running the customer's credit card successfully).
345 The I<noexport> option is deprecated. If I<noexport> is set true, no
346 provisioning jobs (exports) are scheduled. (You can schedule them later with
347 the B<reexport> method.)
349 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
350 of tax names and exemption numbers. FS::cust_main_exemption records will be
351 created and inserted.
353 If I<prospectnum> is set, moves contacts and locations from that prospect.
355 If I<contact> is set to an arrayref of FS::contact objects, those will be
358 If I<contact_params> is set to a hashref of CGI parameters (and I<contact> is
359 unset), inserts those new contacts with this new customer. Handles CGI
360 paramaters for an "m2" multiple entry field as passed by edit/cust_main.cgi
362 If I<cust_payby_params> is set to a hashref o fCGI parameters, inserts those
363 new stored payment records with this new customer. Handles CGI parameters
364 for an "m2" multiple entry field as passed by edit/cust_main.cgi
370 my $cust_pkgs = @_ ? shift : {};
372 if ( $_[0] and ref($_[0]) eq 'ARRAY' ) {
373 warn "cust_main::insert using deprecated invoicing list argument";
374 $invoicing_list = shift;
377 warn "$me insert called with options ".
378 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
381 return "You are not permitted to change customer invoicing terms."
382 if $self->invoice_terms #i.e. not the default
383 && ! $FS::CurrentUser::CurrentUser->access_right('Edit customer invoice terms');
385 local $SIG{HUP} = 'IGNORE';
386 local $SIG{INT} = 'IGNORE';
387 local $SIG{QUIT} = 'IGNORE';
388 local $SIG{TERM} = 'IGNORE';
389 local $SIG{TSTP} = 'IGNORE';
390 local $SIG{PIPE} = 'IGNORE';
392 my $oldAutoCommit = $FS::UID::AutoCommit;
393 local $FS::UID::AutoCommit = 0;
396 my $prepay_identifier = '';
397 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
399 if ( $self->payby eq 'PREPAY' ) {
401 $self->payby(''); #'BILL');
402 $prepay_identifier = $self->payinfo;
405 warn " looking up prepaid card $prepay_identifier\n"
408 my $error = $self->get_prepay( $prepay_identifier,
409 'amount_ref' => \$amount,
410 'seconds_ref' => \$seconds,
411 'upbytes_ref' => \$upbytes,
412 'downbytes_ref' => \$downbytes,
413 'totalbytes_ref' => \$totalbytes,
416 $dbh->rollback if $oldAutoCommit;
417 #return "error applying prepaid card (transaction rolled back): $error";
421 $payby = 'PREP' if $amount;
423 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
426 $self->payby(''); #'BILL');
427 $amount = $self->paid;
432 foreach my $l (qw(bill_location ship_location)) {
434 my $loc = delete $self->hashref->{$l} or next;
436 if ( !$loc->locationnum ) {
437 # warn the location that we're going to insert it with no custnum
438 $loc->set(custnum_pending => 1);
439 warn " inserting $l\n"
441 my $error = $loc->insert;
443 $dbh->rollback if $oldAutoCommit;
444 my $label = $l eq 'ship_location' ? 'service' : 'billing';
445 return "$error (in $label location)";
448 } elsif ( $loc->prospectnum ) {
450 $loc->prospectnum('');
451 $loc->set(custnum_pending => 1);
452 my $error = $loc->replace;
454 $dbh->rollback if $oldAutoCommit;
455 my $label = $l eq 'ship_location' ? 'service' : 'billing';
456 return "$error (moving $label location)";
459 } elsif ( ($loc->custnum || 0) > 0 ) {
460 # then it somehow belongs to another customer--shouldn't happen
461 $dbh->rollback if $oldAutoCommit;
462 return "$l belongs to customer ".$loc->custnum;
464 # else it already belongs to this customer
465 # (happens when ship_location is identical to bill_location)
467 $self->set($l.'num', $loc->locationnum);
469 if ( $self->get($l.'num') eq '' ) {
470 $dbh->rollback if $oldAutoCommit;
475 warn " inserting $self\n"
478 $self->signupdate(time) unless $self->signupdate;
480 $self->auto_agent_custid()
481 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
483 my $error = $self->check_payinfo_cardtype
484 || $self->SUPER::insert;
486 $dbh->rollback if $oldAutoCommit;
487 #return "inserting cust_main record (transaction rolled back): $error";
491 # now set cust_location.custnum
492 foreach my $l (qw(bill_location ship_location)) {
493 warn " setting $l.custnum\n"
495 my $loc = $self->$l or next;
496 unless ( $loc->custnum ) {
497 $loc->set(custnum => $self->custnum);
498 $error ||= $loc->replace;
502 $dbh->rollback if $oldAutoCommit;
503 return "error setting $l custnum: $error";
507 warn " setting customer tags\n"
510 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
511 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
512 'custnum' => $self->custnum };
513 my $error = $cust_tag->insert;
515 $dbh->rollback if $oldAutoCommit;
520 my $prospectnum = delete $options{'prospectnum'};
521 if ( $prospectnum ) {
523 warn " moving contacts and locations from prospect $prospectnum\n"
527 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
528 unless ( $prospect_main ) {
529 $dbh->rollback if $oldAutoCommit;
530 return "Unknown prospectnum $prospectnum";
532 $prospect_main->custnum($self->custnum);
533 $prospect_main->disabled('Y');
534 my $error = $prospect_main->replace;
536 $dbh->rollback if $oldAutoCommit;
540 foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
541 my $cust_contact = new FS::cust_contact {
542 'custnum' => $self->custnum,
543 'invoice_dest' => 'Y', # invoice_dest currently not set for prospect contacts
544 map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
546 my $error = $cust_contact->insert
547 || $prospect_contact->delete;
549 $dbh->rollback if $oldAutoCommit;
554 my @cust_location = $prospect_main->cust_location;
555 my @qual = $prospect_main->qual;
557 foreach my $r ( @cust_location, @qual ) {
559 $r->custnum($self->custnum);
560 my $error = $r->replace;
562 $dbh->rollback if $oldAutoCommit;
566 # since we set invoice_dest on all migrated prospect contacts (for now),
567 # don't process invoicing_list.
568 delete $options{'invoicing_list'};
569 $invoicing_list = undef;
572 warn " setting contacts\n"
575 $invoicing_list ||= $options{'invoicing_list'};
576 if ( $invoicing_list ) {
578 $invoicing_list = [ $invoicing_list ] if !ref($invoicing_list);
581 foreach my $dest (@$invoicing_list ) {
582 if ($dest eq 'POST') {
583 $self->set('postal_invoice', 'Y');
586 my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
587 if ( $contact_email ) {
588 my $cust_contact = FS::cust_contact->new({
589 contactnum => $contact_email->contactnum,
590 custnum => $self->custnum,
592 $cust_contact->set('invoice_dest', 'Y');
593 my $error = $cust_contact->insert;
595 $dbh->rollback if $oldAutoCommit;
596 return "$error (linking to email address $dest)";
600 # this email address is not yet linked to any contact
601 $email .= ',' if length($email);
609 my $contact = FS::contact->new({
610 'custnum' => $self->get('custnum'),
611 'last' => $self->get('last'),
612 'first' => $self->get('first'),
613 'emailaddress' => $email,
614 'invoice_dest' => 'Y', # yes, you can set this via the contact
616 my $error = $contact->insert;
618 $dbh->rollback if $oldAutoCommit;
626 if ( my $contact = delete $options{'contact'} ) {
628 foreach my $c ( @$contact ) {
629 $c->custnum($self->custnum);
630 my $error = $c->insert;
632 $dbh->rollback if $oldAutoCommit;
638 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
640 my $error = $self->process_o2m( 'table' => 'contact',
641 'fields' => FS::contact->cgi_contact_fields,
642 'params' => $contact_params,
645 $dbh->rollback if $oldAutoCommit;
650 warn " setting cust_payby\n"
653 if ( $options{cust_payby} ) {
655 foreach my $cust_payby ( @{ $options{cust_payby} } ) {
656 $cust_payby->custnum($self->custnum);
657 my $error = $cust_payby->insert;
659 $dbh->rollback if $oldAutoCommit;
664 } elsif ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
666 my $error = $self->process_o2m(
667 'table' => 'cust_payby',
668 'fields' => FS::cust_payby->cgi_cust_payby_fields,
669 'params' => $cust_payby_params,
670 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
673 $dbh->rollback if $oldAutoCommit;
679 warn " setting cust_main_exemption\n"
682 my $tax_exemption = delete $options{'tax_exemption'};
683 if ( $tax_exemption ) {
685 $tax_exemption = { map { $_ => '' } @$tax_exemption }
686 if ref($tax_exemption) eq 'ARRAY';
688 foreach my $taxname ( keys %$tax_exemption ) {
689 my $cust_main_exemption = new FS::cust_main_exemption {
690 'custnum' => $self->custnum,
691 'taxname' => $taxname,
692 'exempt_number' => $tax_exemption->{$taxname},
694 my $error = $cust_main_exemption->insert;
696 $dbh->rollback if $oldAutoCommit;
697 return "inserting cust_main_exemption (transaction rolled back): $error";
702 warn " ordering packages\n"
705 $error = $self->order_pkgs( $cust_pkgs,
707 'seconds_ref' => \$seconds,
708 'upbytes_ref' => \$upbytes,
709 'downbytes_ref' => \$downbytes,
710 'totalbytes_ref' => \$totalbytes,
713 $dbh->rollback if $oldAutoCommit;
718 $dbh->rollback if $oldAutoCommit;
719 return "No svc_acct record to apply pre-paid time";
721 if ( $upbytes || $downbytes || $totalbytes ) {
722 $dbh->rollback if $oldAutoCommit;
723 return "No svc_acct record to apply pre-paid data";
727 warn " inserting initial $payby payment of $amount\n"
729 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
731 $dbh->rollback if $oldAutoCommit;
732 return "inserting payment (transaction rolled back): $error";
736 unless ( $import || $skip_fuzzyfiles ) {
737 warn " queueing fuzzyfiles update\n"
739 $error = $self->queue_fuzzyfiles_update;
741 $dbh->rollback if $oldAutoCommit;
742 return "updating fuzzy search cache: $error";
746 # FS::geocode_Mixin::after_insert or something?
747 if ( $conf->config('tax_district_method') and !$import ) {
748 # if anything non-empty, try to look it up
749 my $queue = new FS::queue {
750 'job' => 'FS::geocode_Mixin::process_district_update',
751 'custnum' => $self->custnum,
753 my $error = $queue->insert( ref($self), $self->custnum );
755 $dbh->rollback if $oldAutoCommit;
756 return "queueing tax district update: $error";
761 warn " exporting\n" if $DEBUG > 1;
763 my $export_args = $options{'export_args'} || [];
766 map qsearch( 'part_export', {exportnum=>$_} ),
767 $conf->config('cust_main-exports'); #, $agentnum
769 foreach my $part_export ( @part_export ) {
770 my $error = $part_export->export_insert($self, @$export_args);
772 $dbh->rollback if $oldAutoCommit;
773 return "exporting to ". $part_export->exporttype.
774 " (transaction rolled back): $error";
778 #foreach my $depend_jobnum ( @$depend_jobnums ) {
779 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
781 # foreach my $jobnum ( @jobnums ) {
782 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
783 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
785 # my $error = $queue->depend_insert($depend_jobnum);
787 # $dbh->rollback if $oldAutoCommit;
788 # return "error queuing job dependancy: $error";
795 #if ( exists $options{'jobnums'} ) {
796 # push @{ $options{'jobnums'} }, @jobnums;
799 warn " insert complete; committing transaction\n"
802 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
807 use File::CounterFile;
808 sub auto_agent_custid {
811 my $format = $conf->config('cust_main-auto_agent_custid');
813 if ( $format eq '1YMMXXXXXXXX' ) {
815 my $counter = new File::CounterFile 'cust_main.agent_custid';
818 my $ym = 100000000000 + time2str('%y%m00000000', time);
819 if ( $ym > $counter->value ) {
820 $counter->{'value'} = $agent_custid = $ym;
821 $counter->{'updated'} = 1;
823 $agent_custid = $counter->inc;
829 die "Unknown cust_main-auto_agent_custid format: $format";
832 $self->agent_custid($agent_custid);
836 =item PACKAGE METHODS
838 Documentation on customer package methods has been moved to
839 L<FS::cust_main::Packages>.
841 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
843 Recharges this (existing) customer with the specified prepaid card (see
844 L<FS::prepay_credit>), specified either by I<identifier> or as an
845 FS::prepay_credit object. If there is an error, returns the error, otherwise
848 Optionally, five scalar references can be passed as well. They will have their
849 values filled in with the amount, number of seconds, and number of upload,
850 download, and total bytes applied by this prepaid card.
854 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
855 #the only place that uses these args
856 sub recharge_prepay {
857 my( $self, $prepay_credit, $amountref, $secondsref,
858 $upbytesref, $downbytesref, $totalbytesref ) = @_;
860 local $SIG{HUP} = 'IGNORE';
861 local $SIG{INT} = 'IGNORE';
862 local $SIG{QUIT} = 'IGNORE';
863 local $SIG{TERM} = 'IGNORE';
864 local $SIG{TSTP} = 'IGNORE';
865 local $SIG{PIPE} = 'IGNORE';
867 my $oldAutoCommit = $FS::UID::AutoCommit;
868 local $FS::UID::AutoCommit = 0;
871 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
873 my $error = $self->get_prepay( $prepay_credit,
874 'amount_ref' => \$amount,
875 'seconds_ref' => \$seconds,
876 'upbytes_ref' => \$upbytes,
877 'downbytes_ref' => \$downbytes,
878 'totalbytes_ref' => \$totalbytes,
880 || $self->increment_seconds($seconds)
881 || $self->increment_upbytes($upbytes)
882 || $self->increment_downbytes($downbytes)
883 || $self->increment_totalbytes($totalbytes)
884 || $self->insert_cust_pay_prepay( $amount,
886 ? $prepay_credit->identifier
891 $dbh->rollback if $oldAutoCommit;
895 if ( defined($amountref) ) { $$amountref = $amount; }
896 if ( defined($secondsref) ) { $$secondsref = $seconds; }
897 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
898 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
899 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
901 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
906 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
908 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
909 specified either by I<identifier> or as an FS::prepay_credit object.
911 Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>. The scalars (provided by references) will be
912 incremented by the values of the prepaid card.
914 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
915 check or set this customer's I<agentnum>.
917 If there is an error, returns the error, otherwise returns false.
923 my( $self, $prepay_credit, %opt ) = @_;
925 local $SIG{HUP} = 'IGNORE';
926 local $SIG{INT} = 'IGNORE';
927 local $SIG{QUIT} = 'IGNORE';
928 local $SIG{TERM} = 'IGNORE';
929 local $SIG{TSTP} = 'IGNORE';
930 local $SIG{PIPE} = 'IGNORE';
932 my $oldAutoCommit = $FS::UID::AutoCommit;
933 local $FS::UID::AutoCommit = 0;
936 unless ( ref($prepay_credit) ) {
938 my $identifier = $prepay_credit;
940 $prepay_credit = qsearchs(
942 { 'identifier' => $identifier },
947 unless ( $prepay_credit ) {
948 $dbh->rollback if $oldAutoCommit;
949 return "Invalid prepaid card: ". $identifier;
954 if ( $prepay_credit->agentnum ) {
955 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
956 $dbh->rollback if $oldAutoCommit;
957 return "prepaid card not valid for agent ". $self->agentnum;
959 $self->agentnum($prepay_credit->agentnum);
962 my $error = $prepay_credit->delete;
964 $dbh->rollback if $oldAutoCommit;
965 return "removing prepay_credit (transaction rolled back): $error";
968 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
969 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
971 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
976 =item increment_upbytes SECONDS
978 Updates this customer's single or primary account (see L<FS::svc_acct>) by
979 the specified number of upbytes. If there is an error, returns the error,
980 otherwise returns false.
984 sub increment_upbytes {
985 _increment_column( shift, 'upbytes', @_);
988 =item increment_downbytes SECONDS
990 Updates this customer's single or primary account (see L<FS::svc_acct>) by
991 the specified number of downbytes. If there is an error, returns the error,
992 otherwise returns false.
996 sub increment_downbytes {
997 _increment_column( shift, 'downbytes', @_);
1000 =item increment_totalbytes SECONDS
1002 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1003 the specified number of totalbytes. If there is an error, returns the error,
1004 otherwise returns false.
1008 sub increment_totalbytes {
1009 _increment_column( shift, 'totalbytes', @_);
1012 =item increment_seconds SECONDS
1014 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1015 the specified number of seconds. If there is an error, returns the error,
1016 otherwise returns false.
1020 sub increment_seconds {
1021 _increment_column( shift, 'seconds', @_);
1024 =item _increment_column AMOUNT
1026 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1027 the specified number of seconds or bytes. If there is an error, returns
1028 the error, otherwise returns false.
1032 sub _increment_column {
1033 my( $self, $column, $amount ) = @_;
1034 warn "$me increment_column called: $column, $amount\n"
1037 return '' unless $amount;
1039 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1040 $self->ncancelled_pkgs;
1042 if ( ! @cust_pkg ) {
1043 return 'No packages with primary or single services found'.
1044 ' to apply pre-paid time';
1045 } elsif ( scalar(@cust_pkg) > 1 ) {
1046 #maybe have a way to specify the package/account?
1047 return 'Multiple packages found to apply pre-paid time';
1050 my $cust_pkg = $cust_pkg[0];
1051 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1055 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1057 if ( ! @cust_svc ) {
1058 return 'No account found to apply pre-paid time';
1059 } elsif ( scalar(@cust_svc) > 1 ) {
1060 return 'Multiple accounts found to apply pre-paid time';
1063 my $svc_acct = $cust_svc[0]->svc_x;
1064 warn " found service svcnum ". $svc_acct->pkgnum.
1065 ' ('. $svc_acct->email. ")\n"
1068 $column = "increment_$column";
1069 $svc_acct->$column($amount);
1073 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1075 Inserts a prepayment in the specified amount for this customer. An optional
1076 second argument can specify the prepayment identifier for tracking purposes.
1077 If there is an error, returns the error, otherwise returns false.
1081 sub insert_cust_pay_prepay {
1082 shift->insert_cust_pay('PREP', @_);
1085 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1087 Inserts a cash payment in the specified amount for this customer. An optional
1088 second argument can specify the payment identifier for tracking purposes.
1089 If there is an error, returns the error, otherwise returns false.
1093 sub insert_cust_pay_cash {
1094 shift->insert_cust_pay('CASH', @_);
1097 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1099 Inserts a Western Union payment in the specified amount for this customer. An
1100 optional second argument can specify the prepayment identifier for tracking
1101 purposes. If there is an error, returns the error, otherwise returns false.
1105 sub insert_cust_pay_west {
1106 shift->insert_cust_pay('WEST', @_);
1109 sub insert_cust_pay {
1110 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1111 my $payinfo = scalar(@_) ? shift : '';
1113 my $cust_pay = new FS::cust_pay {
1114 'custnum' => $self->custnum,
1115 'paid' => sprintf('%.2f', $amount),
1116 #'_date' => #date the prepaid card was purchased???
1118 'payinfo' => $payinfo,
1124 =item delete [ OPTION => VALUE ... ]
1126 This deletes the customer. If there is an error, returns the error, otherwise
1129 This will completely remove all traces of the customer record. This is not
1130 what you want when a customer cancels service; for that, cancel all of the
1131 customer's packages (see L</cancel>).
1133 If the customer has any uncancelled packages, you need to pass a new (valid)
1134 customer number for those packages to be transferred to, as the "new_customer"
1135 option. Cancelled packages will be deleted. Did I mention that this is NOT
1136 what you want when a customer cancels service and that you really should be
1137 looking at L<FS::cust_pkg/cancel>?
1139 You can't delete a customer with invoices (see L<FS::cust_bill>),
1140 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1141 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1142 set the "delete_financials" option to a true value.
1147 my( $self, %opt ) = @_;
1149 local $SIG{HUP} = 'IGNORE';
1150 local $SIG{INT} = 'IGNORE';
1151 local $SIG{QUIT} = 'IGNORE';
1152 local $SIG{TERM} = 'IGNORE';
1153 local $SIG{TSTP} = 'IGNORE';
1154 local $SIG{PIPE} = 'IGNORE';
1156 my $oldAutoCommit = $FS::UID::AutoCommit;
1157 local $FS::UID::AutoCommit = 0;
1160 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1161 $dbh->rollback if $oldAutoCommit;
1162 return "Can't delete a master agent customer";
1165 #use FS::access_user
1166 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1167 $dbh->rollback if $oldAutoCommit;
1168 return "Can't delete a master employee customer";
1171 tie my %financial_tables, 'Tie::IxHash',
1172 'cust_bill' => 'invoices',
1173 'cust_statement' => 'statements',
1174 'cust_credit' => 'credits',
1175 'cust_pay' => 'payments',
1176 'cust_refund' => 'refunds',
1179 foreach my $table ( keys %financial_tables ) {
1181 my @records = $self->$table();
1183 if ( @records && ! $opt{'delete_financials'} ) {
1184 $dbh->rollback if $oldAutoCommit;
1185 return "Can't delete a customer with ". $financial_tables{$table};
1188 foreach my $record ( @records ) {
1189 my $error = $record->delete;
1191 $dbh->rollback if $oldAutoCommit;
1192 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1198 my @cust_pkg = $self->ncancelled_pkgs;
1200 my $new_custnum = $opt{'new_custnum'};
1201 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1202 $dbh->rollback if $oldAutoCommit;
1203 return "Invalid new customer number: $new_custnum";
1205 foreach my $cust_pkg ( @cust_pkg ) {
1206 my %hash = $cust_pkg->hash;
1207 $hash{'custnum'} = $new_custnum;
1208 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1209 my $error = $new_cust_pkg->replace($cust_pkg,
1210 options => { $cust_pkg->options },
1213 $dbh->rollback if $oldAutoCommit;
1218 my @cancelled_cust_pkg = $self->all_pkgs;
1219 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1220 my $error = $cust_pkg->delete;
1222 $dbh->rollback if $oldAutoCommit;
1227 #cust_tax_adjustment in financials?
1228 #cust_pay_pending? ouch
1229 foreach my $table (qw(
1230 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1231 cust_payby cust_location cust_main_note cust_tax_adjustment
1232 cust_pay_void cust_pay_batch queue cust_tax_exempt
1234 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1235 my $error = $record->delete;
1237 $dbh->rollback if $oldAutoCommit;
1243 my $sth = $dbh->prepare(
1244 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1246 my $errstr = $dbh->errstr;
1247 $dbh->rollback if $oldAutoCommit;
1250 $sth->execute($self->custnum) or do {
1251 my $errstr = $sth->errstr;
1252 $dbh->rollback if $oldAutoCommit;
1258 my $ticket_dbh = '';
1259 if ($conf->config('ticket_system') eq 'RT_Internal') {
1261 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1262 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1263 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1264 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1267 if ( $ticket_dbh ) {
1269 my $ticket_sth = $ticket_dbh->prepare(
1270 'DELETE FROM Links WHERE Target = ?'
1272 my $errstr = $ticket_dbh->errstr;
1273 $dbh->rollback if $oldAutoCommit;
1276 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1278 my $errstr = $ticket_sth->errstr;
1279 $dbh->rollback if $oldAutoCommit;
1283 #check and see if the customer is the only link on the ticket, and
1284 #if so, set the ticket to deleted status in RT?
1285 #maybe someday, for now this will at least fix tickets not displaying
1289 #delete the customer record
1291 my $error = $self->SUPER::delete;
1293 $dbh->rollback if $oldAutoCommit;
1297 # cust_main exports!
1299 #my $export_args = $options{'export_args'} || [];
1302 map qsearch( 'part_export', {exportnum=>$_} ),
1303 $conf->config('cust_main-exports'); #, $agentnum
1305 foreach my $part_export ( @part_export ) {
1306 my $error = $part_export->export_delete( $self ); #, @$export_args);
1308 $dbh->rollback if $oldAutoCommit;
1309 return "exporting to ". $part_export->exporttype.
1310 " (transaction rolled back): $error";
1314 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1319 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1321 Replaces the OLD_RECORD with this one in the database. If there is an error,
1322 returns the error, otherwise returns false.
1324 To change the customer's address, set the pseudo-fields C<bill_location> and
1325 C<ship_location>. The address will still only change if at least one of the
1326 address fields differs from the existing values.
1328 INVOICING_LIST_ARYREF: If you pass an arrayref to this method, it will be
1329 set as the contact email address for a default contact with the same name as
1332 Currently available options are: I<tax_exemption>, I<cust_payby_params>,
1333 I<contact_params>, I<invoicing_list>.
1335 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1336 of tax names and exemption numbers. FS::cust_main_exemption records will be
1337 deleted and inserted as appropriate.
1339 I<cust_payby_params> and I<contact_params> can be hashrefs of named parameter
1340 groups (describing the customer's payment methods and contacts, respectively)
1341 in the style supported by L<FS::o2m_Common/process_o2m>. See L<FS::cust_payby>
1342 and L<FS::contact> for the fields these can contain.
1344 I<invoicing_list> is a synonym for the INVOICING_LIST_ARYREF parameter, and
1345 should be used instead if possible.
1352 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1354 : $self->replace_old;
1358 warn "$me replace called\n"
1361 my $curuser = $FS::CurrentUser::CurrentUser;
1362 return "You are not permitted to create complimentary accounts."
1363 if $self->complimentary eq 'Y'
1364 && $self->complimentary ne $old->complimentary
1365 && ! $curuser->access_right('Complimentary customer');
1367 local($ignore_expired_card) = 1
1368 if $old->payby =~ /^(CARD|DCRD)$/
1369 && $self->payby =~ /^(CARD|DCRD)$/
1370 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1372 local($ignore_banned_card) = 1
1373 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1374 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1375 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1377 if ( $self->payby =~ /^(CARD|DCRD)$/
1378 && $old->payinfo ne $self->payinfo
1379 && $old->paymask ne $self->paymask )
1381 my $error = $self->check_payinfo_cardtype;
1382 return $error if $error;
1385 return "Invoicing locale is required"
1388 && $conf->exists('cust_main-require_locale');
1390 return "You are not permitted to change customer invoicing terms."
1391 if $old->invoice_terms ne $self->invoice_terms
1392 && ! $curuser->access_right('Edit customer invoice terms');
1394 local $SIG{HUP} = 'IGNORE';
1395 local $SIG{INT} = 'IGNORE';
1396 local $SIG{QUIT} = 'IGNORE';
1397 local $SIG{TERM} = 'IGNORE';
1398 local $SIG{TSTP} = 'IGNORE';
1399 local $SIG{PIPE} = 'IGNORE';
1401 my $oldAutoCommit = $FS::UID::AutoCommit;
1402 local $FS::UID::AutoCommit = 0;
1405 for my $l (qw(bill_location ship_location)) {
1406 #my $old_loc = $old->$l;
1407 my $new_loc = $self->$l or next;
1409 # find the existing location if there is one
1410 $new_loc->set('custnum' => $self->custnum);
1411 my $error = $new_loc->find_or_insert;
1413 $dbh->rollback if $oldAutoCommit;
1416 $self->set($l.'num', $new_loc->locationnum);
1420 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1421 warn "cust_main::replace: using deprecated invoicing list argument";
1422 $invoicing_list = shift @param;
1425 my %options = @param;
1427 $invoicing_list ||= $options{invoicing_list};
1429 my @contacts = map { $_->contact } $self->cust_contact;
1430 # find a contact that matches the customer's name
1431 my ($implicit_contact) = grep { $_->first eq $old->get('first')
1432 and $_->last eq $old->get('last') }
1434 $implicit_contact ||= FS::contact->new({
1435 'custnum' => $self->custnum,
1436 'locationnum' => $self->get('bill_locationnum'),
1439 # for any of these that are already contact emails, link to the existing
1441 if ( $invoicing_list ) {
1444 # kind of like process_m2m on these, except:
1445 # - the other side is two tables in a join
1446 # - and we might have to create new contact_emails
1447 # - and possibly a new contact
1449 # Find existing invoice emails that aren't on the implicit contact.
1450 # Any of these that are not on the new invoicing list will be removed.
1451 my %old_email_cust_contact;
1452 foreach my $cust_contact ($self->cust_contact) {
1453 next if !$cust_contact->invoice_dest;
1454 next if $cust_contact->contactnum == ($implicit_contact->contactnum || 0);
1456 foreach my $contact_email ($cust_contact->contact->contact_email) {
1457 $old_email_cust_contact{ $contact_email->emailaddress } = $cust_contact;
1461 foreach my $dest (@$invoicing_list) {
1463 if ($dest eq 'POST') {
1465 $self->set('postal_invoice', 'Y');
1467 } elsif ( exists($old_email_cust_contact{$dest}) ) {
1469 delete $old_email_cust_contact{$dest}; # don't need to remove it, then
1473 # See if it belongs to some other contact; if so, link it.
1474 my $contact_email = qsearchs('contact_email', { emailaddress => $dest });
1476 and $contact_email->contactnum != ($implicit_contact->contactnum || 0) ) {
1477 my $cust_contact = qsearchs('cust_contact', {
1478 contactnum => $contact_email->contactnum,
1479 custnum => $self->custnum,
1480 }) || FS::cust_contact->new({
1481 contactnum => $contact_email->contactnum,
1482 custnum => $self->custnum,
1484 $cust_contact->set('invoice_dest', 'Y');
1485 my $error = $cust_contact->custcontactnum ?
1486 $cust_contact->replace : $cust_contact->insert;
1488 $dbh->rollback if $oldAutoCommit;
1489 return "$error (linking to email address $dest)";
1493 # This email address is not yet linked to any contact, so it will
1494 # be added to the implicit contact.
1495 $email .= ',' if length($email);
1501 foreach my $remove_dest (keys %old_email_cust_contact) {
1502 my $cust_contact = $old_email_cust_contact{$remove_dest};
1503 # These were not in the list of requested destinations, so take them off.
1504 $cust_contact->set('invoice_dest', '');
1505 my $error = $cust_contact->replace;
1507 $dbh->rollback if $oldAutoCommit;
1508 return "$error (unlinking email address $remove_dest)";
1512 # make sure it keeps up with the changed customer name, if any
1513 $implicit_contact->set('last', $self->get('last'));
1514 $implicit_contact->set('first', $self->get('first'));
1515 $implicit_contact->set('emailaddress', $email);
1516 $implicit_contact->set('invoice_dest', 'Y');
1517 $implicit_contact->set('custnum', $self->custnum);
1518 my $i_cust_contact =
1519 qsearchs('cust_contact', {
1520 contactnum => $implicit_contact->contactnum,
1521 custnum => $self->custnum,
1524 if ( $i_cust_contact ) {
1525 $implicit_contact->set($_, $i_cust_contact->$_)
1526 foreach qw( classnum selfservice_access comment );
1530 if ( $implicit_contact->contactnum ) {
1531 $error = $implicit_contact->replace;
1532 } elsif ( length($email) ) { # don't create a new contact if not needed
1533 $error = $implicit_contact->insert;
1537 $dbh->rollback if $oldAutoCommit;
1538 return "$error (adding email address $email)";
1543 # replace the customer record
1544 my $error = $self->SUPER::replace($old);
1547 $dbh->rollback if $oldAutoCommit;
1551 # now move packages to the new service location
1552 $self->set('ship_location', ''); #flush cache
1553 if ( $old->ship_locationnum and # should only be null during upgrade...
1554 $old->ship_locationnum != $self->ship_locationnum ) {
1555 $error = $old->ship_location->move_to($self->ship_location);
1557 $dbh->rollback if $oldAutoCommit;
1561 # don't move packages based on the billing location, but
1562 # disable it if it's no longer in use
1563 if ( $old->bill_locationnum and
1564 $old->bill_locationnum != $self->bill_locationnum ) {
1565 $error = $old->bill_location->disable_if_unused;
1567 $dbh->rollback if $oldAutoCommit;
1572 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1574 #this could be more efficient than deleting and re-inserting, if it matters
1575 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1576 my $error = $cust_tag->delete;
1578 $dbh->rollback if $oldAutoCommit;
1582 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1583 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1584 'custnum' => $self->custnum };
1585 my $error = $cust_tag->insert;
1587 $dbh->rollback if $oldAutoCommit;
1594 my $tax_exemption = delete $options{'tax_exemption'};
1595 if ( $tax_exemption ) {
1597 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1598 if ref($tax_exemption) eq 'ARRAY';
1600 my %cust_main_exemption =
1601 map { $_->taxname => $_ }
1602 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1604 foreach my $taxname ( keys %$tax_exemption ) {
1606 if ( $cust_main_exemption{$taxname} &&
1607 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1610 delete $cust_main_exemption{$taxname};
1614 my $cust_main_exemption = new FS::cust_main_exemption {
1615 'custnum' => $self->custnum,
1616 'taxname' => $taxname,
1617 'exempt_number' => $tax_exemption->{$taxname},
1619 my $error = $cust_main_exemption->insert;
1621 $dbh->rollback if $oldAutoCommit;
1622 return "inserting cust_main_exemption (transaction rolled back): $error";
1626 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1627 my $error = $cust_main_exemption->delete;
1629 $dbh->rollback if $oldAutoCommit;
1630 return "deleting cust_main_exemption (transaction rolled back): $error";
1636 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1638 my $error = $self->process_o2m(
1639 'table' => 'cust_payby',
1640 'fields' => FS::cust_payby->cgi_cust_payby_fields,
1641 'params' => $cust_payby_params,
1642 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1645 $dbh->rollback if $oldAutoCommit;
1651 if ( my $contact_params = delete $options{'contact_params'} ) {
1653 # this can potentially replace contacts that were created by the
1654 # invoicing list argument, but the UI shouldn't allow both of them
1657 my $error = $self->process_o2m(
1658 'table' => 'contact',
1659 'fields' => FS::contact->cgi_contact_fields,
1660 'params' => $contact_params,
1663 $dbh->rollback if $oldAutoCommit;
1669 unless ( $import || $skip_fuzzyfiles ) {
1670 $error = $self->queue_fuzzyfiles_update;
1672 $dbh->rollback if $oldAutoCommit;
1673 return "updating fuzzy search cache: $error";
1677 # tax district update in cust_location
1679 # cust_main exports!
1681 my $export_args = $options{'export_args'} || [];
1684 map qsearch( 'part_export', {exportnum=>$_} ),
1685 $conf->config('cust_main-exports'); #, $agentnum
1687 foreach my $part_export ( @part_export ) {
1688 my $error = $part_export->export_replace( $self, $old, @$export_args);
1690 $dbh->rollback if $oldAutoCommit;
1691 return "exporting to ". $part_export->exporttype.
1692 " (transaction rolled back): $error";
1696 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1701 =item queue_fuzzyfiles_update
1703 Used by insert & replace to update the fuzzy search cache
1707 use FS::cust_main::Search;
1708 sub queue_fuzzyfiles_update {
1711 local $SIG{HUP} = 'IGNORE';
1712 local $SIG{INT} = 'IGNORE';
1713 local $SIG{QUIT} = 'IGNORE';
1714 local $SIG{TERM} = 'IGNORE';
1715 local $SIG{TSTP} = 'IGNORE';
1716 local $SIG{PIPE} = 'IGNORE';
1718 my $oldAutoCommit = $FS::UID::AutoCommit;
1719 local $FS::UID::AutoCommit = 0;
1722 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1723 my $queue = new FS::queue {
1724 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1726 my @args = "cust_main.$field", $self->get($field);
1727 my $error = $queue->insert( @args );
1729 $dbh->rollback if $oldAutoCommit;
1730 return "queueing job (transaction rolled back): $error";
1735 push @locations, $self->bill_location if $self->bill_locationnum;
1736 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1737 foreach my $location (@locations) {
1738 my $queue = new FS::queue {
1739 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1741 my @args = 'cust_location.address1', $location->address1;
1742 my $error = $queue->insert( @args );
1744 $dbh->rollback if $oldAutoCommit;
1745 return "queueing job (transaction rolled back): $error";
1749 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1756 Checks all fields to make sure this is a valid customer record. If there is
1757 an error, returns the error, otherwise returns false. Called by the insert
1758 and replace methods.
1765 warn "$me check BEFORE: \n". $self->_dump
1769 $self->ut_numbern('custnum')
1770 || $self->ut_number('agentnum')
1771 || $self->ut_textn('agent_custid')
1772 || $self->ut_number('refnum')
1773 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1774 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1775 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1776 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1777 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1778 || $self->ut_textn('custbatch')
1779 || $self->ut_name('last')
1780 || $self->ut_name('first')
1781 || $self->ut_snumbern('signupdate')
1782 || $self->ut_snumbern('birthdate')
1783 || $self->ut_namen('spouse_last')
1784 || $self->ut_namen('spouse_first')
1785 || $self->ut_snumbern('spouse_birthdate')
1786 || $self->ut_snumbern('anniversary_date')
1787 || $self->ut_textn('company')
1788 || $self->ut_textn('ship_company')
1789 || $self->ut_anything('comments')
1790 || $self->ut_numbern('referral_custnum')
1791 || $self->ut_textn('stateid')
1792 || $self->ut_textn('stateid_state')
1793 || $self->ut_textn('invoice_terms')
1794 || $self->ut_floatn('cdr_termination_percentage')
1795 || $self->ut_floatn('credit_limit')
1796 || $self->ut_numbern('billday')
1797 || $self->ut_numbern('prorate_day')
1798 || $self->ut_flag('force_prorate_day')
1799 || $self->ut_flag('edit_subject')
1800 || $self->ut_flag('calling_list_exempt')
1801 || $self->ut_flag('invoice_noemail')
1802 || $self->ut_flag('message_noemail')
1803 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1804 || $self->ut_currencyn('currency')
1805 || $self->ut_textn('po_number')
1806 || $self->ut_enum('complimentary', [ '', 'Y' ])
1807 || $self->ut_flag('invoice_ship_address')
1808 || $self->ut_flag('invoice_dest')
1811 foreach (qw(company ship_company)) {
1812 my $company = $self->get($_);
1813 $company =~ s/^\s+//;
1814 $company =~ s/\s+$//;
1815 $company =~ s/\s+/ /g;
1816 $self->set($_, $company);
1819 #barf. need message catalogs. i18n. etc.
1820 $error .= "Please select an advertising source."
1821 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1822 return $error if $error;
1824 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1825 or return "Unknown agent";
1827 if ( $self->currency ) {
1828 my $agent_currency = qsearchs( 'agent_currency', {
1829 'agentnum' => $agent->agentnum,
1830 'currency' => $self->currency,
1832 or return "Agent ". $agent->agent.
1833 " not permitted to offer ". $self->currency. " invoicing";
1836 return "Unknown refnum"
1837 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1839 return "Unknown referring custnum: ". $self->referral_custnum
1840 unless ! $self->referral_custnum
1841 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1843 if ( $self->ss eq '' ) {
1848 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1849 or return "Illegal social security number: ". $self->ss;
1850 $self->ss("$1-$2-$3");
1853 #turn off invoice_ship_address if ship & bill are the same
1854 if ($self->bill_locationnum eq $self->ship_locationnum) {
1855 $self->invoice_ship_address('');
1858 # cust_main_county verification now handled by cust_location check
1861 $self->ut_phonen('daytime', $self->country)
1862 || $self->ut_phonen('night', $self->country)
1863 || $self->ut_phonen('fax', $self->country)
1864 || $self->ut_phonen('mobile', $self->country)
1866 return $error if $error;
1868 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1870 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1873 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1875 : FS::Msgcat::_gettext('daytime');
1876 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1878 : FS::Msgcat::_gettext('night');
1880 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1882 : FS::Msgcat::_gettext('mobile');
1884 return "$daytime_label, $night_label or $mobile_label is required"
1888 ### start of stuff moved to cust_payby
1889 # then mostly kept here to support upgrades (can remove in 5.x)
1890 # but modified to allow everything to be empty
1892 if ( $self->payby ) {
1893 FS::payby->can_payby($self->table, $self->payby)
1894 or return "Illegal payby: ". $self->payby;
1899 $error = $self->ut_numbern('paystart_month')
1900 || $self->ut_numbern('paystart_year')
1901 || $self->ut_numbern('payissue')
1902 || $self->ut_textn('paytype')
1904 return $error if $error;
1906 if ( $self->payip eq '' ) {
1909 $error = $self->ut_ip('payip');
1910 return $error if $error;
1913 # If it is encrypted and the private key is not availaible then we can't
1914 # check the credit card.
1915 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1917 # Need some kind of global flag to accept invalid cards, for testing
1919 if ( !$import && !$ignore_invalid_card && $check_payinfo &&
1920 $self->payby =~ /^(CARD|DCRD)$/ ) {
1922 my $payinfo = $self->payinfo;
1923 $payinfo =~ s/\D//g;
1924 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1925 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1927 $self->payinfo($payinfo);
1929 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1931 return gettext('unknown_card_type')
1932 if $self->payinfo !~ /^99\d{14}$/ #token
1933 && cardtype($self->payinfo) eq "Unknown";
1935 unless ( $ignore_banned_card ) {
1936 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1938 if ( $ban->bantype eq 'warn' ) {
1939 #or others depending on value of $ban->reason ?
1940 return '_duplicate_card'.
1941 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1942 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1943 ' (ban# '. $ban->bannum. ')'
1944 unless $self->override_ban_warn;
1946 return 'Banned credit card: banned on '.
1947 time2str('%a %h %o at %r', $ban->_date).
1948 ' by '. $ban->otaker.
1949 ' (ban# '. $ban->bannum. ')';
1954 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1955 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1956 $self->paycvv =~ /^(\d{4})$/
1957 or return "CVV2 (CID) for American Express cards is four digits.";
1960 $self->paycvv =~ /^(\d{3})$/
1961 or return "CVV2 (CVC2/CID) is three digits.";
1968 my $cardtype = cardtype($payinfo);
1969 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1971 return "Start date or issue number is required for $cardtype cards"
1972 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1974 return "Start month must be between 1 and 12"
1975 if $self->paystart_month
1976 and $self->paystart_month < 1 || $self->paystart_month > 12;
1978 return "Start year must be 1990 or later"
1979 if $self->paystart_year
1980 and $self->paystart_year < 1990;
1982 return "Issue number must be beween 1 and 99"
1984 and $self->payissue < 1 || $self->payissue > 99;
1987 $self->paystart_month('');
1988 $self->paystart_year('');
1989 $self->payissue('');
1992 } elsif ( !$ignore_invalid_card && $check_payinfo &&
1993 $self->payby =~ /^(CHEK|DCHK)$/ ) {
1995 my $payinfo = $self->payinfo;
1996 $payinfo =~ s/[^\d\@\.]//g;
1997 if ( $conf->config('echeck-country') eq 'CA' ) {
1998 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1999 or return 'invalid echeck account@branch.bank';
2000 $payinfo = "$1\@$2.$3";
2001 } elsif ( $conf->config('echeck-country') eq 'US' ) {
2002 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
2003 $payinfo = "$1\@$2";
2005 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
2006 $payinfo = "$1\@$2";
2008 $self->payinfo($payinfo);
2011 unless ( $ignore_banned_card ) {
2012 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
2014 if ( $ban->bantype eq 'warn' ) {
2015 #or others depending on value of $ban->reason ?
2016 return '_duplicate_ach' unless $self->override_ban_warn;
2018 return 'Banned ACH account: banned on '.
2019 time2str('%a %h %o at %r', $ban->_date).
2020 ' by '. $ban->otaker.
2021 ' (ban# '. $ban->bannum. ')';
2026 } elsif ( $self->payby eq 'LECB' ) {
2028 my $payinfo = $self->payinfo;
2029 $payinfo =~ s/\D//g;
2030 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2032 $self->payinfo($payinfo);
2035 } elsif ( $self->payby eq 'BILL' ) {
2037 $error = $self->ut_textn('payinfo');
2038 return "Illegal P.O. number: ". $self->payinfo if $error;
2041 } elsif ( $self->payby eq 'COMP' ) {
2043 my $curuser = $FS::CurrentUser::CurrentUser;
2044 if ( ! $self->custnum
2045 && ! $curuser->access_right('Complimentary customer')
2048 return "You are not permitted to create complimentary accounts."
2051 $error = $self->ut_textn('payinfo');
2052 return "Illegal comp account issuer: ". $self->payinfo if $error;
2055 } elsif ( $self->payby eq 'PREPAY' ) {
2057 my $payinfo = $self->payinfo;
2058 $payinfo =~ s/\W//g; #anything else would just confuse things
2059 $self->payinfo($payinfo);
2060 $error = $self->ut_alpha('payinfo');
2061 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2062 return "Unknown prepayment identifier"
2063 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2068 return "You are not permitted to create complimentary accounts."
2070 && $self->complimentary eq 'Y'
2071 && ! $FS::CurrentUser::CurrentUser->access_right('Complimentary customer');
2073 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2074 return "Expiration date required"
2075 # shouldn't payinfo_check do this?
2076 unless ! $self->payby
2077 || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
2081 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2082 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2083 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2084 ( $m, $y ) = ( $2, "19$1" );
2085 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2086 ( $m, $y ) = ( $3, "20$2" );
2088 return "Illegal expiration date: ". $self->paydate;
2090 $m = sprintf('%02d',$m);
2091 $self->paydate("$y-$m-01");
2092 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2093 return gettext('expired_card')
2095 && !$ignore_expired_card
2096 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2099 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2100 ( ! $conf->exists('require_cardname')
2101 || $self->payby !~ /^(CARD|DCRD)$/ )
2103 $self->payname( $self->first. " ". $self->getfield('last') );
2106 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2107 $self->payname =~ /^([\w \,\.\-\']*)$/
2108 or return gettext('illegal_name'). " payname: ". $self->payname;
2111 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
2112 or return gettext('illegal_name'). " payname: ". $self->payname;
2118 ### end of stuff moved to cust_payby
2120 return "Please select an invoicing locale"
2123 && $conf->exists('cust_main-require_locale');
2125 return "Please select a customer class"
2126 if ! $self->classnum
2127 && $conf->exists('cust_main-require_classnum');
2129 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2130 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2134 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2136 warn "$me check AFTER: \n". $self->_dump
2139 $self->SUPER::check;
2142 sub check_payinfo_cardtype {
2145 return '' unless $self->payby =~ /^(CARD|DCRD)$/;
2147 my $payinfo = $self->payinfo;
2148 $payinfo =~ s/\D//g;
2150 return '' if $self->tokenized($payinfo); #token
2152 my %bop_card_types = map { $_=>1 } values %{ card_types() };
2153 my $cardtype = cardtype($payinfo);
2155 return "$cardtype not accepted" unless $bop_card_types{$cardtype};
2163 Additional checks for replace only.
2168 my ($new,$old) = @_;
2169 #preserve old value if global config is set
2170 if ($old && $conf->exists('invoice-ship_address')) {
2171 $new->invoice_ship_address($old->invoice_ship_address);
2178 Returns a list of fields which have ship_ duplicates.
2183 qw( last first company
2185 address1 address2 city county state zip country
2187 daytime night fax mobile
2191 =item has_ship_address
2193 Returns true if this customer record has a separate shipping address.
2197 sub has_ship_address {
2199 $self->bill_locationnum != $self->ship_locationnum;
2204 Returns a list of key/value pairs, with the following keys: address1,
2205 adddress2, city, county, state, zip, country, district, and geocode. The
2206 shipping address is used if present.
2212 $self->ship_location->location_hash;
2217 Returns all locations (see L<FS::cust_location>) for this customer.
2224 'table' => 'cust_location',
2225 'hashref' => { 'custnum' => $self->custnum,
2226 'prospectnum' => '',
2228 'order_by' => 'ORDER BY country, LOWER(state), LOWER(city), LOWER(county), LOWER(address1), LOWER(address2)',
2234 Returns all contact associations (see L<FS::cust_contact>) for this customer.
2240 qsearch('cust_contact', { 'custnum' => $self->custnum } );
2243 =item cust_payby PAYBY
2245 Returns all payment methods (see L<FS::cust_payby>) for this customer.
2247 If one or more PAYBY are specified, returns only payment methods for specified PAYBY.
2248 Does not validate PAYBY.
2256 'table' => 'cust_payby',
2257 'hashref' => { 'custnum' => $self->custnum },
2258 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
2260 $search->{'extra_sql'} = ' AND payby IN ( '.
2261 join(',', map dbh->quote($_), @payby).
2268 =item has_cust_payby_auto
2270 Returns true if customer has an automatic payment method ('CARD' or 'CHEK')
2274 sub has_cust_payby_auto {
2277 'table' => 'cust_payby',
2278 'hashref' => { 'custnum' => $self->custnum, },
2279 'extra_sql' => " AND payby IN ( 'CARD', 'CHEK' ) ",
2280 'order_by' => 'LIMIT 1',
2287 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2288 and L<FS::cust_pkg>) for this customer, except those on hold.
2290 Returns a list: an empty list on success or a list of errors.
2296 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2301 Unsuspends all suspended packages in the on-hold state (those without setup
2302 dates) for this customer.
2308 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2313 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2315 Returns a list: an empty list on success or a list of errors.
2321 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2324 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2326 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2327 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2328 of a list of pkgparts; the hashref has the following keys:
2332 =item pkgparts - listref of pkgparts
2334 =item (other options are passed to the suspend method)
2339 Returns a list: an empty list on success or a list of errors.
2343 sub suspend_if_pkgpart {
2345 my (@pkgparts, %opt);
2346 if (ref($_[0]) eq 'HASH'){
2347 @pkgparts = @{$_[0]{pkgparts}};
2352 grep { $_->suspend(%opt) }
2353 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2354 $self->unsuspended_pkgs;
2357 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2359 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2360 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2361 instead of a list of pkgparts; the hashref has the following keys:
2365 =item pkgparts - listref of pkgparts
2367 =item (other options are passed to the suspend method)
2371 Returns a list: an empty list on success or a list of errors.
2375 sub suspend_unless_pkgpart {
2377 my (@pkgparts, %opt);
2378 if (ref($_[0]) eq 'HASH'){
2379 @pkgparts = @{$_[0]{pkgparts}};
2384 grep { $_->suspend(%opt) }
2385 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2386 $self->unsuspended_pkgs;
2389 =item cancel [ OPTION => VALUE ... ]
2391 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2392 The cancellation time will be now.
2396 Always returns a list: an empty list on success or a list of errors.
2403 warn "$me cancel called on customer ". $self->custnum. " with options ".
2404 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2406 my @pkgs = $self->ncancelled_pkgs;
2408 $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs );
2411 =item cancel_pkgs OPTIONS
2413 Cancels a specified list of packages. OPTIONS can include:
2417 =item cust_pkg - an arrayref of the packages. Required.
2419 =item time - the cancellation time, used to calculate final bills and
2420 unused-time credits if any. Will be passed through to the bill() and
2421 FS::cust_pkg::cancel() methods.
2423 =item quiet - can be set true to supress email cancellation notices.
2425 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a
2426 reasonnum of an existing reason, or passing a hashref will create a new reason.
2427 The hashref should have the following keys:
2428 typenum - Reason type (see L<FS::reason_type>)
2429 reason - Text of the new reason.
2431 =item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
2432 for the individual packages, parallel to the C<cust_pkg> argument. The
2433 reason and reason_otaker arguments will be taken from those objects.
2435 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2437 =item nobill - can be set true to skip billing if it might otherwise be done.
2442 my( $self, %opt ) = @_;
2444 # we're going to cancel services, which is not reversible
2445 # unless exports are suppressed
2446 die "cancel_pkgs cannot be run inside a transaction"
2447 if !$FS::UID::AutoCommit && !$FS::svc_Common::noexport_hack;
2449 my $oldAutoCommit = $FS::UID::AutoCommit;
2450 local $FS::UID::AutoCommit = 0;
2452 savepoint_create('cancel_pkgs');
2454 return ( 'access denied' )
2455 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2457 if ( $opt{'ban'} ) {
2459 foreach my $cust_payby ( $self->cust_payby ) {
2461 #well, if they didn't get decrypted on search, then we don't have to
2462 # try again... queue a job for the server that does have decryption
2463 # capability if we're in a paranoid multi-server implementation?
2464 return ( "Can't (yet) ban encrypted credit cards" )
2465 if $cust_payby->is_encrypted($cust_payby->payinfo);
2467 my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
2468 my $error = $ban->insert;
2470 savepoint_rollback_and_release('cancel_pkgs');
2471 dbh->rollback if $oldAutoCommit;
2479 my @pkgs = @{ delete $opt{'cust_pkg'} };
2480 my $cancel_time = $opt{'time'} || time;
2482 # bill all packages first, so we don't lose usage, service counts for
2483 # bulk billing, etc.
2484 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2486 my $error = $self->bill( 'pkg_list' => [ @pkgs ],
2488 'time' => $cancel_time );
2490 warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
2491 savepoint_rollback_and_release('cancel_pkgs');
2492 dbh->rollback if $oldAutoCommit;
2493 return ( "Error billing during cancellation: $error" );
2496 savepoint_release('cancel_pkgs');
2497 dbh->commit if $oldAutoCommit;
2500 # now cancel all services, the same way we would for individual packages.
2501 # if any of them fail, cancel the rest anyway.
2502 my @cust_svc = map { $_->cust_svc } @pkgs;
2503 my @sorted_cust_svc =
2505 sort { $a->[1] <=> $b->[1] }
2506 map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc
2508 warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
2512 foreach my $cust_svc (@sorted_cust_svc) {
2513 my $savepoint = 'cancel_pkgs_'.$i++;
2514 savepoint_create( $savepoint );
2515 my $part_svc = $cust_svc->part_svc;
2516 next if ( defined($part_svc) and $part_svc->preserve );
2517 # immediate cancel, no date option
2518 # transactionize individually
2519 my $error = try { $cust_svc->cancel } catch { $_ };
2521 savepoint_rollback_and_release( $savepoint );
2522 dbh->rollback if $oldAutoCommit;
2523 push @errors, $error;
2525 savepoint_release( $savepoint );
2526 dbh->commit if $oldAutoCommit;
2533 warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ".
2534 $self->custnum. "\n"
2538 if ($opt{'cust_pkg_reason'}) {
2539 @cprs = @{ delete $opt{'cust_pkg_reason'} };
2545 my $savepoint = 'cancel_pkgs_'.$i++;
2546 savepoint_create( $savepoint );
2548 my $cpr = shift @cprs;
2550 $lopt{'reason'} = $cpr->reasonnum;
2551 $lopt{'reason_otaker'} = $cpr->otaker;
2553 warn "no reason found when canceling package ".$_->pkgnum."\n";
2554 # we're not actually required to pass a reason to cust_pkg::cancel,
2555 # but if we're getting to this point, something has gone awry.
2556 $null_reason ||= FS::reason->new_or_existing(
2557 reason => 'unknown reason',
2558 type => 'Cancel Reason',
2561 $lopt{'reason'} = $null_reason->reasonnum;
2562 $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username;
2565 my $error = $_->cancel(%lopt);
2567 savepoint_rollback_and_release( $savepoint );
2568 dbh->rollback if $oldAutoCommit;
2569 push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
2571 savepoint_release( $savepoint );
2572 dbh->commit if $oldAutoCommit;
2579 sub _banned_pay_hashref {
2590 'payby' => $payby2ban{$self->payby},
2591 'payinfo' => $self->payinfo,
2592 #don't ever *search* on reason! #'reason' =>
2598 Returns all notes (see L<FS::cust_main_note>) for this customer.
2603 my($self,$orderby_classnum) = (shift,shift);
2604 my $orderby = "sticky DESC, _date DESC";
2605 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2606 qsearch( 'cust_main_note',
2607 { 'custnum' => $self->custnum },
2609 "ORDER BY $orderby",
2615 Returns the agent (see L<FS::agent>) for this customer.
2619 Returns the agent name (see L<FS::agent>) for this customer.
2625 $self->agent->agent;
2630 Returns any tags associated with this customer, as FS::cust_tag objects,
2631 or an empty list if there are no tags.
2635 Returns any tags associated with this customer, as FS::part_tag objects,
2636 or an empty list if there are no tags.
2642 map $_->part_tag, $self->cust_tag;
2648 Returns the customer class, as an FS::cust_class object, or the empty string
2649 if there is no customer class.
2653 Returns the customer category name, or the empty string if there is no customer
2660 my $cust_class = $self->cust_class;
2662 ? $cust_class->categoryname
2668 Returns the customer class name, or the empty string if there is no customer
2675 my $cust_class = $self->cust_class;
2677 ? $cust_class->classname
2683 Returns the external tax status, as an FS::tax_status object, or the empty
2684 string if there is no tax status.
2690 if ( $self->taxstatusnum ) {
2691 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2699 Returns the tax status code if there is one.
2705 my $tax_status = $self->tax_status;
2707 ? $tax_status->taxstatus
2711 =item BILLING METHODS
2713 Documentation on billing methods has been moved to
2714 L<FS::cust_main::Billing>.
2716 =item REALTIME BILLING METHODS
2718 Documentation on realtime billing methods has been moved to
2719 L<FS::cust_main::Billing_Realtime>.
2723 Removes the I<paycvv> field from the database directly.
2725 If there is an error, returns the error, otherwise returns false.
2727 DEPRECATED. Use L</remove_cvv_from_cust_payby> instead.
2733 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2734 or return dbh->errstr;
2735 $sth->execute($self->custnum)
2736 or return $sth->errstr;
2743 Returns the total owed for this customer on all invoices
2744 (see L<FS::cust_bill/owed>).
2750 $self->total_owed_date(2145859200); #12/31/2037
2753 =item total_owed_date TIME
2755 Returns the total owed for this customer on all invoices with date earlier than
2756 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2757 see L<Time::Local> and L<Date::Parse> for conversion functions.
2761 sub total_owed_date {
2765 my $custnum = $self->custnum;
2767 my $owed_sql = FS::cust_bill->owed_sql;
2770 SELECT SUM($owed_sql) FROM cust_bill
2771 WHERE custnum = $custnum
2775 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2779 =item total_owed_pkgnum PKGNUM
2781 Returns the total owed on all invoices for this customer's specific package
2782 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2786 sub total_owed_pkgnum {
2787 my( $self, $pkgnum ) = @_;
2788 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2791 =item total_owed_date_pkgnum TIME PKGNUM
2793 Returns the total owed for this customer's specific package when using
2794 experimental package balances on all invoices with date earlier than
2795 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2796 see L<Time::Local> and L<Date::Parse> for conversion functions.
2800 sub total_owed_date_pkgnum {
2801 my( $self, $time, $pkgnum ) = @_;
2804 foreach my $cust_bill (
2805 grep { $_->_date <= $time }
2806 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2808 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2810 sprintf( "%.2f", $total_bill );
2816 Returns the total amount of all payments.
2823 $total += $_->paid foreach $self->cust_pay;
2824 sprintf( "%.2f", $total );
2827 =item total_unapplied_credits
2829 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2830 customer. See L<FS::cust_credit/credited>.
2832 =item total_credited
2834 Old name for total_unapplied_credits. Don't use.
2838 sub total_credited {
2839 #carp "total_credited deprecated, use total_unapplied_credits";
2840 shift->total_unapplied_credits(@_);
2843 sub total_unapplied_credits {
2846 my $custnum = $self->custnum;
2848 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2851 SELECT SUM($unapplied_sql) FROM cust_credit
2852 WHERE custnum = $custnum
2855 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2859 =item total_unapplied_credits_pkgnum PKGNUM
2861 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2862 customer. See L<FS::cust_credit/credited>.
2866 sub total_unapplied_credits_pkgnum {
2867 my( $self, $pkgnum ) = @_;
2868 my $total_credit = 0;
2869 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2870 sprintf( "%.2f", $total_credit );
2874 =item total_unapplied_payments
2876 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2877 See L<FS::cust_pay/unapplied>.
2881 sub total_unapplied_payments {
2884 my $custnum = $self->custnum;
2886 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2889 SELECT SUM($unapplied_sql) FROM cust_pay
2890 WHERE custnum = $custnum
2893 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2897 =item total_unapplied_payments_pkgnum PKGNUM
2899 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2900 specific package when using experimental package balances. See
2901 L<FS::cust_pay/unapplied>.
2905 sub total_unapplied_payments_pkgnum {
2906 my( $self, $pkgnum ) = @_;
2907 my $total_unapplied = 0;
2908 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2909 sprintf( "%.2f", $total_unapplied );
2913 =item total_unapplied_refunds
2915 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2916 customer. See L<FS::cust_refund/unapplied>.
2920 sub total_unapplied_refunds {
2922 my $custnum = $self->custnum;
2924 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2927 SELECT SUM($unapplied_sql) FROM cust_refund
2928 WHERE custnum = $custnum
2931 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2937 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2938 total_unapplied_credits minus total_unapplied_payments).
2944 $self->balance_date_range;
2947 =item balance_date TIME
2949 Returns the balance for this customer, only considering invoices with date
2950 earlier than TIME (total_owed_date minus total_credited minus
2951 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2952 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2959 $self->balance_date_range(shift);
2962 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2964 Returns the balance for this customer, optionally considering invoices with
2965 date earlier than START_TIME, and not later than END_TIME
2966 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2968 Times are specified as SQL fragments or numeric
2969 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2970 L<Date::Parse> for conversion functions. The empty string can be passed
2971 to disable that time constraint completely.
2973 Accepts the same options as L<balance_date_sql>:
2977 =item unapplied_date
2979 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)
2983 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2984 time will be ignored. Note that START_TIME and END_TIME only limit the date
2985 range for invoices and I<unapplied> payments, credits, and refunds.
2991 sub balance_date_range {
2993 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2994 ') FROM cust_main WHERE custnum='. $self->custnum;
2995 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2998 =item balance_pkgnum PKGNUM
3000 Returns the balance for this customer's specific package when using
3001 experimental package balances (total_owed plus total_unrefunded, minus
3002 total_unapplied_credits minus total_unapplied_payments)
3006 sub balance_pkgnum {
3007 my( $self, $pkgnum ) = @_;
3010 $self->total_owed_pkgnum($pkgnum)
3011 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
3012 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
3013 - $self->total_unapplied_credits_pkgnum($pkgnum)
3014 - $self->total_unapplied_payments_pkgnum($pkgnum)
3020 Returns a hash of useful information for making a payment.
3030 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3031 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3032 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3036 For credit card transactions:
3048 For electronic check transactions:
3063 $return{balance} = $self->balance;
3065 $return{payname} = $self->payname
3066 || ( $self->first. ' '. $self->get('last') );
3068 $return{$_} = $self->bill_location->$_
3069 for qw(address1 address2 city state zip);
3071 $return{payby} = $self->payby;
3072 $return{stateid_state} = $self->stateid_state;
3074 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3075 $return{card_type} = cardtype($self->payinfo);
3076 $return{payinfo} = $self->paymask;
3078 @return{'month', 'year'} = $self->paydate_monthyear;
3082 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3083 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3084 $return{payinfo1} = $payinfo1;
3085 $return{payinfo2} = $payinfo2;
3086 $return{paytype} = $self->paytype;
3087 $return{paystate} = $self->paystate;
3091 #doubleclick protection
3093 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3101 Returns the next payment expiration date for this customer. If they have no
3102 payment methods that will expire, returns 0.
3108 # filter out the ones that individually return 0, but then return 0 if
3109 # there are no results
3110 my @epochs = grep { $_ > 0 } map { $_->paydate_epoch } $self->cust_payby;
3111 min( @epochs ) || 0;
3114 =item paydate_epoch_sql
3116 Returns an SQL expression to get the next payment expiration date for a
3117 customer. Returns 2143260000 (2037-12-01) if there are no payment expiration
3118 dates, so that it's safe to test for "will it expire before date X" for any
3123 sub paydate_epoch_sql {
3125 my $paydate = FS::cust_payby->paydate_epoch_sql;
3126 "(SELECT COALESCE(MIN($paydate), 2143260000) FROM cust_payby WHERE cust_payby.custnum = cust_main.custnum)";
3130 my( $self, $taxname ) = @_;
3132 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3133 'taxname' => $taxname,
3138 =item cust_main_exemption
3140 =item invoicing_list
3142 Returns a list of email addresses (with svcnum entries expanded), and the word
3143 'POST' if the customer receives postal invoices.
3147 sub invoicing_list {
3148 my( $self, $arrayref ) = @_;
3151 warn "FS::cust_main::invoicing_list(ARRAY) is no longer supported.";
3154 my @emails = $self->invoicing_list_emailonly;
3155 push @emails, 'POST' if $self->get('postal_invoice');
3160 =item check_invoicing_list ARRAYREF
3162 Checks these arguements as valid input for the invoicing_list method. If there
3163 is an error, returns the error, otherwise returns false.
3167 sub check_invoicing_list {
3168 my( $self, $arrayref ) = @_;
3170 foreach my $address ( @$arrayref ) {
3172 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3173 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3176 my $cust_main_invoice = new FS::cust_main_invoice ( {
3177 'custnum' => $self->custnum,
3180 my $error = $self->custnum
3181 ? $cust_main_invoice->check
3182 : $cust_main_invoice->checkdest
3184 return $error if $error;
3188 return "Email address required"
3189 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3190 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3197 Returns the email addresses of all accounts provisioned for this customer.
3204 foreach my $cust_pkg ( $self->all_pkgs ) {
3205 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3207 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3208 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3210 $list{$_}=1 foreach map { $_->email } @svc_acct;
3215 =item invoicing_list_addpost
3217 Adds postal invoicing to this customer. If this customer is already configured
3218 to receive postal invoices, does nothing.
3222 sub invoicing_list_addpost {
3224 if ( $self->get('postal_invoice') eq '' ) {
3225 $self->set('postal_invoice', 'Y');
3226 my $error = $self->replace;
3227 warn $error if $error; # should fail harder, but this is traditional
3231 =item invoicing_list_emailonly
3233 Returns the list of email invoice recipients (invoicing_list without non-email
3234 destinations such as POST and FAX).
3238 sub invoicing_list_emailonly {
3240 warn "$me invoicing_list_emailonly called"
3242 return () if !$self->custnum; # not yet inserted
3243 return map { $_->emailaddress }
3245 table => 'cust_contact',
3246 select => 'emailaddress',
3247 addl_from => ' JOIN contact USING (contactnum) '.
3248 ' JOIN contact_email USING (contactnum)',
3249 hashref => { 'custnum' => $self->custnum, },
3250 extra_sql => q( AND cust_contact.invoice_dest = 'Y'),
3254 =item invoicing_list_emailonly_scalar
3256 Returns the list of email invoice recipients (invoicing_list without non-email
3257 destinations such as POST and FAX) as a comma-separated scalar.
3261 sub invoicing_list_emailonly_scalar {
3263 warn "$me invoicing_list_emailonly_scalar called"
3265 join(', ', $self->invoicing_list_emailonly);
3268 =item contact_list [ CLASSNUM, DEST_FLAG... ]
3270 Returns a list of contacts (L<FS::contact> objects) for the customer.
3272 If no arguments are given, returns all contacts for the customer.
3274 Arguments may contain classnums. When classnums are specified, only
3275 contacts with a matching cust_contact.classnum are returned. When a
3276 classnum of 0 is given, contacts with a null classnum are also included.
3278 Arguments may also contain the dest flag names 'invoice' or 'message'.
3279 If given, contacts who's invoice_dest and/or message_dest flags are
3280 not set to 'Y' will be excluded.
3288 select => join(', ',(
3290 'cust_contact.invoice_dest',
3291 'cust_contact.message_dest',
3293 addl_from => ' JOIN cust_contact USING (contactnum)',
3294 extra_sql => ' WHERE cust_contact.custnum = '.$self->custnum,
3298 # Calling methods were relying on this method to use invoice_dest to
3299 # block e-mail messages. Depending on parameters, this may or may not
3300 # have actually happened.
3302 # The bug could cause this SQL to be used to filter e-mail addresses:
3305 # cust_contact.classnums IN (1,2,3)
3306 # OR cust_contact.invoice_dest = 'Y'
3309 # improperly including everybody with the opt-in flag AND everybody
3310 # in the contact classes
3312 # Possibility to introduce new bugs:
3313 # If callers of this method called it incorrectly, and didn't notice
3314 # because it seemed to send the e-mails they wanted.
3319 # cust_contact.classnum IN (1,2,3)
3321 # cust_contact.classnum IS NULL
3324 # cust_contact.invoice_dest = 'Y'
3326 # cust_contact.message_dest = 'Y'
3334 if ($_ eq 'invoice' || $_ eq 'message') {
3335 push @and_dest, " cust_contact.${_}_dest = 'Y' ";
3336 } elsif ($_ eq '0') {
3337 push @or_classnum, ' cust_contact.classnum IS NULL ';
3338 } elsif ( /^\d+$/ ) {
3339 push @classnums, $_;
3341 croak "bad classnum argument '$_'";
3345 push @or_classnum, 'cust_contact.classnum IN ('.join(',',@classnums).')'
3348 if (@or_classnum || @and_dest) { # catch, no arguments given
3349 $search->{extra_sql} .= ' AND ( ';
3352 $search->{extra_sql} .= ' ( ';
3353 $search->{extra_sql} .= join ' OR ', map {" $_ "} @or_classnum;
3354 $search->{extra_sql} .= ' ) ';
3355 $search->{extra_sql} .= ' AND ( ' if @and_dest;
3359 $search->{extra_sql} .= join ' OR ', map {" $_ "} @and_dest;
3360 $search->{extra_sql} .= ' ) ' if @or_classnum;
3363 $search->{extra_sql} .= ' ) ';
3365 warn "\$extra_sql: $search->{extra_sql} \n" if $DEBUG;
3371 =item contact_list_email [ CLASSNUM, ... ]
3373 Same as L</contact_list>, but returns email destinations instead of contact
3378 sub contact_list_email {
3380 my @contacts = $self->contact_list(@_);
3382 foreach my $contact (@contacts) {
3383 foreach my $contact_email ($contact->contact_email) {
3384 push @emails, Email::Address->new( $contact->firstlast,
3385 $contact_email->emailaddress
3392 =item referral_custnum_cust_main
3394 Returns the customer who referred this customer (or the empty string, if
3395 this customer was not referred).
3397 Note the difference with referral_cust_main method: This method,
3398 referral_custnum_cust_main returns the single customer (if any) who referred
3399 this customer, while referral_cust_main returns an array of customers referred
3404 sub referral_custnum_cust_main {
3406 return '' unless $self->referral_custnum;
3407 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3410 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3412 Returns an array of customers referred by this customer (referral_custnum set
3413 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3414 customers referred by customers referred by this customer and so on, inclusive.
3415 The default behavior is DEPTH 1 (no recursion).
3417 Note the difference with referral_custnum_cust_main method: This method,
3418 referral_cust_main, returns an array of customers referred BY this customer,
3419 while referral_custnum_cust_main returns the single customer (if any) who
3420 referred this customer.
3424 sub referral_cust_main {
3426 my $depth = @_ ? shift : 1;
3427 my $exclude = @_ ? shift : {};
3430 map { $exclude->{$_->custnum}++; $_; }
3431 grep { ! $exclude->{ $_->custnum } }
3432 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3436 map { $_->referral_cust_main($depth-1, $exclude) }
3443 =item referral_cust_main_ncancelled
3445 Same as referral_cust_main, except only returns customers with uncancelled
3450 sub referral_cust_main_ncancelled {
3452 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3455 =item referral_cust_pkg [ DEPTH ]
3457 Like referral_cust_main, except returns a flat list of all unsuspended (and
3458 uncancelled) packages for each customer. The number of items in this list may
3459 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3463 sub referral_cust_pkg {
3465 my $depth = @_ ? shift : 1;
3467 map { $_->unsuspended_pkgs }
3468 grep { $_->unsuspended_pkgs }
3469 $self->referral_cust_main($depth);
3472 =item referring_cust_main
3474 Returns the single cust_main record for the customer who referred this customer
3475 (referral_custnum), or false.
3479 sub referring_cust_main {
3481 return '' unless $self->referral_custnum;
3482 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3485 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3487 Applies a credit to this customer. If there is an error, returns the error,
3488 otherwise returns false.
3490 REASON can be a text string, an FS::reason object, or a scalar reference to
3491 a reasonnum. If a text string, it will be automatically inserted as a new
3492 reason, and a 'reason_type' option must be passed to indicate the
3493 FS::reason_type for the new reason.
3495 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3496 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3497 I<commission_pkgnum>.
3499 Any other options are passed to FS::cust_credit::insert.
3504 my( $self, $amount, $reason, %options ) = @_;
3506 my $cust_credit = new FS::cust_credit {
3507 'custnum' => $self->custnum,
3508 'amount' => $amount,
3511 if ( ref($reason) ) {
3513 if ( ref($reason) eq 'SCALAR' ) {
3514 $cust_credit->reasonnum( $$reason );
3516 $cust_credit->reasonnum( $reason->reasonnum );
3520 $cust_credit->set('reason', $reason)
3523 $cust_credit->$_( delete $options{$_} )
3524 foreach grep exists($options{$_}),
3525 qw( addlinfo eventnum ),
3526 map "commission_$_", qw( agentnum salesnum pkgnum );
3528 $cust_credit->insert(%options);
3532 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3534 Creates a one-time charge for this customer. If there is an error, returns
3535 the error, otherwise returns false.
3537 New-style, with a hashref of options:
3539 my $error = $cust_main->charge(
3543 'start_date' => str2time('7/4/2009'),
3544 'pkg' => 'Description',
3545 'comment' => 'Comment',
3546 'additional' => [], #extra invoice detail
3547 'classnum' => 1, #pkg_class
3549 'setuptax' => '', # or 'Y' for tax exempt
3551 'locationnum'=> 1234, # optional
3554 'taxclass' => 'Tax class',
3557 'taxproduct' => 2, #part_pkg_taxproduct
3558 'override' => {}, #XXX describe
3560 #will be filled in with the new object
3561 'cust_pkg_ref' => \$cust_pkg,
3563 #generate an invoice immediately
3565 'invoice_terms' => '', #with these terms
3571 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3575 #super false laziness w/quotation::charge
3578 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3579 my ( $pkg, $comment, $additional );
3580 my ( $setuptax, $taxclass ); #internal taxes
3581 my ( $taxproduct, $override ); #vendor (CCH) taxes
3583 my $separate_bill = '';
3584 my $cust_pkg_ref = '';
3585 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3587 my ( $discountnum, $discountnum_amount, $discountnum_percent ) = ( '','','' );
3588 if ( ref( $_[0] ) ) {
3589 $amount = $_[0]->{amount};
3590 $setup_cost = $_[0]->{setup_cost};
3591 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3592 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3593 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3594 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3595 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3596 : '$'. sprintf("%.2f",$amount);
3597 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3598 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3599 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3600 $additional = $_[0]->{additional} || [];
3601 $taxproduct = $_[0]->{taxproductnum};
3602 $override = { '' => $_[0]->{tax_override} };
3603 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3604 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3605 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3606 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3607 $separate_bill = $_[0]->{separate_bill} || '';
3608 $discountnum = $_[0]->{setup_discountnum};
3609 $discountnum_amount = $_[0]->{setup_discountnum_amount};
3610 $discountnum_percent = $_[0]->{setup_discountnum_percent};
3616 $pkg = @_ ? shift : 'One-time charge';
3617 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3619 $taxclass = @_ ? shift : '';
3623 local $SIG{HUP} = 'IGNORE';
3624 local $SIG{INT} = 'IGNORE';
3625 local $SIG{QUIT} = 'IGNORE';
3626 local $SIG{TERM} = 'IGNORE';
3627 local $SIG{TSTP} = 'IGNORE';
3628 local $SIG{PIPE} = 'IGNORE';
3630 my $oldAutoCommit = $FS::UID::AutoCommit;
3631 local $FS::UID::AutoCommit = 0;
3634 my $part_pkg = new FS::part_pkg ( {
3636 'comment' => $comment,
3640 'classnum' => ( $classnum ? $classnum : '' ),
3641 'setuptax' => $setuptax,
3642 'taxclass' => $taxclass,
3643 'taxproductnum' => $taxproduct,
3644 'setup_cost' => $setup_cost,
3647 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3648 ( 0 .. @$additional - 1 )
3650 'additional_count' => scalar(@$additional),
3651 'setup_fee' => $amount,
3654 my $error = $part_pkg->insert( options => \%options,
3655 tax_overrides => $override,
3658 $dbh->rollback if $oldAutoCommit;
3662 my $pkgpart = $part_pkg->pkgpart;
3663 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3664 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3665 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3666 $error = $type_pkgs->insert;
3668 $dbh->rollback if $oldAutoCommit;
3673 my $cust_pkg = new FS::cust_pkg ( {
3674 'custnum' => $self->custnum,
3675 'pkgpart' => $pkgpart,
3676 'quantity' => $quantity,
3677 'start_date' => $start_date,
3678 'no_auto' => $no_auto,
3679 'separate_bill' => $separate_bill,
3680 'locationnum' => $locationnum,
3681 'setup_discountnum' => $discountnum,
3682 'setup_discountnum_amount' => $discountnum_amount,
3683 'setup_discountnum_percent' => $discountnum_percent,
3686 $error = $cust_pkg->insert;
3688 $dbh->rollback if $oldAutoCommit;
3690 } elsif ( $cust_pkg_ref ) {
3691 ${$cust_pkg_ref} = $cust_pkg;
3695 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3696 'pkg_list' => [ $cust_pkg ],
3699 $dbh->rollback if $oldAutoCommit;
3704 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3709 #=item charge_postal_fee
3711 #Applies a one time charge this customer. If there is an error,
3712 #returns the error, returns the cust_pkg charge object or false
3713 #if there was no charge.
3717 # This should be a customer event. For that to work requires that bill
3718 # also be a customer event.
3720 sub charge_postal_fee {
3723 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3724 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3726 my $cust_pkg = new FS::cust_pkg ( {
3727 'custnum' => $self->custnum,
3728 'pkgpart' => $pkgpart,
3732 my $error = $cust_pkg->insert;
3733 $error ? $error : $cust_pkg;
3736 =item num_cust_attachment_deleted
3738 Returns the number of deleted attachments for this customer (see
3739 L<FS::num_cust_attachment>).
3743 sub num_cust_attachments_deleted {
3746 " SELECT COUNT(*) FROM cust_attachment ".
3747 " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0",
3754 Returns the most recent invnum (invoice number) for this customer.
3761 " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?",
3766 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3768 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3770 Optionally, a list or hashref of additional arguments to the qsearch call can
3777 my $opt = ref($_[0]) ? shift : { @_ };
3779 #return $self->num_cust_bill unless wantarray || keys %$opt;
3781 $opt->{'table'} = 'cust_bill';
3782 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3783 $opt->{'hashref'}{'custnum'} = $self->custnum;
3784 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3786 map { $_ } #behavior of sort undefined in scalar context
3787 sort { $a->_date <=> $b->_date }
3791 =item open_cust_bill
3793 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3798 sub open_cust_bill {
3802 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3808 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3810 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3814 sub legacy_cust_bill {
3817 #return $self->num_legacy_cust_bill unless wantarray;
3819 map { $_ } #behavior of sort undefined in scalar context
3820 sort { $a->_date <=> $b->_date }
3821 qsearch({ 'table' => 'legacy_cust_bill',
3822 'hashref' => { 'custnum' => $self->custnum, },
3823 'order_by' => 'ORDER BY _date ASC',
3827 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3829 Returns all the statements (see L<FS::cust_statement>) for this customer.
3831 Optionally, a list or hashref of additional arguments to the qsearch call can
3836 =item cust_bill_void
3838 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3842 sub cust_bill_void {
3845 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3846 sort { $a->_date <=> $b->_date }
3847 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3850 sub cust_statement {
3852 my $opt = ref($_[0]) ? shift : { @_ };
3854 #return $self->num_cust_statement unless wantarray || keys %$opt;
3856 $opt->{'table'} = 'cust_statement';
3857 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3858 $opt->{'hashref'}{'custnum'} = $self->custnum;
3859 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3861 map { $_ } #behavior of sort undefined in scalar context
3862 sort { $a->_date <=> $b->_date }
3866 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3868 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3870 Optionally, a list or hashref of additional arguments to the qsearch call can
3871 be passed following the SVCDB.
3878 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3879 warn "$me svc_x requires a svcdb";
3882 my $opt = ref($_[0]) ? shift : { @_ };
3884 $opt->{'table'} = $svcdb;
3885 $opt->{'addl_from'} =
3886 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3887 ($opt->{'addl_from'} || '');
3889 my $custnum = $self->custnum;
3890 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3891 my $where = "cust_pkg.custnum = $custnum";
3893 my $extra_sql = $opt->{'extra_sql'} || '';
3894 if ( keys %{ $opt->{'hashref'} } ) {
3895 $extra_sql = " AND $where $extra_sql";
3898 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3899 $extra_sql = "WHERE $where AND $1";
3902 $extra_sql = "WHERE $where $extra_sql";
3905 $opt->{'extra_sql'} = $extra_sql;
3910 # required for use as an eventtable;
3913 $self->svc_x('svc_acct', @_);
3918 Returns all the credits (see L<FS::cust_credit>) for this customer.
3925 #return $self->num_cust_credit unless wantarray;
3927 map { $_ } #behavior of sort undefined in scalar context
3928 sort { $a->_date <=> $b->_date }
3929 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3932 =item cust_credit_pkgnum
3934 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3935 package when using experimental package balances.
3939 sub cust_credit_pkgnum {
3940 my( $self, $pkgnum ) = @_;
3941 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3942 sort { $a->_date <=> $b->_date }
3943 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3944 'pkgnum' => $pkgnum,
3949 =item cust_credit_void
3951 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3955 sub cust_credit_void {
3958 sort { $a->_date <=> $b->_date }
3959 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3964 Returns all the payments (see L<FS::cust_pay>) for this customer.
3970 my $opt = ref($_[0]) ? shift : { @_ };
3972 return $self->num_cust_pay unless wantarray || keys %$opt;
3974 $opt->{'table'} = 'cust_pay';
3975 $opt->{'hashref'}{'custnum'} = $self->custnum;
3977 map { $_ } #behavior of sort undefined in scalar context
3978 sort { $a->_date <=> $b->_date }
3985 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3986 called automatically when the cust_pay method is used in a scalar context.
3992 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3993 my $sth = dbh->prepare($sql) or die dbh->errstr;
3994 $sth->execute($self->custnum) or die $sth->errstr;
3995 $sth->fetchrow_arrayref->[0];
3998 =item unapplied_cust_pay
4000 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
4004 sub unapplied_cust_pay {
4008 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
4014 =item cust_pay_pkgnum
4016 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4017 package when using experimental package balances.
4021 sub cust_pay_pkgnum {
4022 my( $self, $pkgnum ) = @_;
4023 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4024 sort { $a->_date <=> $b->_date }
4025 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4026 'pkgnum' => $pkgnum,
4033 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4039 map { $_ } #return $self->num_cust_pay_void unless wantarray;
4040 sort { $a->_date <=> $b->_date }
4041 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4044 =item cust_pay_pending
4046 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4047 (without status "done").
4051 sub cust_pay_pending {
4053 return $self->num_cust_pay_pending unless wantarray;
4054 sort { $a->_date <=> $b->_date }
4055 qsearch( 'cust_pay_pending', {
4056 'custnum' => $self->custnum,
4057 'status' => { op=>'!=', value=>'done' },
4062 =item cust_pay_pending_attempt
4064 Returns all payment attempts / declined payments for this customer, as pending
4065 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4066 a corresponding payment (see L<FS::cust_pay>).
4070 sub cust_pay_pending_attempt {
4072 return $self->num_cust_pay_pending_attempt unless wantarray;
4073 sort { $a->_date <=> $b->_date }
4074 qsearch( 'cust_pay_pending', {
4075 'custnum' => $self->custnum,
4082 =item num_cust_pay_pending
4084 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4085 customer (without status "done"). Also called automatically when the
4086 cust_pay_pending method is used in a scalar context.
4090 sub num_cust_pay_pending {
4093 " SELECT COUNT(*) FROM cust_pay_pending ".
4094 " WHERE custnum = ? AND status != 'done' ",
4099 =item num_cust_pay_pending_attempt
4101 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4102 customer, with status "done" but without a corresp. Also called automatically when the
4103 cust_pay_pending method is used in a scalar context.
4107 sub num_cust_pay_pending_attempt {
4110 " SELECT COUNT(*) FROM cust_pay_pending ".
4111 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4118 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4124 map { $_ } #return $self->num_cust_refund unless wantarray;
4125 sort { $a->_date <=> $b->_date }
4126 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4129 =item display_custnum
4131 Returns the displayed customer number for this customer: agent_custid if
4132 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4136 sub display_custnum {
4139 return $self->agent_custid
4140 if $default_agent_custid && $self->agent_custid;
4142 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
4146 sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
4147 } elsif ( $custnum_display_length ) {
4148 return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
4150 return $self->custnum;
4156 Returns a name string for this customer, either "Company (Last, First)" or
4163 my $name = $self->contact;
4164 $name = $self->company. " ($name)" if $self->company;
4168 =item batch_payment_payname
4170 Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company,
4171 based on if a company name exists and is the account being used a business account.
4175 sub batch_payment_payname {
4177 my $cust_pay_batch = shift;
4180 if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; }
4181 else { $name = $self->first .' '. $self->last; }
4183 $name = $self->company
4184 if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company);
4189 =item service_contact
4191 Returns the L<FS::contact> object for this customer that has the 'Service'
4192 contact class, or undef if there is no such contact. Deprecated; don't use
4197 sub service_contact {
4199 if ( !exists($self->{service_contact}) ) {
4200 my $classnum = $self->scalar_sql(
4201 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4202 ) || 0; #if it's zero, qsearchs will return nothing
4203 my $cust_contact = qsearchs('cust_contact', {
4204 'classnum' => $classnum,
4205 'custnum' => $self->custnum,
4207 $self->{service_contact} = $cust_contact->contact if $cust_contact;
4209 $self->{service_contact};
4214 Returns a name string for this (service/shipping) contact, either
4215 "Company (Last, First)" or "Last, First".
4222 my $name = $self->ship_contact;
4223 $name = $self->company. " ($name)" if $self->company;
4229 Returns a name string for this customer, either "Company" or "First Last".
4235 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4238 =item ship_name_short
4240 Returns a name string for this (service/shipping) contact, either "Company"
4245 sub ship_name_short {
4247 $self->service_contact
4248 ? $self->ship_contact_firstlast
4254 Returns this customer's full (billing) contact name only, "Last, First"
4260 $self->get('last'). ', '. $self->first;
4265 Returns this customer's full (shipping) contact name only, "Last, First"
4271 my $contact = $self->service_contact || $self;
4272 $contact->get('last') . ', ' . $contact->get('first');
4275 =item contact_firstlast
4277 Returns this customers full (billing) contact name only, "First Last".
4281 sub contact_firstlast {
4283 $self->first. ' '. $self->get('last');
4286 =item ship_contact_firstlast
4288 Returns this customer's full (shipping) contact name only, "First Last".
4292 sub ship_contact_firstlast {
4294 my $contact = $self->service_contact || $self;
4295 $contact->get('first') . ' '. $contact->get('last');
4298 sub bill_country_full {
4300 $self->bill_location->country_full;
4303 sub ship_country_full {
4305 $self->ship_location->country_full;
4308 =item county_state_county [ PREFIX ]
4310 Returns a string consisting of just the county, state and country.
4314 sub county_state_country {
4317 if ( @_ && $_[0] && $self->has_ship_address ) {
4318 $locationnum = $self->ship_locationnum;
4320 $locationnum = $self->bill_locationnum;
4322 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4323 $cust_location->county_state_country;
4326 =item geocode DATA_VENDOR
4328 Returns a value for the customer location as encoded by DATA_VENDOR.
4329 Currently this only makes sense for "CCH" as DATA_VENDOR.
4337 Returns a status string for this customer, currently:
4343 No packages have ever been ordered. Displayed as "No packages".
4347 Recurring packages all are new (not yet billed).
4351 One or more recurring packages is active.
4355 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
4359 All non-cancelled recurring packages are suspended.
4363 All recurring packages are cancelled.
4367 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4368 cust_main-status_module configuration option.
4372 sub status { shift->cust_status(@_); }
4376 return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4377 for my $status ( FS::cust_main->statuses() ) {
4378 my $method = $status.'_sql';
4379 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4380 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4381 $sth->execute( ($self->custnum) x $numnum )
4382 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4383 if ( $sth->fetchrow_arrayref->[0] ) {
4384 $self->hashref->{cust_status} = $status;
4390 =item is_status_delay_cancel
4392 Returns true if customer status is 'suspended'
4393 and all suspended cust_pkg return true for
4394 cust_pkg->is_status_delay_cancel.
4396 This is not a real status, this only meant for hacking display
4397 values, because otherwise treating the customer as suspended is
4398 really the whole point of the delay_cancel option.
4402 sub is_status_delay_cancel {
4404 return 0 unless $self->status eq 'suspended';
4405 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4406 return 0 unless $cust_pkg->is_status_delay_cancel;
4411 =item ucfirst_cust_status
4413 =item ucfirst_status
4415 Deprecated, use the cust_status_label method instead.
4417 Returns the status with the first character capitalized.
4421 sub ucfirst_status {
4422 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4423 local($ucfirst_nowarn) = 1;
4424 shift->ucfirst_cust_status(@_);
4427 sub ucfirst_cust_status {
4428 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4430 ucfirst($self->cust_status);
4433 =item cust_status_label
4437 Returns the display label for this status.
4441 sub status_label { shift->cust_status_label(@_); }
4443 sub cust_status_label {
4445 __PACKAGE__->statuslabels->{$self->cust_status};
4450 Returns a hex triplet color string for this customer's status.
4454 sub statuscolor { shift->cust_statuscolor(@_); }
4456 sub cust_statuscolor {
4458 __PACKAGE__->statuscolors->{$self->cust_status};
4461 =item tickets [ STATUS ]
4463 Returns an array of hashes representing the customer's RT tickets.
4465 An optional status (or arrayref or hashref of statuses) may be specified.
4471 my $status = ( @_ && $_[0] ) ? shift : '';
4473 my $num = $conf->config('cust_main-max_tickets') || 10;
4476 if ( $conf->config('ticket_system') ) {
4477 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4479 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4488 foreach my $priority (
4489 $conf->config('ticket_system-custom_priority_field-values'), ''
4491 last if scalar(@tickets) >= $num;
4493 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4494 $num - scalar(@tickets),
4505 =item appointments [ STATUS ]
4507 Returns an array of hashes representing the customer's RT tickets which
4514 my $status = ( @_ && $_[0] ) ? shift : '';
4516 return () unless $conf->config('ticket_system');
4518 my $queueid = $conf->config('ticket_system-appointment-queueid');
4520 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4529 # Return services representing svc_accts in customer support packages
4530 sub support_services {
4532 my %packages = map { $_ => 1 } $conf->config('support_packages');
4534 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4535 grep { $_->part_svc->svcdb eq 'svc_acct' }
4536 map { $_->cust_svc }
4537 grep { exists $packages{ $_->pkgpart } }
4538 $self->ncancelled_pkgs;
4542 # Return a list of latitude/longitude for one of the services (if any)
4543 sub service_coordinates {
4547 grep { $_->latitude && $_->longitude }
4549 map { $_->cust_svc }
4550 $self->ncancelled_pkgs;
4552 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4557 Returns a masked version of the named field
4562 my ($self,$field) = @_;
4566 'x'x(length($self->getfield($field))-4).
4567 substr($self->getfield($field), (length($self->getfield($field))-4));
4571 =item payment_history
4573 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4574 cust_credit and cust_refund objects. Each hashref has the following fields:
4576 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4578 I<date> - value of _date field, unix timestamp
4580 I<date_pretty> - user-friendly date
4582 I<description> - user-friendly description of item
4584 I<amount> - impact of item on user's balance
4585 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4586 Not to be confused with the native 'amount' field in cust_credit, see below.
4588 I<amount_pretty> - includes money char
4590 I<balance> - customer balance, chronologically as of this item
4592 I<balance_pretty> - includes money char
4594 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4596 I<paid> - amount paid for cust_pay records, undef for other types
4598 I<credit> - amount credited for cust_credit records, undef for other types.
4599 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4601 I<refund> - amount refunded for cust_refund records, undef for other types
4603 The four table-specific keys always have positive values, whether they reflect charges or payments.
4605 The following options may be passed to this method:
4607 I<line_items> - if true, returns charges ('Line item') rather than invoices
4609 I<start_date> - unix timestamp, only include records on or after.
4610 If specified, an item of type 'Previous' will also be included.
4611 It does not have table-specific fields.
4613 I<end_date> - unix timestamp, only include records before
4615 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4617 I<conf> - optional already-loaded FS::Conf object.
4621 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4622 # and also for sending customer statements, which should both be kept customer-friendly.
4623 # If you add anything that shouldn't be passed on through the API or exposed
4624 # to customers, add a new option to include it, don't include it by default
4625 sub payment_history {
4627 my $opt = ref($_[0]) ? $_[0] : { @_ };
4629 my $conf = $$opt{'conf'} || new FS::Conf;
4630 my $money_char = $conf->config("money_char") || '$',
4632 #first load entire history,
4633 #need previous to calculate previous balance
4634 #loading after end_date shouldn't hurt too much?
4636 if ( $$opt{'line_items'} ) {
4638 foreach my $cust_bill ( $self->cust_bill ) {
4641 'type' => 'Line item',
4642 'description' => $_->desc( $self->locale ).
4643 ( $_->sdate && $_->edate
4644 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4645 ' To '. time2str('%d-%b-%Y', $_->edate)
4648 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4649 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4650 'date' => $cust_bill->_date,
4651 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4653 foreach $cust_bill->cust_bill_pkg;
4660 'type' => 'Invoice',
4661 'description' => 'Invoice #'. $_->display_invnum,
4662 'amount' => sprintf('%.2f', $_->charged ),
4663 'charged' => sprintf('%.2f', $_->charged ),
4664 'date' => $_->_date,
4665 'date_pretty' => $self->time2str_local('short', $_->_date ),
4667 foreach $self->cust_bill;
4672 'type' => 'Payment',
4673 'description' => 'Payment', #XXX type
4674 'amount' => sprintf('%.2f', 0 - $_->paid ),
4675 'paid' => sprintf('%.2f', $_->paid ),
4676 'date' => $_->_date,
4677 'date_pretty' => $self->time2str_local('short', $_->_date ),
4679 foreach $self->cust_pay;
4683 'description' => 'Credit', #more info?
4684 'amount' => sprintf('%.2f', 0 -$_->amount ),
4685 'credit' => sprintf('%.2f', $_->amount ),
4686 'date' => $_->_date,
4687 'date_pretty' => $self->time2str_local('short', $_->_date ),
4689 foreach $self->cust_credit;
4693 'description' => 'Refund', #more info? type, like payment?
4694 'amount' => $_->refund,
4695 'refund' => $_->refund,
4696 'date' => $_->_date,
4697 'date_pretty' => $self->time2str_local('short', $_->_date ),
4699 foreach $self->cust_refund;
4701 #put it all in chronological order
4702 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4704 #calculate balance, filter items outside date range
4708 foreach my $item (@history) {
4709 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4710 $balance += $$item{'amount'};
4711 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4712 $previous += $$item{'amount'};
4715 $$item{'balance'} = sprintf("%.2f",$balance);
4716 foreach my $key ( qw(amount balance) ) {
4717 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4722 # start with previous balance, if there was one
4725 'type' => 'Previous',
4726 'description' => 'Previous balance',
4727 'amount' => sprintf("%.2f",$previous),
4728 'balance' => sprintf("%.2f",$previous),
4729 'date' => $$opt{'start_date'},
4730 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4732 #false laziness with above
4733 foreach my $key ( qw(amount balance) ) {
4734 $$item{$key.'_pretty'} = $$item{$key};
4735 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4737 unshift(@out,$item);
4740 @out = reverse @history if $$opt{'reverse_sort'};
4745 =item save_cust_payby
4747 Saves a new cust_payby for this customer, replacing an existing entry only
4748 in select circumstances. Does not validate input.
4750 If auto is specified, marks this as the customer's primary method, or the
4751 specified weight. Existing payment methods have their weight incremented as
4754 If bill_location is specified with auto, also sets location in cust_main.
4756 Will not insert complete duplicates of existing records, or records in which the
4757 only difference from an existing record is to turn off automatic payment (will
4758 return without error.) Will replace existing records in which the only difference
4759 is to add a value to a previously empty preserved field and/or turn on automatic payment.
4760 Fields marked as preserved are optional, and existing values will not be overwritten with
4761 blanks when replacing.
4763 Accepts the following named parameters:
4773 save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
4777 optional, set higher than 1 for secondary, etc.
4785 optional, but should be specified for anything that might be tokenized, will be preserved when replacing
4793 optional, will be preserved when replacing
4801 CARD only, required, FS::cust_location object
4803 =item paystart_month
4805 CARD only, optional, will be preserved when replacing
4809 CARD only, optional, will be preserved when replacing
4813 CARD only, optional, will be preserved when replacing
4817 CARD only, only used if conf cvv-save is set appropriately
4827 =item saved_cust_payby
4829 scalar reference, for returning saved object
4835 #The code for this option is in place, but it's not currently used
4839 # existing cust_payby object to be replaced (must match custnum)
4841 # stateid/stateid_state/ss are not currently supported in cust_payby,
4842 # might not even work properly in 4.x, but will need to work here if ever added
4844 sub save_cust_payby {
4848 my $old = $opt{'replace'};
4849 my $new = new FS::cust_payby { $old ? $old->hash : () };
4850 return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum;
4851 $new->set( 'custnum' => $self->custnum );
4853 my $payby = $opt{'payment_payby'};
4854 return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK'));
4856 # don't allow turning off auto when replacing
4857 $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/;
4859 my @check_existing; # payby relevant to this payment_payby
4861 # set payby based on auto
4862 if ( $payby eq 'CARD' ) {
4863 $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) );
4864 @check_existing = qw( CARD DCRD );
4865 } elsif ( $payby eq 'CHEK' ) {
4866 $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) );
4867 @check_existing = qw( CHEK DCHK );
4870 $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' );
4873 $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized
4874 $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask
4875 $new->set( 'payname' => $opt{'payname'} );
4876 $new->set( 'payip' => $opt{'payip'} ); # will be preserved below
4878 my $conf = new FS::Conf;
4880 # compare to FS::cust_main::realtime_bop - check both to make sure working correctly
4881 if ( $payby eq 'CARD' &&
4882 ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save'))
4883 || $conf->exists('business-onlinepayment-verification')
4886 $new->set( 'paycvv' => $opt{'paycvv'} );
4888 $new->set( 'paycvv' => '');
4891 local $SIG{HUP} = 'IGNORE';
4892 local $SIG{INT} = 'IGNORE';
4893 local $SIG{QUIT} = 'IGNORE';
4894 local $SIG{TERM} = 'IGNORE';
4895 local $SIG{TSTP} = 'IGNORE';
4896 local $SIG{PIPE} = 'IGNORE';
4898 my $oldAutoCommit = $FS::UID::AutoCommit;
4899 local $FS::UID::AutoCommit = 0;
4902 # set fields specific to payment_payby
4903 if ( $payby eq 'CARD' ) {
4904 if ($opt{'bill_location'}) {
4905 $opt{'bill_location'}->set('custnum' => $self->custnum);
4906 my $error = $opt{'bill_location'}->find_or_insert;
4908 $dbh->rollback if $oldAutoCommit;
4911 $new->set( 'locationnum' => $opt{'bill_location'}->locationnum );
4913 foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) {
4914 $new->set( $field => $opt{$field} );
4917 foreach my $field ( qw(paytype paystate) ) {
4918 $new->set( $field => $opt{$field} );
4922 # other cust_payby to compare this to
4923 my @existing = $self->cust_payby(@check_existing);
4925 # fields that can overwrite blanks with values, but not values with blanks
4926 my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip );
4928 my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby
4930 # generally, we don't want to overwrite existing cust_payby with this,
4931 # but we can replace if we're only marking it auto or adding a preserved field
4932 # and we can avoid saving a total duplicate or merely turning off auto
4934 foreach my $cust_payby (@existing) {
4935 # check fields that absolutely should not change
4936 foreach my $field ($new->fields) {
4937 next if grep(/^$field$/, qw( custpaybynum payby weight ) );
4938 next if grep(/^$field$/, @preserve );
4939 next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
4940 # check if paymask exists, if so stop and don't save, no need for a duplicate.
4941 return '' if $new->get('paymask') eq $cust_payby->get('paymask');
4943 # now check fields that can replace if one value is blank
4945 foreach my $field (@preserve) {
4947 ( $new->get($field) and !$cust_payby->get($field) ) or
4948 ( $cust_payby->get($field) and !$new->get($field) )
4950 # prevention of overwriting values with blanks happens farther below
4952 } elsif ( $new->get($field) ne $cust_payby->get($field) ) {
4956 unless ( $replace ) {
4957 # nearly identical, now check weight
4958 if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) {
4959 # ignore identical cust_payby, and ignore attempts to turn off auto
4960 # no need to save or re-weight cust_payby (but still need to update/commit $self)
4961 $skip_cust_payby = 1;
4964 # otherwise, only change is to mark this as primary
4966 # if we got this far, we're definitely replacing
4973 $new->set( 'custpaybynum' => $old->custpaybynum );
4974 # don't turn off automatic payment (but allow it to be turned on)
4975 if ($new->payby =~ /^D/ and $new->payby ne $old->payby) {
4977 $new->set( 'payby' => $old->payby );
4978 $new->set( 'weight' => 1 );
4980 # make sure we're not overwriting values with blanks
4981 foreach my $field (@preserve) {
4982 if ( $old->get($field) and !$new->get($field) ) {
4983 $new->set( $field => $old->get($field) );
4988 # only overwrite cust_main bill_location if auto
4989 if ($opt{'auto'} && $opt{'bill_location'}) {
4990 $self->set('bill_location' => $opt{'bill_location'});
4991 my $error = $self->replace;
4993 $dbh->rollback if $oldAutoCommit;
4998 # done with everything except reweighting and saving cust_payby
4999 # still need to commit changes to cust_main and cust_location
5000 if ($skip_cust_payby) {
5001 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5005 # re-weight existing primary cust_pay for this payby
5007 foreach my $cust_payby (@existing) {
5008 # relies on cust_payby return order
5009 last unless $cust_payby->payby !~ /^D/;
5010 last if $cust_payby->weight > 1;
5011 next if $new->custpaybynum eq $cust_payby->custpaybynum;
5012 next if $cust_payby->weight < ($opt{'weight'} || 1);
5013 $cust_payby->weight( $cust_payby->weight + 1 );
5014 my $error = $cust_payby->replace;
5016 $dbh->rollback if $oldAutoCommit;
5017 return "Error reweighting cust_payby: $error";
5022 # finally, save cust_payby
5023 my $error = $old ? $new->replace($old) : $new->insert;
5025 $dbh->rollback if $oldAutoCommit;
5029 ${$opt{'saved_cust_payby'}} = $new
5030 if $opt{'saved_cust_payby'};
5032 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5037 =item remove_cvv_from_cust_payby PAYINFO
5039 Removes paycvv from associated cust_payby with matching PAYINFO.
5043 sub remove_cvv_from_cust_payby {
5044 my ($self,$payinfo) = @_;
5046 my $oldAutoCommit = $FS::UID::AutoCommit;
5047 local $FS::UID::AutoCommit = 0;
5050 foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) {
5051 next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo
5052 $cust_payby->paycvv('');
5053 my $error = $cust_payby->replace;
5055 $dbh->rollback if $oldAutoCommit;
5060 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5066 =head1 CLASS METHODS
5072 Class method that returns the list of possible status strings for customers
5073 (see L<the status method|/status>). For example:
5075 @statuses = FS::cust_main->statuses();
5081 keys %{ $self->statuscolors };
5084 =item cust_status_sql
5086 Returns an SQL fragment to determine the status of a cust_main record, as a
5091 sub cust_status_sql {
5093 for my $status ( FS::cust_main->statuses() ) {
5094 my $method = $status.'_sql';
5095 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
5104 Returns an SQL expression identifying prospective cust_main records (customers
5105 with no packages ever ordered)
5109 use vars qw($select_count_pkgs);
5110 $select_count_pkgs =
5111 "SELECT COUNT(*) FROM cust_pkg
5112 WHERE cust_pkg.custnum = cust_main.custnum";
5114 sub select_count_pkgs_sql {
5119 " 0 = ( $select_count_pkgs ) ";
5124 Returns an SQL expression identifying ordered cust_main records (customers with
5125 no active packages, but recurring packages not yet setup or one time charges
5131 FS::cust_main->none_active_sql.
5132 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
5137 Returns an SQL expression identifying active cust_main records (customers with
5138 active recurring packages).
5143 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
5146 =item none_active_sql
5148 Returns an SQL expression identifying cust_main records with no active
5149 recurring packages. This includes customers of status prospect, ordered,
5150 inactive, and suspended.
5154 sub none_active_sql {
5155 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
5160 Returns an SQL expression identifying inactive cust_main records (customers with
5161 no active recurring packages, but otherwise unsuspended/uncancelled).
5166 FS::cust_main->none_active_sql.
5167 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
5173 Returns an SQL expression identifying suspended cust_main records.
5178 sub suspended_sql { susp_sql(@_); }
5180 FS::cust_main->none_active_sql.
5181 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
5187 Returns an SQL expression identifying cancelled cust_main records.
5191 sub cancel_sql { shift->cancelled_sql(@_); }
5194 =item uncancelled_sql
5196 Returns an SQL expression identifying un-cancelled cust_main records.
5200 sub uncancelled_sql { uncancel_sql(@_); }
5203 "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
5208 Returns an SQL fragment to retreive the balance.
5213 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5214 WHERE cust_bill.custnum = cust_main.custnum )
5215 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
5216 WHERE cust_pay.custnum = cust_main.custnum )
5217 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
5218 WHERE cust_credit.custnum = cust_main.custnum )
5219 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
5220 WHERE cust_refund.custnum = cust_main.custnum )
5223 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
5225 Returns an SQL fragment to retreive the balance for this customer, optionally
5226 considering invoices with date earlier than START_TIME, and not
5227 later than END_TIME (total_owed_date minus total_unapplied_credits minus
5228 total_unapplied_payments).
5230 Times are specified as SQL fragments or numeric
5231 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5232 L<Date::Parse> for conversion functions. The empty string can be passed
5233 to disable that time constraint completely.
5235 Available options are:
5239 =item unapplied_date
5241 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)
5246 set to true to remove all customer comparison clauses, for totals
5251 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5256 JOIN clause (typically used with the total option)
5260 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
5261 time will be ignored. Note that START_TIME and END_TIME only limit the date
5262 range for invoices and I<unapplied> payments, credits, and refunds.
5268 sub balance_date_sql {
5269 my( $class, $start, $end, %opt ) = @_;
5271 my $cutoff = $opt{'cutoff'};
5273 my $owed = FS::cust_bill->owed_sql($cutoff);
5274 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
5275 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
5276 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5278 my $j = $opt{'join'} || '';
5280 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5281 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5282 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5283 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5285 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5286 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5287 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5288 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5293 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
5295 Returns an SQL fragment to retreive the total unapplied payments for this
5296 customer, only considering payments with date earlier than START_TIME, and
5297 optionally not later than END_TIME.
5299 Times are specified as SQL fragments or numeric
5300 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5301 L<Date::Parse> for conversion functions. The empty string can be passed
5302 to disable that time constraint completely.
5304 Available options are:
5308 sub unapplied_payments_date_sql {
5309 my( $class, $start, $end, %opt ) = @_;
5311 my $cutoff = $opt{'cutoff'};
5313 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5315 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
5316 'unapplied_date'=>1 );
5318 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
5321 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5323 Helper method for balance_date_sql; name (and usage) subject to change
5324 (suggestions welcome).
5326 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5327 cust_refund, cust_credit or cust_pay).
5329 If TABLE is "cust_bill" or the unapplied_date option is true, only
5330 considers records with date earlier than START_TIME, and optionally not
5331 later than END_TIME .
5335 sub _money_table_where {
5336 my( $class, $table, $start, $end, %opt ) = @_;
5339 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5340 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5341 push @where, "$table._date <= $start" if defined($start) && length($start);
5342 push @where, "$table._date > $end" if defined($end) && length($end);
5344 push @where, @{$opt{'where'}} if $opt{'where'};
5345 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5351 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5352 use FS::cust_main::Search;
5355 FS::cust_main::Search->search(@_);
5364 #=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5366 #Deprecated. Use event notification and message templates
5367 #(L<FS::msg_template>) instead.
5369 #Sends a templated email notification to the customer (see L<Text::Template>).
5371 #OPTIONS is a hash and may include
5373 #I<from> - the email sender (default is invoice_from)
5375 #I<to> - comma-separated scalar or arrayref of recipients
5376 # (default is invoicing_list)
5378 #I<subject> - The subject line of the sent email notification
5379 # (default is "Notice from company_name")
5381 #I<extra_fields> - a hashref of name/value pairs which will be substituted
5384 #The following variables are vavailable in the template.
5386 #I<$first> - the customer first name
5387 #I<$last> - the customer last name
5388 #I<$company> - the customer company
5389 #I<$payby> - a description of the method of payment for the customer
5390 # # would be nice to use FS::payby::shortname
5391 #I<$payinfo> - the account information used to collect for this customer
5392 #I<$expdate> - the expiration of the customer payment in seconds from epoch
5397 # my ($self, $template, %options) = @_;
5399 # return unless $conf->exists($template);
5401 # my $from = $conf->invoice_from_full($self->agentnum)
5402 # if $conf->exists('invoice_from', $self->agentnum);
5403 # $from = $options{from} if exists($options{from});
5405 # my $to = join(',', $self->invoicing_list_emailonly);
5406 # $to = $options{to} if exists($options{to});
5408 # my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5409 # if $conf->exists('company_name', $self->agentnum);
5410 # $subject = $options{subject} if exists($options{subject});
5412 # my $notify_template = new Text::Template (TYPE => 'ARRAY',
5413 # SOURCE => [ map "$_\n",
5414 # $conf->config($template)]
5416 # or die "can't create new Text::Template object: Text::Template::ERROR";
5417 # $notify_template->compile()
5418 # or die "can't compile template: Text::Template::ERROR";
5420 # $FS::notify_template::_template::company_name =
5421 # $conf->config('company_name', $self->agentnum);
5422 # $FS::notify_template::_template::company_address =
5423 # join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5425 # my $paydate = $self->paydate || '2037-12-31';
5426 # $FS::notify_template::_template::first = $self->first;
5427 # $FS::notify_template::_template::last = $self->last;
5428 # $FS::notify_template::_template::company = $self->company;
5429 # $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5430 # my $payby = $self->payby;
5431 # my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5432 # my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5434 # #credit cards expire at the end of the month/year of their exp date
5435 # if ($payby eq 'CARD' || $payby eq 'DCRD') {
5436 # $FS::notify_template::_template::payby = 'credit card';
5437 # ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5438 # $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5440 # }elsif ($payby eq 'COMP') {
5441 # $FS::notify_template::_template::payby = 'complimentary account';
5443 # $FS::notify_template::_template::payby = 'current method';
5445 # $FS::notify_template::_template::expdate = $expire_time;
5447 # for (keys %{$options{extra_fields}}){
5449 # ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5452 # send_email(from => $from,
5454 # subject => $subject,
5455 # body => $notify_template->fill_in( PACKAGE =>
5456 # 'FS::notify_template::_template' ),
5461 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5463 Generates a templated notification to the customer (see L<Text::Template>).
5465 OPTIONS is a hash and may include
5467 I<extra_fields> - a hashref of name/value pairs which will be substituted
5468 into the template. These values may override values mentioned below
5469 and those from the customer record.
5471 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5473 The following variables are available in the template instead of or in addition
5474 to the fields of the customer record.
5476 I<$payby> - a description of the method of payment for the customer
5477 # would be nice to use FS::payby::shortname
5478 I<$payinfo> - the masked account information used to collect for this customer
5479 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5480 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5484 # a lot like cust_bill::print_latex
5485 sub generate_letter {
5486 my ($self, $template, %options) = @_;
5488 warn "Template $template does not exist" && return
5489 unless $conf->exists($template) || $options{'template_text'};
5491 my $template_source = $options{'template_text'}
5492 ? [ $options{'template_text'} ]
5493 : [ map "$_\n", $conf->config($template) ];
5495 my $letter_template = new Text::Template
5497 SOURCE => $template_source,
5498 DELIMITERS => [ '[@--', '--@]' ],
5500 or die "can't create new Text::Template object: Text::Template::ERROR";
5502 $letter_template->compile()
5503 or die "can't compile template: Text::Template::ERROR";
5505 my %letter_data = map { $_ => $self->$_ } $self->fields;
5506 $letter_data{payinfo} = $self->mask_payinfo;
5508 #my $paydate = $self->paydate || '2037-12-31';
5509 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5511 my $payby = $self->payby;
5512 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5513 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5515 #credit cards expire at the end of the month/year of their exp date
5516 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5517 $letter_data{payby} = 'credit card';
5518 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5519 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5521 }elsif ($payby eq 'COMP') {
5522 $letter_data{payby} = 'complimentary account';
5524 $letter_data{payby} = 'current method';
5526 $letter_data{expdate} = $expire_time;
5528 for (keys %{$options{extra_fields}}){
5529 $letter_data{$_} = $options{extra_fields}->{$_};
5532 unless(exists($letter_data{returnaddress})){
5533 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5534 $self->agent_template)
5536 if ( length($retadd) ) {
5537 $letter_data{returnaddress} = $retadd;
5538 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5539 $letter_data{returnaddress} =
5540 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5544 ( $conf->config('company_name', $self->agentnum),
5545 $conf->config('company_address', $self->agentnum),
5549 $letter_data{returnaddress} = '~';
5553 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5555 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5557 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5559 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5563 ) or die "can't open temp file: $!\n";
5564 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5565 or die "can't write temp file: $!\n";
5567 $letter_data{'logo_file'} = $lh->filename;
5569 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5573 ) or die "can't open temp file: $!\n";
5575 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5577 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5578 return ($1, $letter_data{'logo_file'});
5582 =item print_ps TEMPLATE
5584 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5590 my($file, $lfile) = $self->generate_letter(@_);
5591 my $ps = FS::Misc::generate_ps($file);
5592 unlink($file.'.tex');
5598 =item print TEMPLATE
5600 Prints the filled in template.
5602 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5606 sub queueable_print {
5609 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5610 or die "invalid customer number: " . $opt{custnum};
5612 #do not backport this change to 3.x
5613 # my $error = $self->print( { 'template' => $opt{template} } );
5614 my $error = $self->print( $opt{'template'} );
5615 die $error if $error;
5619 my ($self, $template) = (shift, shift);
5621 [ $self->print_ps($template) ],
5622 'agentnum' => $self->agentnum,
5626 #these three subs should just go away once agent stuff is all config overrides
5628 sub agent_template {
5630 $self->_agent_plandata('agent_templatename');
5633 sub agent_invoice_from {
5635 $self->_agent_plandata('agent_invoice_from');
5638 sub _agent_plandata {
5639 my( $self, $option ) = @_;
5641 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5642 #agent-specific Conf
5644 use FS::part_event::Condition;
5646 my $agentnum = $self->agentnum;
5648 my $regexp = regexp_sql();
5650 my $part_event_option =
5652 'select' => 'part_event_option.*',
5653 'table' => 'part_event_option',
5655 LEFT JOIN part_event USING ( eventpart )
5656 LEFT JOIN part_event_option AS peo_agentnum
5657 ON ( part_event.eventpart = peo_agentnum.eventpart
5658 AND peo_agentnum.optionname = 'agentnum'
5659 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5661 LEFT JOIN part_event_condition
5662 ON ( part_event.eventpart = part_event_condition.eventpart
5663 AND part_event_condition.conditionname = 'cust_bill_age'
5665 LEFT JOIN part_event_condition_option
5666 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5667 AND part_event_condition_option.optionname = 'age'
5670 #'hashref' => { 'optionname' => $option },
5671 #'hashref' => { 'part_event_option.optionname' => $option },
5673 " WHERE part_event_option.optionname = ". dbh->quote($option).
5674 " AND action = 'cust_bill_send_agent' ".
5675 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5676 " AND peo_agentnum.optionname = 'agentnum' ".
5677 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5679 CASE WHEN part_event_condition_option.optionname IS NULL
5681 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5683 , part_event.weight".
5687 unless ( $part_event_option ) {
5688 return $self->agent->invoice_template || ''
5689 if $option eq 'agent_templatename';
5693 $part_event_option->optionvalue;
5697 sub process_o2m_qsearch {
5700 return qsearch($table, @_) unless $table eq 'contact';
5702 my $hashref = shift;
5703 my %hash = %$hashref;
5704 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5705 or die 'guru meditation #4343';
5707 qsearch({ 'table' => 'contact',
5708 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5709 'hashref' => \%hash,
5710 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5711 " cust_contact.custnum = $custnum "
5715 sub process_o2m_qsearchs {
5718 return qsearchs($table, @_) unless $table eq 'contact';
5720 my $hashref = shift;
5721 my %hash = %$hashref;
5722 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5723 or die 'guru meditation #2121';
5725 qsearchs({ 'table' => 'contact',
5726 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5727 'hashref' => \%hash,
5728 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5729 " cust_contact.custnum = $custnum "
5733 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5735 Subroutine (not a method), designed to be called from the queue.
5737 Takes a list of options and values.
5739 Pulls up the customer record via the custnum option and calls bill_and_collect.
5744 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5746 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5747 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5749 #without this errors don't get rolled back
5750 $args{'fatal'} = 1; # runs from job queue, will be caught
5752 $cust_main->bill_and_collect( %args );
5755 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5757 Like queued_bill, but instead of C<bill_and_collect>, just runs the
5758 C<collect> part. This is used in batch tax calculation, where invoice
5759 generation and collection events have to be completely separated.
5763 sub queued_collect {
5765 my $cust_main = FS::cust_main->by_key($args{'custnum'});
5767 $cust_main->collect(%args);
5770 sub process_bill_and_collect {
5773 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5774 or die "custnum '$param->{custnum}' not found!\n";
5775 $param->{'job'} = $job;
5776 $param->{'fatal'} = 1; # runs from job queue, will be caught
5777 $param->{'retry'} = 1;
5779 $cust_main->bill_and_collect( %$param );
5782 =item pending_invoice_count
5784 Return number of cust_bill with pending=Y for this customer
5788 sub pending_invoice_count {
5789 FS::cust_bill->count( 'custnum = '.shift->custnum."AND pending = 'Y'" );
5792 #starting to take quite a while for big dbs
5793 # (JRNL: journaled so it only happens once per database)
5794 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5795 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5796 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5797 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5798 # JRNL leading/trailing spaces in first, last, company
5799 # JRNL migrate to cust_payby
5800 # - otaker upgrade? journal and call it good? (double check to make sure
5801 # we're not still setting otaker here)
5803 #only going to get worse with new location stuff...
5805 sub _upgrade_data { #class method
5806 my ($class, %opts) = @_;
5809 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5812 #this seems to be the only expensive one.. why does it take so long?
5813 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5815 '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';
5816 FS::upgrade_journal->set_done('cust_main__signupdate');
5819 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5821 # fix yyyy-m-dd formatted paydates
5822 if ( driver_name =~ /^mysql/i ) {
5824 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5825 } else { # the SQL standard
5827 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5829 FS::upgrade_journal->set_done('cust_main__paydate');
5832 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5834 push @statements, #fix the weird BILL with a cc# in payinfo problem
5836 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5838 FS::upgrade_journal->set_done('cust_main__payinfo');
5843 foreach my $sql ( @statements ) {
5844 my $sth = dbh->prepare($sql) or die dbh->errstr;
5845 $sth->execute or die $sth->errstr;
5846 #warn ( (time - $t). " seconds\n" );
5850 local($ignore_expired_card) = 1;
5851 local($ignore_banned_card) = 1;
5852 local($skip_fuzzyfiles) = 1;
5853 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5855 unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
5857 #we don't want to decrypt them, just stuff them as-is into cust_payby
5858 local(@encrypted_fields) = ();
5860 local($FS::cust_payby::ignore_expired_card) = 1;
5861 local($FS::cust_payby::ignore_banned_card) = 1;
5862 local($FS::cust_payby::ignore_cardtype) = 1;
5864 my @payfields = qw( payby payinfo paycvv paymask
5865 paydate paystart_month paystart_year payissue
5866 payname paystate paytype payip
5869 my $search = new FS::Cursor {
5870 'table' => 'cust_main',
5871 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
5874 while (my $cust_main = $search->fetch) {
5876 unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
5878 my $cust_payby = new FS::cust_payby {
5879 'custnum' => $cust_main->custnum,
5881 map { $_ => $cust_main->$_(); } @payfields
5884 my $error = $cust_payby->insert;
5885 die $error if $error;
5889 # at the time we do this, also migrate paytype into cust_pay_batch
5890 # so that batches that are open before the migration can still be
5892 if ( $cust_main->get('paytype') ) {
5893 my @cust_pay_batch = qsearch('cust_pay_batch', {
5894 'custnum' => $cust_main->custnum,
5898 foreach my $cust_pay_batch (@cust_pay_batch) {
5899 $cust_pay_batch->set('paytype', $cust_main->get('paytype'));
5900 my $error = $cust_pay_batch->replace;
5901 die "$error (setting cust_pay_batch.paytype)" if $error;
5905 $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP';
5907 $cust_main->invoice_attn( $cust_main->payname )
5908 if $cust_main->payby eq 'BILL' && $cust_main->payname;
5909 $cust_main->po_number( $cust_main->payinfo )
5910 if $cust_main->payby eq 'BILL' && $cust_main->payinfo;
5912 $cust_main->setfield($_, '') foreach @payfields;
5913 my $error = $cust_main->replace;
5914 die "Error upgradging payment information for custnum ".
5915 $cust_main->custnum. ": $error"
5920 FS::upgrade_journal->set_done('cust_main__cust_payby');
5923 FS::cust_main::Location->_upgrade_data(%opts);
5925 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5927 foreach my $cust_main ( qsearch({
5928 'table' => 'cust_main',
5930 'extra_sql' => 'WHERE '.
5932 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5933 qw( first last company )
5936 my $error = $cust_main->replace;
5937 die $error if $error;
5940 FS::upgrade_journal->set_done('cust_main__trimspaces');
5944 $class->_upgrade_otaker(%opts);
5946 # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
5947 # existing records will be encrypted in queueable_upgrade (below)
5948 unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
5949 eval "use FS::Setup";
5951 FS::Setup::enable_encryption();
5956 sub queueable_upgrade {
5959 ### encryption gets turned on in _upgrade_data, above
5961 eval "use FS::upgrade_journal";
5964 # prior to 2013 (commit f16665c9) payinfo was stored in history if not encrypted,
5965 # clear that out before encrypting/tokenizing anything else
5966 if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
5967 foreach my $table ('cust_payby','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
5968 my $sql = 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
5969 my $sth = dbh->prepare($sql) or die dbh->errstr;
5970 $sth->execute or die $sth->errstr;
5972 FS::upgrade_journal->set_done('clear_payinfo_history');
5975 # fix Tokenized paycardtype and encrypt old records
5976 if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
5977 || ! FS::upgrade_journal->is_done('encryption_check')
5981 # allow replacement of closed cust_pay/cust_refund records
5982 local $FS::payinfo_Mixin::allow_closed_replace = 1;
5984 # because it looks like nothing's changing
5985 local $FS::Record::no_update_diff = 1;
5987 # commit everything immediately
5988 local $FS::UID::AutoCommit = 1;
5990 # encrypt what's there
5991 foreach my $table ('cust_payby','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
5992 my $tclass = 'FS::'.$table;
5995 while (my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)) {
5996 my $record = $tclass->by_key($recnum);
5997 next unless $record; # small chance it's been deleted, that's ok
5998 next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
5999 # window for possible conflict is practically nonexistant,
6000 # but just in case...
6001 $record = $record->select_for_update;
6002 if (!$record->custnum && $table eq 'cust_pay_pending') {
6003 $record->set('custnum_pending',1);
6005 $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
6007 local($ignore_expired_card) = 1;
6008 local($ignore_banned_card) = 1;
6009 local($skip_fuzzyfiles) = 1;
6010 local($import) = 1;#prevent automatic geocoding (need its own variable?)
6012 my $error = $record->replace;
6013 die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
6017 FS::upgrade_journal->set_done('paycardtype_Tokenized');
6018 FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
6021 # now that everything's encrypted, tokenize...
6022 FS::cust_main::Billing_Realtime::token_check(@_);
6025 # not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
6026 # cust_payby might get deleted while this runs
6028 sub _upgrade_next_recnum {
6029 my ($dbh,$table,$lastrecnum,$recnums) = @_;
6030 my $recnum = shift @$recnums;
6031 return $recnum if $recnum;
6032 my $tclass = 'FS::'.$table;
6033 my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : '';
6034 my $sql = 'SELECT '.$tclass->primary_key.
6036 ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
6037 " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
6038 " AND ( length(payinfo) < 80$paycardtypecheck ) ".
6039 ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
6040 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
6041 $sth->execute() or die $sth->errstr;
6043 while (my $rec = $sth->fetchrow_hashref) {
6044 push @$recnums, $rec->{$tclass->primary_key};
6047 $$lastrecnum = $$recnums[-1];
6048 return shift @$recnums;
6057 The delete method should possibly take an FS::cust_main object reference
6058 instead of a scalar customer number.
6060 Bill and collect options should probably be passed as references instead of a
6063 There should probably be a configuration file with a list of allowed credit
6066 No multiple currency support (probably a larger project than just this module).
6068 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
6070 Birthdates rely on negative epoch values.
6072 The payby for card/check batches is broken. With mixed batching, bad
6075 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
6079 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
6080 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
6081 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.