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.
3318 # ( cust_contact.classnum IN (1,2,3) )
3320 # ( cust_contact.classnum IS NULL )
3323 # ( cust_contact.invoice_dest = 'Y' )
3325 # ( cust_contact.message_dest = 'Y' )
3333 if ($_ eq 'invoice' || $_ eq 'message') {
3334 push @and_dest, " cust_contact.${_}_dest = 'Y' ";
3335 } elsif ($_ eq '0') {
3336 push @or_classnum, ' cust_contact.classnum IS NULL ';
3337 } elsif ( /^\d+$/ ) {
3338 push @classnums, $_;
3340 croak "bad classnum argument '$_'";
3344 push @or_classnum, 'cust_contact.classnum IN ('.join(',',@classnums).')'
3347 if (@or_classnum || @and_dest) { # catch, no arguments given
3348 $search->{extra_sql} .= ' AND ( ';
3351 $search->{extra_sql} .= join ' OR ', map {" ($_) "} @or_classnum;
3352 $search->{extra_sql} .= ' AND ( ' if @and_dest;
3356 $search->{extra_sql} .= join ' OR ', map {" ($_) "} @and_dest;
3357 $search->{extra_sql} .= ' ) ' if @or_classnum;
3360 $search->{extra_sql} .= ' ) ';
3362 warn "\$extra_sql: $search->{extra_sql} \n" if $DEBUG;
3368 =item contact_list_email [ CLASSNUM, ... ]
3370 Same as L</contact_list>, but returns email destinations instead of contact
3375 sub contact_list_email {
3377 my @contacts = $self->contact_list(@_);
3379 foreach my $contact (@contacts) {
3380 foreach my $contact_email ($contact->contact_email) {
3381 push @emails, Email::Address->new( $contact->firstlast,
3382 $contact_email->emailaddress
3389 =item referral_custnum_cust_main
3391 Returns the customer who referred this customer (or the empty string, if
3392 this customer was not referred).
3394 Note the difference with referral_cust_main method: This method,
3395 referral_custnum_cust_main returns the single customer (if any) who referred
3396 this customer, while referral_cust_main returns an array of customers referred
3401 sub referral_custnum_cust_main {
3403 return '' unless $self->referral_custnum;
3404 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3407 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3409 Returns an array of customers referred by this customer (referral_custnum set
3410 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3411 customers referred by customers referred by this customer and so on, inclusive.
3412 The default behavior is DEPTH 1 (no recursion).
3414 Note the difference with referral_custnum_cust_main method: This method,
3415 referral_cust_main, returns an array of customers referred BY this customer,
3416 while referral_custnum_cust_main returns the single customer (if any) who
3417 referred this customer.
3421 sub referral_cust_main {
3423 my $depth = @_ ? shift : 1;
3424 my $exclude = @_ ? shift : {};
3427 map { $exclude->{$_->custnum}++; $_; }
3428 grep { ! $exclude->{ $_->custnum } }
3429 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3433 map { $_->referral_cust_main($depth-1, $exclude) }
3440 =item referral_cust_main_ncancelled
3442 Same as referral_cust_main, except only returns customers with uncancelled
3447 sub referral_cust_main_ncancelled {
3449 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3452 =item referral_cust_pkg [ DEPTH ]
3454 Like referral_cust_main, except returns a flat list of all unsuspended (and
3455 uncancelled) packages for each customer. The number of items in this list may
3456 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3460 sub referral_cust_pkg {
3462 my $depth = @_ ? shift : 1;
3464 map { $_->unsuspended_pkgs }
3465 grep { $_->unsuspended_pkgs }
3466 $self->referral_cust_main($depth);
3469 =item referring_cust_main
3471 Returns the single cust_main record for the customer who referred this customer
3472 (referral_custnum), or false.
3476 sub referring_cust_main {
3478 return '' unless $self->referral_custnum;
3479 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3482 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3484 Applies a credit to this customer. If there is an error, returns the error,
3485 otherwise returns false.
3487 REASON can be a text string, an FS::reason object, or a scalar reference to
3488 a reasonnum. If a text string, it will be automatically inserted as a new
3489 reason, and a 'reason_type' option must be passed to indicate the
3490 FS::reason_type for the new reason.
3492 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3493 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3494 I<commission_pkgnum>.
3496 Any other options are passed to FS::cust_credit::insert.
3501 my( $self, $amount, $reason, %options ) = @_;
3503 my $cust_credit = new FS::cust_credit {
3504 'custnum' => $self->custnum,
3505 'amount' => $amount,
3508 if ( ref($reason) ) {
3510 if ( ref($reason) eq 'SCALAR' ) {
3511 $cust_credit->reasonnum( $$reason );
3513 $cust_credit->reasonnum( $reason->reasonnum );
3517 $cust_credit->set('reason', $reason)
3520 $cust_credit->$_( delete $options{$_} )
3521 foreach grep exists($options{$_}),
3522 qw( addlinfo eventnum ),
3523 map "commission_$_", qw( agentnum salesnum pkgnum );
3525 $cust_credit->insert(%options);
3529 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3531 Creates a one-time charge for this customer. If there is an error, returns
3532 the error, otherwise returns false.
3534 New-style, with a hashref of options:
3536 my $error = $cust_main->charge(
3540 'start_date' => str2time('7/4/2009'),
3541 'pkg' => 'Description',
3542 'comment' => 'Comment',
3543 'additional' => [], #extra invoice detail
3544 'classnum' => 1, #pkg_class
3546 'setuptax' => '', # or 'Y' for tax exempt
3548 'locationnum'=> 1234, # optional
3551 'taxclass' => 'Tax class',
3554 'taxproduct' => 2, #part_pkg_taxproduct
3555 'override' => {}, #XXX describe
3557 #will be filled in with the new object
3558 'cust_pkg_ref' => \$cust_pkg,
3560 #generate an invoice immediately
3562 'invoice_terms' => '', #with these terms
3568 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3572 #super false laziness w/quotation::charge
3575 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3576 my ( $pkg, $comment, $additional );
3577 my ( $setuptax, $taxclass ); #internal taxes
3578 my ( $taxproduct, $override ); #vendor (CCH) taxes
3580 my $separate_bill = '';
3581 my $cust_pkg_ref = '';
3582 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3584 my ( $discountnum, $discountnum_amount, $discountnum_percent ) = ( '','','' );
3585 if ( ref( $_[0] ) ) {
3586 $amount = $_[0]->{amount};
3587 $setup_cost = $_[0]->{setup_cost};
3588 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3589 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3590 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3591 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3592 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3593 : '$'. sprintf("%.2f",$amount);
3594 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3595 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3596 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3597 $additional = $_[0]->{additional} || [];
3598 $taxproduct = $_[0]->{taxproductnum};
3599 $override = { '' => $_[0]->{tax_override} };
3600 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3601 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3602 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3603 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3604 $separate_bill = $_[0]->{separate_bill} || '';
3605 $discountnum = $_[0]->{setup_discountnum};
3606 $discountnum_amount = $_[0]->{setup_discountnum_amount};
3607 $discountnum_percent = $_[0]->{setup_discountnum_percent};
3613 $pkg = @_ ? shift : 'One-time charge';
3614 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3616 $taxclass = @_ ? shift : '';
3620 local $SIG{HUP} = 'IGNORE';
3621 local $SIG{INT} = 'IGNORE';
3622 local $SIG{QUIT} = 'IGNORE';
3623 local $SIG{TERM} = 'IGNORE';
3624 local $SIG{TSTP} = 'IGNORE';
3625 local $SIG{PIPE} = 'IGNORE';
3627 my $oldAutoCommit = $FS::UID::AutoCommit;
3628 local $FS::UID::AutoCommit = 0;
3631 my $part_pkg = new FS::part_pkg ( {
3633 'comment' => $comment,
3637 'classnum' => ( $classnum ? $classnum : '' ),
3638 'setuptax' => $setuptax,
3639 'taxclass' => $taxclass,
3640 'taxproductnum' => $taxproduct,
3641 'setup_cost' => $setup_cost,
3644 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3645 ( 0 .. @$additional - 1 )
3647 'additional_count' => scalar(@$additional),
3648 'setup_fee' => $amount,
3651 my $error = $part_pkg->insert( options => \%options,
3652 tax_overrides => $override,
3655 $dbh->rollback if $oldAutoCommit;
3659 my $pkgpart = $part_pkg->pkgpart;
3660 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3661 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3662 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3663 $error = $type_pkgs->insert;
3665 $dbh->rollback if $oldAutoCommit;
3670 my $cust_pkg = new FS::cust_pkg ( {
3671 'custnum' => $self->custnum,
3672 'pkgpart' => $pkgpart,
3673 'quantity' => $quantity,
3674 'start_date' => $start_date,
3675 'no_auto' => $no_auto,
3676 'separate_bill' => $separate_bill,
3677 'locationnum' => $locationnum,
3678 'setup_discountnum' => $discountnum,
3679 'setup_discountnum_amount' => $discountnum_amount,
3680 'setup_discountnum_percent' => $discountnum_percent,
3683 $error = $cust_pkg->insert;
3685 $dbh->rollback if $oldAutoCommit;
3687 } elsif ( $cust_pkg_ref ) {
3688 ${$cust_pkg_ref} = $cust_pkg;
3692 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3693 'pkg_list' => [ $cust_pkg ],
3696 $dbh->rollback if $oldAutoCommit;
3701 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3706 #=item charge_postal_fee
3708 #Applies a one time charge this customer. If there is an error,
3709 #returns the error, returns the cust_pkg charge object or false
3710 #if there was no charge.
3714 # This should be a customer event. For that to work requires that bill
3715 # also be a customer event.
3717 sub charge_postal_fee {
3720 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3721 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3723 my $cust_pkg = new FS::cust_pkg ( {
3724 'custnum' => $self->custnum,
3725 'pkgpart' => $pkgpart,
3729 my $error = $cust_pkg->insert;
3730 $error ? $error : $cust_pkg;
3733 =item num_cust_attachment_deleted
3735 Returns the number of deleted attachments for this customer (see
3736 L<FS::num_cust_attachment>).
3740 sub num_cust_attachments_deleted {
3743 " SELECT COUNT(*) FROM cust_attachment ".
3744 " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0",
3751 Returns the most recent invnum (invoice number) for this customer.
3758 " SELECT MAX(invnum) FROM cust_bill WHERE custnum = ?",
3763 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3765 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3767 Optionally, a list or hashref of additional arguments to the qsearch call can
3774 my $opt = ref($_[0]) ? shift : { @_ };
3776 #return $self->num_cust_bill unless wantarray || keys %$opt;
3778 $opt->{'table'} = 'cust_bill';
3779 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3780 $opt->{'hashref'}{'custnum'} = $self->custnum;
3781 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3783 map { $_ } #behavior of sort undefined in scalar context
3784 sort { $a->_date <=> $b->_date }
3788 =item open_cust_bill
3790 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3795 sub open_cust_bill {
3799 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3805 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3807 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3811 sub legacy_cust_bill {
3814 #return $self->num_legacy_cust_bill unless wantarray;
3816 map { $_ } #behavior of sort undefined in scalar context
3817 sort { $a->_date <=> $b->_date }
3818 qsearch({ 'table' => 'legacy_cust_bill',
3819 'hashref' => { 'custnum' => $self->custnum, },
3820 'order_by' => 'ORDER BY _date ASC',
3824 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3826 Returns all the statements (see L<FS::cust_statement>) for this customer.
3828 Optionally, a list or hashref of additional arguments to the qsearch call can
3833 =item cust_bill_void
3835 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3839 sub cust_bill_void {
3842 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3843 sort { $a->_date <=> $b->_date }
3844 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3847 sub cust_statement {
3849 my $opt = ref($_[0]) ? shift : { @_ };
3851 #return $self->num_cust_statement unless wantarray || keys %$opt;
3853 $opt->{'table'} = 'cust_statement';
3854 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3855 $opt->{'hashref'}{'custnum'} = $self->custnum;
3856 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3858 map { $_ } #behavior of sort undefined in scalar context
3859 sort { $a->_date <=> $b->_date }
3863 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3865 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3867 Optionally, a list or hashref of additional arguments to the qsearch call can
3868 be passed following the SVCDB.
3875 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3876 warn "$me svc_x requires a svcdb";
3879 my $opt = ref($_[0]) ? shift : { @_ };
3881 $opt->{'table'} = $svcdb;
3882 $opt->{'addl_from'} =
3883 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3884 ($opt->{'addl_from'} || '');
3886 my $custnum = $self->custnum;
3887 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3888 my $where = "cust_pkg.custnum = $custnum";
3890 my $extra_sql = $opt->{'extra_sql'} || '';
3891 if ( keys %{ $opt->{'hashref'} } ) {
3892 $extra_sql = " AND $where $extra_sql";
3895 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3896 $extra_sql = "WHERE $where AND $1";
3899 $extra_sql = "WHERE $where $extra_sql";
3902 $opt->{'extra_sql'} = $extra_sql;
3907 # required for use as an eventtable;
3910 $self->svc_x('svc_acct', @_);
3915 Returns all the credits (see L<FS::cust_credit>) for this customer.
3922 #return $self->num_cust_credit unless wantarray;
3924 map { $_ } #behavior of sort undefined in scalar context
3925 sort { $a->_date <=> $b->_date }
3926 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3929 =item cust_credit_pkgnum
3931 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3932 package when using experimental package balances.
3936 sub cust_credit_pkgnum {
3937 my( $self, $pkgnum ) = @_;
3938 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3939 sort { $a->_date <=> $b->_date }
3940 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3941 'pkgnum' => $pkgnum,
3946 =item cust_credit_void
3948 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3952 sub cust_credit_void {
3955 sort { $a->_date <=> $b->_date }
3956 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3961 Returns all the payments (see L<FS::cust_pay>) for this customer.
3967 my $opt = ref($_[0]) ? shift : { @_ };
3969 return $self->num_cust_pay unless wantarray || keys %$opt;
3971 $opt->{'table'} = 'cust_pay';
3972 $opt->{'hashref'}{'custnum'} = $self->custnum;
3974 map { $_ } #behavior of sort undefined in scalar context
3975 sort { $a->_date <=> $b->_date }
3982 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3983 called automatically when the cust_pay method is used in a scalar context.
3989 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3990 my $sth = dbh->prepare($sql) or die dbh->errstr;
3991 $sth->execute($self->custnum) or die $sth->errstr;
3992 $sth->fetchrow_arrayref->[0];
3995 =item unapplied_cust_pay
3997 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
4001 sub unapplied_cust_pay {
4005 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
4011 =item cust_pay_pkgnum
4013 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4014 package when using experimental package balances.
4018 sub cust_pay_pkgnum {
4019 my( $self, $pkgnum ) = @_;
4020 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4021 sort { $a->_date <=> $b->_date }
4022 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4023 'pkgnum' => $pkgnum,
4030 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4036 map { $_ } #return $self->num_cust_pay_void unless wantarray;
4037 sort { $a->_date <=> $b->_date }
4038 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4041 =item cust_pay_pending
4043 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4044 (without status "done").
4048 sub cust_pay_pending {
4050 return $self->num_cust_pay_pending unless wantarray;
4051 sort { $a->_date <=> $b->_date }
4052 qsearch( 'cust_pay_pending', {
4053 'custnum' => $self->custnum,
4054 'status' => { op=>'!=', value=>'done' },
4059 =item cust_pay_pending_attempt
4061 Returns all payment attempts / declined payments for this customer, as pending
4062 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4063 a corresponding payment (see L<FS::cust_pay>).
4067 sub cust_pay_pending_attempt {
4069 return $self->num_cust_pay_pending_attempt unless wantarray;
4070 sort { $a->_date <=> $b->_date }
4071 qsearch( 'cust_pay_pending', {
4072 'custnum' => $self->custnum,
4079 =item num_cust_pay_pending
4081 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4082 customer (without status "done"). Also called automatically when the
4083 cust_pay_pending method is used in a scalar context.
4087 sub num_cust_pay_pending {
4090 " SELECT COUNT(*) FROM cust_pay_pending ".
4091 " WHERE custnum = ? AND status != 'done' ",
4096 =item num_cust_pay_pending_attempt
4098 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4099 customer, with status "done" but without a corresp. Also called automatically when the
4100 cust_pay_pending method is used in a scalar context.
4104 sub num_cust_pay_pending_attempt {
4107 " SELECT COUNT(*) FROM cust_pay_pending ".
4108 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4115 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4121 map { $_ } #return $self->num_cust_refund unless wantarray;
4122 sort { $a->_date <=> $b->_date }
4123 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4126 =item display_custnum
4128 Returns the displayed customer number for this customer: agent_custid if
4129 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4133 sub display_custnum {
4136 return $self->agent_custid
4137 if $default_agent_custid && $self->agent_custid;
4139 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
4143 sprintf('%0'.($custnum_display_length||8).'d', $self->custnum)
4144 } elsif ( $custnum_display_length ) {
4145 return sprintf('%0'.$custnum_display_length.'d', $self->custnum);
4147 return $self->custnum;
4153 Returns a name string for this customer, either "Company (Last, First)" or
4160 my $name = $self->contact;
4161 $name = $self->company. " ($name)" if $self->company;
4165 =item batch_payment_payname
4167 Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company,
4168 based on if a company name exists and is the account being used a business account.
4172 sub batch_payment_payname {
4174 my $cust_pay_batch = shift;
4177 if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; }
4178 else { $name = $self->first .' '. $self->last; }
4180 $name = $self->company
4181 if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company);
4186 =item service_contact
4188 Returns the L<FS::contact> object for this customer that has the 'Service'
4189 contact class, or undef if there is no such contact. Deprecated; don't use
4194 sub service_contact {
4196 if ( !exists($self->{service_contact}) ) {
4197 my $classnum = $self->scalar_sql(
4198 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4199 ) || 0; #if it's zero, qsearchs will return nothing
4200 my $cust_contact = qsearchs('cust_contact', {
4201 'classnum' => $classnum,
4202 'custnum' => $self->custnum,
4204 $self->{service_contact} = $cust_contact->contact if $cust_contact;
4206 $self->{service_contact};
4211 Returns a name string for this (service/shipping) contact, either
4212 "Company (Last, First)" or "Last, First".
4219 my $name = $self->ship_contact;
4220 $name = $self->company. " ($name)" if $self->company;
4226 Returns a name string for this customer, either "Company" or "First Last".
4232 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4235 =item ship_name_short
4237 Returns a name string for this (service/shipping) contact, either "Company"
4242 sub ship_name_short {
4244 $self->service_contact
4245 ? $self->ship_contact_firstlast
4251 Returns this customer's full (billing) contact name only, "Last, First"
4257 $self->get('last'). ', '. $self->first;
4262 Returns this customer's full (shipping) contact name only, "Last, First"
4268 my $contact = $self->service_contact || $self;
4269 $contact->get('last') . ', ' . $contact->get('first');
4272 =item contact_firstlast
4274 Returns this customers full (billing) contact name only, "First Last".
4278 sub contact_firstlast {
4280 $self->first. ' '. $self->get('last');
4283 =item ship_contact_firstlast
4285 Returns this customer's full (shipping) contact name only, "First Last".
4289 sub ship_contact_firstlast {
4291 my $contact = $self->service_contact || $self;
4292 $contact->get('first') . ' '. $contact->get('last');
4295 sub bill_country_full {
4297 $self->bill_location->country_full;
4300 sub ship_country_full {
4302 $self->ship_location->country_full;
4305 =item county_state_county [ PREFIX ]
4307 Returns a string consisting of just the county, state and country.
4311 sub county_state_country {
4314 if ( @_ && $_[0] && $self->has_ship_address ) {
4315 $locationnum = $self->ship_locationnum;
4317 $locationnum = $self->bill_locationnum;
4319 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4320 $cust_location->county_state_country;
4323 =item geocode DATA_VENDOR
4325 Returns a value for the customer location as encoded by DATA_VENDOR.
4326 Currently this only makes sense for "CCH" as DATA_VENDOR.
4334 Returns a status string for this customer, currently:
4340 No packages have ever been ordered. Displayed as "No packages".
4344 Recurring packages all are new (not yet billed).
4348 One or more recurring packages is active.
4352 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
4356 All non-cancelled recurring packages are suspended.
4360 All recurring packages are cancelled.
4364 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4365 cust_main-status_module configuration option.
4369 sub status { shift->cust_status(@_); }
4373 return $self->hashref->{cust_status} if $self->hashref->{cust_status};
4374 for my $status ( FS::cust_main->statuses() ) {
4375 my $method = $status.'_sql';
4376 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4377 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4378 $sth->execute( ($self->custnum) x $numnum )
4379 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4380 if ( $sth->fetchrow_arrayref->[0] ) {
4381 $self->hashref->{cust_status} = $status;
4387 =item is_status_delay_cancel
4389 Returns true if customer status is 'suspended'
4390 and all suspended cust_pkg return true for
4391 cust_pkg->is_status_delay_cancel.
4393 This is not a real status, this only meant for hacking display
4394 values, because otherwise treating the customer as suspended is
4395 really the whole point of the delay_cancel option.
4399 sub is_status_delay_cancel {
4401 return 0 unless $self->status eq 'suspended';
4402 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4403 return 0 unless $cust_pkg->is_status_delay_cancel;
4408 =item ucfirst_cust_status
4410 =item ucfirst_status
4412 Deprecated, use the cust_status_label method instead.
4414 Returns the status with the first character capitalized.
4418 sub ucfirst_status {
4419 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4420 local($ucfirst_nowarn) = 1;
4421 shift->ucfirst_cust_status(@_);
4424 sub ucfirst_cust_status {
4425 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
4427 ucfirst($self->cust_status);
4430 =item cust_status_label
4434 Returns the display label for this status.
4438 sub status_label { shift->cust_status_label(@_); }
4440 sub cust_status_label {
4442 __PACKAGE__->statuslabels->{$self->cust_status};
4447 Returns a hex triplet color string for this customer's status.
4451 sub statuscolor { shift->cust_statuscolor(@_); }
4453 sub cust_statuscolor {
4455 __PACKAGE__->statuscolors->{$self->cust_status};
4458 =item tickets [ STATUS ]
4460 Returns an array of hashes representing the customer's RT tickets.
4462 An optional status (or arrayref or hashref of statuses) may be specified.
4468 my $status = ( @_ && $_[0] ) ? shift : '';
4470 my $num = $conf->config('cust_main-max_tickets') || 10;
4473 if ( $conf->config('ticket_system') ) {
4474 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4476 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4485 foreach my $priority (
4486 $conf->config('ticket_system-custom_priority_field-values'), ''
4488 last if scalar(@tickets) >= $num;
4490 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4491 $num - scalar(@tickets),
4502 =item appointments [ STATUS ]
4504 Returns an array of hashes representing the customer's RT tickets which
4511 my $status = ( @_ && $_[0] ) ? shift : '';
4513 return () unless $conf->config('ticket_system');
4515 my $queueid = $conf->config('ticket_system-appointment-queueid');
4517 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4526 # Return services representing svc_accts in customer support packages
4527 sub support_services {
4529 my %packages = map { $_ => 1 } $conf->config('support_packages');
4531 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4532 grep { $_->part_svc->svcdb eq 'svc_acct' }
4533 map { $_->cust_svc }
4534 grep { exists $packages{ $_->pkgpart } }
4535 $self->ncancelled_pkgs;
4539 # Return a list of latitude/longitude for one of the services (if any)
4540 sub service_coordinates {
4544 grep { $_->latitude && $_->longitude }
4546 map { $_->cust_svc }
4547 $self->ncancelled_pkgs;
4549 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4554 Returns a masked version of the named field
4559 my ($self,$field) = @_;
4563 'x'x(length($self->getfield($field))-4).
4564 substr($self->getfield($field), (length($self->getfield($field))-4));
4568 =item payment_history
4570 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4571 cust_credit and cust_refund objects. Each hashref has the following fields:
4573 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4575 I<date> - value of _date field, unix timestamp
4577 I<date_pretty> - user-friendly date
4579 I<description> - user-friendly description of item
4581 I<amount> - impact of item on user's balance
4582 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4583 Not to be confused with the native 'amount' field in cust_credit, see below.
4585 I<amount_pretty> - includes money char
4587 I<balance> - customer balance, chronologically as of this item
4589 I<balance_pretty> - includes money char
4591 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4593 I<paid> - amount paid for cust_pay records, undef for other types
4595 I<credit> - amount credited for cust_credit records, undef for other types.
4596 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4598 I<refund> - amount refunded for cust_refund records, undef for other types
4600 The four table-specific keys always have positive values, whether they reflect charges or payments.
4602 The following options may be passed to this method:
4604 I<line_items> - if true, returns charges ('Line item') rather than invoices
4606 I<start_date> - unix timestamp, only include records on or after.
4607 If specified, an item of type 'Previous' will also be included.
4608 It does not have table-specific fields.
4610 I<end_date> - unix timestamp, only include records before
4612 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4614 I<conf> - optional already-loaded FS::Conf object.
4618 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4619 # and also for sending customer statements, which should both be kept customer-friendly.
4620 # If you add anything that shouldn't be passed on through the API or exposed
4621 # to customers, add a new option to include it, don't include it by default
4622 sub payment_history {
4624 my $opt = ref($_[0]) ? $_[0] : { @_ };
4626 my $conf = $$opt{'conf'} || new FS::Conf;
4627 my $money_char = $conf->config("money_char") || '$',
4629 #first load entire history,
4630 #need previous to calculate previous balance
4631 #loading after end_date shouldn't hurt too much?
4633 if ( $$opt{'line_items'} ) {
4635 foreach my $cust_bill ( $self->cust_bill ) {
4638 'type' => 'Line item',
4639 'description' => $_->desc( $self->locale ).
4640 ( $_->sdate && $_->edate
4641 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4642 ' To '. time2str('%d-%b-%Y', $_->edate)
4645 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4646 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4647 'date' => $cust_bill->_date,
4648 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4650 foreach $cust_bill->cust_bill_pkg;
4657 'type' => 'Invoice',
4658 'description' => 'Invoice #'. $_->display_invnum,
4659 'amount' => sprintf('%.2f', $_->charged ),
4660 'charged' => sprintf('%.2f', $_->charged ),
4661 'date' => $_->_date,
4662 'date_pretty' => $self->time2str_local('short', $_->_date ),
4664 foreach $self->cust_bill;
4669 'type' => 'Payment',
4670 'description' => 'Payment', #XXX type
4671 'amount' => sprintf('%.2f', 0 - $_->paid ),
4672 'paid' => sprintf('%.2f', $_->paid ),
4673 'date' => $_->_date,
4674 'date_pretty' => $self->time2str_local('short', $_->_date ),
4676 foreach $self->cust_pay;
4680 'description' => 'Credit', #more info?
4681 'amount' => sprintf('%.2f', 0 -$_->amount ),
4682 'credit' => sprintf('%.2f', $_->amount ),
4683 'date' => $_->_date,
4684 'date_pretty' => $self->time2str_local('short', $_->_date ),
4686 foreach $self->cust_credit;
4690 'description' => 'Refund', #more info? type, like payment?
4691 'amount' => $_->refund,
4692 'refund' => $_->refund,
4693 'date' => $_->_date,
4694 'date_pretty' => $self->time2str_local('short', $_->_date ),
4696 foreach $self->cust_refund;
4698 #put it all in chronological order
4699 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4701 #calculate balance, filter items outside date range
4705 foreach my $item (@history) {
4706 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4707 $balance += $$item{'amount'};
4708 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4709 $previous += $$item{'amount'};
4712 $$item{'balance'} = sprintf("%.2f",$balance);
4713 foreach my $key ( qw(amount balance) ) {
4714 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4719 # start with previous balance, if there was one
4722 'type' => 'Previous',
4723 'description' => 'Previous balance',
4724 'amount' => sprintf("%.2f",$previous),
4725 'balance' => sprintf("%.2f",$previous),
4726 'date' => $$opt{'start_date'},
4727 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4729 #false laziness with above
4730 foreach my $key ( qw(amount balance) ) {
4731 $$item{$key.'_pretty'} = $$item{$key};
4732 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4734 unshift(@out,$item);
4737 @out = reverse @history if $$opt{'reverse_sort'};
4742 =item save_cust_payby
4744 Saves a new cust_payby for this customer, replacing an existing entry only
4745 in select circumstances. Does not validate input.
4747 If auto is specified, marks this as the customer's primary method, or the
4748 specified weight. Existing payment methods have their weight incremented as
4751 If bill_location is specified with auto, also sets location in cust_main.
4753 Will not insert complete duplicates of existing records, or records in which the
4754 only difference from an existing record is to turn off automatic payment (will
4755 return without error.) Will replace existing records in which the only difference
4756 is to add a value to a previously empty preserved field and/or turn on automatic payment.
4757 Fields marked as preserved are optional, and existing values will not be overwritten with
4758 blanks when replacing.
4760 Accepts the following named parameters:
4770 save as an automatic payment type (CARD/CHEK if true, DCRD/DCHK if false)
4774 optional, set higher than 1 for secondary, etc.
4782 optional, but should be specified for anything that might be tokenized, will be preserved when replacing
4790 optional, will be preserved when replacing
4798 CARD only, required, FS::cust_location object
4800 =item paystart_month
4802 CARD only, optional, will be preserved when replacing
4806 CARD only, optional, will be preserved when replacing
4810 CARD only, optional, will be preserved when replacing
4814 CARD only, only used if conf cvv-save is set appropriately
4824 =item saved_cust_payby
4826 scalar reference, for returning saved object
4832 #The code for this option is in place, but it's not currently used
4836 # existing cust_payby object to be replaced (must match custnum)
4838 # stateid/stateid_state/ss are not currently supported in cust_payby,
4839 # might not even work properly in 4.x, but will need to work here if ever added
4841 sub save_cust_payby {
4845 my $old = $opt{'replace'};
4846 my $new = new FS::cust_payby { $old ? $old->hash : () };
4847 return "Customer number does not match" if $new->custnum and $new->custnum != $self->custnum;
4848 $new->set( 'custnum' => $self->custnum );
4850 my $payby = $opt{'payment_payby'};
4851 return "Bad payby" unless grep(/^$payby$/,('CARD','CHEK'));
4853 # don't allow turning off auto when replacing
4854 $opt{'auto'} ||= 1 if $old and $old->payby !~ /^D/;
4856 my @check_existing; # payby relevant to this payment_payby
4858 # set payby based on auto
4859 if ( $payby eq 'CARD' ) {
4860 $new->set( 'payby' => ( $opt{'auto'} ? 'CARD' : 'DCRD' ) );
4861 @check_existing = qw( CARD DCRD );
4862 } elsif ( $payby eq 'CHEK' ) {
4863 $new->set( 'payby' => ( $opt{'auto'} ? 'CHEK' : 'DCHK' ) );
4864 @check_existing = qw( CHEK DCHK );
4867 $new->set( 'weight' => $opt{'auto'} ? $opt{'weight'} : '' );
4870 $new->payinfo($opt{'payinfo'}); # sets default paymask, but not if it's already tokenized
4871 $new->paymask($opt{'paymask'}) if $opt{'paymask'}; # in case it's been tokenized, override with loaded paymask
4872 $new->set( 'payname' => $opt{'payname'} );
4873 $new->set( 'payip' => $opt{'payip'} ); # will be preserved below
4875 my $conf = new FS::Conf;
4877 # compare to FS::cust_main::realtime_bop - check both to make sure working correctly
4878 if ( $payby eq 'CARD' &&
4879 ( (grep { $_ eq cardtype($opt{'payinfo'}) } $conf->config('cvv-save'))
4880 || $conf->exists('business-onlinepayment-verification')
4883 $new->set( 'paycvv' => $opt{'paycvv'} );
4885 $new->set( 'paycvv' => '');
4888 local $SIG{HUP} = 'IGNORE';
4889 local $SIG{INT} = 'IGNORE';
4890 local $SIG{QUIT} = 'IGNORE';
4891 local $SIG{TERM} = 'IGNORE';
4892 local $SIG{TSTP} = 'IGNORE';
4893 local $SIG{PIPE} = 'IGNORE';
4895 my $oldAutoCommit = $FS::UID::AutoCommit;
4896 local $FS::UID::AutoCommit = 0;
4899 # set fields specific to payment_payby
4900 if ( $payby eq 'CARD' ) {
4901 if ($opt{'bill_location'}) {
4902 $opt{'bill_location'}->set('custnum' => $self->custnum);
4903 my $error = $opt{'bill_location'}->find_or_insert;
4905 $dbh->rollback if $oldAutoCommit;
4908 $new->set( 'locationnum' => $opt{'bill_location'}->locationnum );
4910 foreach my $field ( qw( paydate paystart_month paystart_year payissue ) ) {
4911 $new->set( $field => $opt{$field} );
4914 foreach my $field ( qw(paytype paystate) ) {
4915 $new->set( $field => $opt{$field} );
4919 # other cust_payby to compare this to
4920 my @existing = $self->cust_payby(@check_existing);
4922 # fields that can overwrite blanks with values, but not values with blanks
4923 my @preserve = qw( paymask locationnum paystart_month paystart_year payissue payip );
4925 my $skip_cust_payby = 0; # true if we don't need to save or reweight cust_payby
4927 # generally, we don't want to overwrite existing cust_payby with this,
4928 # but we can replace if we're only marking it auto or adding a preserved field
4929 # and we can avoid saving a total duplicate or merely turning off auto
4931 foreach my $cust_payby (@existing) {
4932 # check fields that absolutely should not change
4933 foreach my $field ($new->fields) {
4934 next if grep(/^$field$/, qw( custpaybynum payby weight ) );
4935 next if grep(/^$field$/, @preserve );
4936 next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
4937 # check if paymask exists, if so stop and don't save, no need for a duplicate.
4938 return '' if $new->get('paymask') eq $cust_payby->get('paymask');
4940 # now check fields that can replace if one value is blank
4942 foreach my $field (@preserve) {
4944 ( $new->get($field) and !$cust_payby->get($field) ) or
4945 ( $cust_payby->get($field) and !$new->get($field) )
4947 # prevention of overwriting values with blanks happens farther below
4949 } elsif ( $new->get($field) ne $cust_payby->get($field) ) {
4953 unless ( $replace ) {
4954 # nearly identical, now check weight
4955 if ($new->get('weight') eq $cust_payby->get('weight') or !$new->get('weight')) {
4956 # ignore identical cust_payby, and ignore attempts to turn off auto
4957 # no need to save or re-weight cust_payby (but still need to update/commit $self)
4958 $skip_cust_payby = 1;
4961 # otherwise, only change is to mark this as primary
4963 # if we got this far, we're definitely replacing
4970 $new->set( 'custpaybynum' => $old->custpaybynum );
4971 # don't turn off automatic payment (but allow it to be turned on)
4972 if ($new->payby =~ /^D/ and $new->payby ne $old->payby) {
4974 $new->set( 'payby' => $old->payby );
4975 $new->set( 'weight' => 1 );
4977 # make sure we're not overwriting values with blanks
4978 foreach my $field (@preserve) {
4979 if ( $old->get($field) and !$new->get($field) ) {
4980 $new->set( $field => $old->get($field) );
4985 # only overwrite cust_main bill_location if auto
4986 if ($opt{'auto'} && $opt{'bill_location'}) {
4987 $self->set('bill_location' => $opt{'bill_location'});
4988 my $error = $self->replace;
4990 $dbh->rollback if $oldAutoCommit;
4995 # done with everything except reweighting and saving cust_payby
4996 # still need to commit changes to cust_main and cust_location
4997 if ($skip_cust_payby) {
4998 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5002 # re-weight existing primary cust_pay for this payby
5004 foreach my $cust_payby (@existing) {
5005 # relies on cust_payby return order
5006 last unless $cust_payby->payby !~ /^D/;
5007 last if $cust_payby->weight > 1;
5008 next if $new->custpaybynum eq $cust_payby->custpaybynum;
5009 next if $cust_payby->weight < ($opt{'weight'} || 1);
5010 $cust_payby->weight( $cust_payby->weight + 1 );
5011 my $error = $cust_payby->replace;
5013 $dbh->rollback if $oldAutoCommit;
5014 return "Error reweighting cust_payby: $error";
5019 # finally, save cust_payby
5020 my $error = $old ? $new->replace($old) : $new->insert;
5022 $dbh->rollback if $oldAutoCommit;
5026 ${$opt{'saved_cust_payby'}} = $new
5027 if $opt{'saved_cust_payby'};
5029 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5034 =item remove_cvv_from_cust_payby PAYINFO
5036 Removes paycvv from associated cust_payby with matching PAYINFO.
5040 sub remove_cvv_from_cust_payby {
5041 my ($self,$payinfo) = @_;
5043 my $oldAutoCommit = $FS::UID::AutoCommit;
5044 local $FS::UID::AutoCommit = 0;
5047 foreach my $cust_payby ( qsearch('cust_payby',{ custnum => $self->custnum }) ) {
5048 next unless $cust_payby->payinfo eq $payinfo; # can't qsearch on payinfo
5049 $cust_payby->paycvv('');
5050 my $error = $cust_payby->replace;
5052 $dbh->rollback if $oldAutoCommit;
5057 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5063 =head1 CLASS METHODS
5069 Class method that returns the list of possible status strings for customers
5070 (see L<the status method|/status>). For example:
5072 @statuses = FS::cust_main->statuses();
5078 keys %{ $self->statuscolors };
5081 =item cust_status_sql
5083 Returns an SQL fragment to determine the status of a cust_main record, as a
5088 sub cust_status_sql {
5090 for my $status ( FS::cust_main->statuses() ) {
5091 my $method = $status.'_sql';
5092 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
5101 Returns an SQL expression identifying prospective cust_main records (customers
5102 with no packages ever ordered)
5106 use vars qw($select_count_pkgs);
5107 $select_count_pkgs =
5108 "SELECT COUNT(*) FROM cust_pkg
5109 WHERE cust_pkg.custnum = cust_main.custnum";
5111 sub select_count_pkgs_sql {
5116 " 0 = ( $select_count_pkgs ) ";
5121 Returns an SQL expression identifying ordered cust_main records (customers with
5122 no active packages, but recurring packages not yet setup or one time charges
5128 FS::cust_main->none_active_sql.
5129 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
5134 Returns an SQL expression identifying active cust_main records (customers with
5135 active recurring packages).
5140 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
5143 =item none_active_sql
5145 Returns an SQL expression identifying cust_main records with no active
5146 recurring packages. This includes customers of status prospect, ordered,
5147 inactive, and suspended.
5151 sub none_active_sql {
5152 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
5157 Returns an SQL expression identifying inactive cust_main records (customers with
5158 no active recurring packages, but otherwise unsuspended/uncancelled).
5163 FS::cust_main->none_active_sql.
5164 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
5170 Returns an SQL expression identifying suspended cust_main records.
5175 sub suspended_sql { susp_sql(@_); }
5177 FS::cust_main->none_active_sql.
5178 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
5184 Returns an SQL expression identifying cancelled cust_main records.
5188 sub cancel_sql { shift->cancelled_sql(@_); }
5191 =item uncancelled_sql
5193 Returns an SQL expression identifying un-cancelled cust_main records.
5197 sub uncancelled_sql { uncancel_sql(@_); }
5200 "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module
5205 Returns an SQL fragment to retreive the balance.
5210 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5211 WHERE cust_bill.custnum = cust_main.custnum )
5212 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
5213 WHERE cust_pay.custnum = cust_main.custnum )
5214 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
5215 WHERE cust_credit.custnum = cust_main.custnum )
5216 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
5217 WHERE cust_refund.custnum = cust_main.custnum )
5220 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
5222 Returns an SQL fragment to retreive the balance for this customer, optionally
5223 considering invoices with date earlier than START_TIME, and not
5224 later than END_TIME (total_owed_date minus total_unapplied_credits minus
5225 total_unapplied_payments).
5227 Times are specified as SQL fragments or numeric
5228 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5229 L<Date::Parse> for conversion functions. The empty string can be passed
5230 to disable that time constraint completely.
5232 Available options are:
5236 =item unapplied_date
5238 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)
5243 set to true to remove all customer comparison clauses, for totals
5248 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5253 JOIN clause (typically used with the total option)
5257 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
5258 time will be ignored. Note that START_TIME and END_TIME only limit the date
5259 range for invoices and I<unapplied> payments, credits, and refunds.
5265 sub balance_date_sql {
5266 my( $class, $start, $end, %opt ) = @_;
5268 my $cutoff = $opt{'cutoff'};
5270 my $owed = FS::cust_bill->owed_sql($cutoff);
5271 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
5272 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
5273 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5275 my $j = $opt{'join'} || '';
5277 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
5278 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5279 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5280 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
5282 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
5283 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5284 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5285 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
5290 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
5292 Returns an SQL fragment to retreive the total unapplied payments for this
5293 customer, only considering payments with date earlier than START_TIME, and
5294 optionally not later than END_TIME.
5296 Times are specified as SQL fragments or numeric
5297 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
5298 L<Date::Parse> for conversion functions. The empty string can be passed
5299 to disable that time constraint completely.
5301 Available options are:
5305 sub unapplied_payments_date_sql {
5306 my( $class, $start, $end, %opt ) = @_;
5308 my $cutoff = $opt{'cutoff'};
5310 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
5312 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
5313 'unapplied_date'=>1 );
5315 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
5318 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5320 Helper method for balance_date_sql; name (and usage) subject to change
5321 (suggestions welcome).
5323 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5324 cust_refund, cust_credit or cust_pay).
5326 If TABLE is "cust_bill" or the unapplied_date option is true, only
5327 considers records with date earlier than START_TIME, and optionally not
5328 later than END_TIME .
5332 sub _money_table_where {
5333 my( $class, $table, $start, $end, %opt ) = @_;
5336 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5337 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5338 push @where, "$table._date <= $start" if defined($start) && length($start);
5339 push @where, "$table._date > $end" if defined($end) && length($end);
5341 push @where, @{$opt{'where'}} if $opt{'where'};
5342 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5348 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5349 use FS::cust_main::Search;
5352 FS::cust_main::Search->search(@_);
5361 #=item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5363 #Deprecated. Use event notification and message templates
5364 #(L<FS::msg_template>) instead.
5366 #Sends a templated email notification to the customer (see L<Text::Template>).
5368 #OPTIONS is a hash and may include
5370 #I<from> - the email sender (default is invoice_from)
5372 #I<to> - comma-separated scalar or arrayref of recipients
5373 # (default is invoicing_list)
5375 #I<subject> - The subject line of the sent email notification
5376 # (default is "Notice from company_name")
5378 #I<extra_fields> - a hashref of name/value pairs which will be substituted
5381 #The following variables are vavailable in the template.
5383 #I<$first> - the customer first name
5384 #I<$last> - the customer last name
5385 #I<$company> - the customer company
5386 #I<$payby> - a description of the method of payment for the customer
5387 # # would be nice to use FS::payby::shortname
5388 #I<$payinfo> - the account information used to collect for this customer
5389 #I<$expdate> - the expiration of the customer payment in seconds from epoch
5394 # my ($self, $template, %options) = @_;
5396 # return unless $conf->exists($template);
5398 # my $from = $conf->invoice_from_full($self->agentnum)
5399 # if $conf->exists('invoice_from', $self->agentnum);
5400 # $from = $options{from} if exists($options{from});
5402 # my $to = join(',', $self->invoicing_list_emailonly);
5403 # $to = $options{to} if exists($options{to});
5405 # my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5406 # if $conf->exists('company_name', $self->agentnum);
5407 # $subject = $options{subject} if exists($options{subject});
5409 # my $notify_template = new Text::Template (TYPE => 'ARRAY',
5410 # SOURCE => [ map "$_\n",
5411 # $conf->config($template)]
5413 # or die "can't create new Text::Template object: Text::Template::ERROR";
5414 # $notify_template->compile()
5415 # or die "can't compile template: Text::Template::ERROR";
5417 # $FS::notify_template::_template::company_name =
5418 # $conf->config('company_name', $self->agentnum);
5419 # $FS::notify_template::_template::company_address =
5420 # join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5422 # my $paydate = $self->paydate || '2037-12-31';
5423 # $FS::notify_template::_template::first = $self->first;
5424 # $FS::notify_template::_template::last = $self->last;
5425 # $FS::notify_template::_template::company = $self->company;
5426 # $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5427 # my $payby = $self->payby;
5428 # my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5429 # my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5431 # #credit cards expire at the end of the month/year of their exp date
5432 # if ($payby eq 'CARD' || $payby eq 'DCRD') {
5433 # $FS::notify_template::_template::payby = 'credit card';
5434 # ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5435 # $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5437 # }elsif ($payby eq 'COMP') {
5438 # $FS::notify_template::_template::payby = 'complimentary account';
5440 # $FS::notify_template::_template::payby = 'current method';
5442 # $FS::notify_template::_template::expdate = $expire_time;
5444 # for (keys %{$options{extra_fields}}){
5446 # ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5449 # send_email(from => $from,
5451 # subject => $subject,
5452 # body => $notify_template->fill_in( PACKAGE =>
5453 # 'FS::notify_template::_template' ),
5458 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5460 Generates a templated notification to the customer (see L<Text::Template>).
5462 OPTIONS is a hash and may include
5464 I<extra_fields> - a hashref of name/value pairs which will be substituted
5465 into the template. These values may override values mentioned below
5466 and those from the customer record.
5468 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5470 The following variables are available in the template instead of or in addition
5471 to the fields of the customer record.
5473 I<$payby> - a description of the method of payment for the customer
5474 # would be nice to use FS::payby::shortname
5475 I<$payinfo> - the masked account information used to collect for this customer
5476 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5477 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5481 # a lot like cust_bill::print_latex
5482 sub generate_letter {
5483 my ($self, $template, %options) = @_;
5485 warn "Template $template does not exist" && return
5486 unless $conf->exists($template) || $options{'template_text'};
5488 my $template_source = $options{'template_text'}
5489 ? [ $options{'template_text'} ]
5490 : [ map "$_\n", $conf->config($template) ];
5492 my $letter_template = new Text::Template
5494 SOURCE => $template_source,
5495 DELIMITERS => [ '[@--', '--@]' ],
5497 or die "can't create new Text::Template object: Text::Template::ERROR";
5499 $letter_template->compile()
5500 or die "can't compile template: Text::Template::ERROR";
5502 my %letter_data = map { $_ => $self->$_ } $self->fields;
5503 $letter_data{payinfo} = $self->mask_payinfo;
5505 #my $paydate = $self->paydate || '2037-12-31';
5506 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5508 my $payby = $self->payby;
5509 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5510 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5512 #credit cards expire at the end of the month/year of their exp date
5513 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5514 $letter_data{payby} = 'credit card';
5515 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5516 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5518 }elsif ($payby eq 'COMP') {
5519 $letter_data{payby} = 'complimentary account';
5521 $letter_data{payby} = 'current method';
5523 $letter_data{expdate} = $expire_time;
5525 for (keys %{$options{extra_fields}}){
5526 $letter_data{$_} = $options{extra_fields}->{$_};
5529 unless(exists($letter_data{returnaddress})){
5530 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5531 $self->agent_template)
5533 if ( length($retadd) ) {
5534 $letter_data{returnaddress} = $retadd;
5535 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5536 $letter_data{returnaddress} =
5537 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5541 ( $conf->config('company_name', $self->agentnum),
5542 $conf->config('company_address', $self->agentnum),
5546 $letter_data{returnaddress} = '~';
5550 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5552 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5554 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5556 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5560 ) or die "can't open temp file: $!\n";
5561 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5562 or die "can't write temp file: $!\n";
5564 $letter_data{'logo_file'} = $lh->filename;
5566 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5570 ) or die "can't open temp file: $!\n";
5572 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5574 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5575 return ($1, $letter_data{'logo_file'});
5579 =item print_ps TEMPLATE
5581 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5587 my($file, $lfile) = $self->generate_letter(@_);
5588 my $ps = FS::Misc::generate_ps($file);
5589 unlink($file.'.tex');
5595 =item print TEMPLATE
5597 Prints the filled in template.
5599 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5603 sub queueable_print {
5606 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5607 or die "invalid customer number: " . $opt{custnum};
5609 #do not backport this change to 3.x
5610 # my $error = $self->print( { 'template' => $opt{template} } );
5611 my $error = $self->print( $opt{'template'} );
5612 die $error if $error;
5616 my ($self, $template) = (shift, shift);
5618 [ $self->print_ps($template) ],
5619 'agentnum' => $self->agentnum,
5623 #these three subs should just go away once agent stuff is all config overrides
5625 sub agent_template {
5627 $self->_agent_plandata('agent_templatename');
5630 sub agent_invoice_from {
5632 $self->_agent_plandata('agent_invoice_from');
5635 sub _agent_plandata {
5636 my( $self, $option ) = @_;
5638 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5639 #agent-specific Conf
5641 use FS::part_event::Condition;
5643 my $agentnum = $self->agentnum;
5645 my $regexp = regexp_sql();
5647 my $part_event_option =
5649 'select' => 'part_event_option.*',
5650 'table' => 'part_event_option',
5652 LEFT JOIN part_event USING ( eventpart )
5653 LEFT JOIN part_event_option AS peo_agentnum
5654 ON ( part_event.eventpart = peo_agentnum.eventpart
5655 AND peo_agentnum.optionname = 'agentnum'
5656 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5658 LEFT JOIN part_event_condition
5659 ON ( part_event.eventpart = part_event_condition.eventpart
5660 AND part_event_condition.conditionname = 'cust_bill_age'
5662 LEFT JOIN part_event_condition_option
5663 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5664 AND part_event_condition_option.optionname = 'age'
5667 #'hashref' => { 'optionname' => $option },
5668 #'hashref' => { 'part_event_option.optionname' => $option },
5670 " WHERE part_event_option.optionname = ". dbh->quote($option).
5671 " AND action = 'cust_bill_send_agent' ".
5672 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5673 " AND peo_agentnum.optionname = 'agentnum' ".
5674 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5676 CASE WHEN part_event_condition_option.optionname IS NULL
5678 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5680 , part_event.weight".
5684 unless ( $part_event_option ) {
5685 return $self->agent->invoice_template || ''
5686 if $option eq 'agent_templatename';
5690 $part_event_option->optionvalue;
5694 sub process_o2m_qsearch {
5697 return qsearch($table, @_) unless $table eq 'contact';
5699 my $hashref = shift;
5700 my %hash = %$hashref;
5701 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5702 or die 'guru meditation #4343';
5704 qsearch({ 'table' => 'contact',
5705 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5706 'hashref' => \%hash,
5707 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5708 " cust_contact.custnum = $custnum "
5712 sub process_o2m_qsearchs {
5715 return qsearchs($table, @_) unless $table eq 'contact';
5717 my $hashref = shift;
5718 my %hash = %$hashref;
5719 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
5720 or die 'guru meditation #2121';
5722 qsearchs({ 'table' => 'contact',
5723 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
5724 'hashref' => \%hash,
5725 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
5726 " cust_contact.custnum = $custnum "
5730 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5732 Subroutine (not a method), designed to be called from the queue.
5734 Takes a list of options and values.
5736 Pulls up the customer record via the custnum option and calls bill_and_collect.
5741 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5743 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5744 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5746 #without this errors don't get rolled back
5747 $args{'fatal'} = 1; # runs from job queue, will be caught
5749 $cust_main->bill_and_collect( %args );
5752 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5754 Like queued_bill, but instead of C<bill_and_collect>, just runs the
5755 C<collect> part. This is used in batch tax calculation, where invoice
5756 generation and collection events have to be completely separated.
5760 sub queued_collect {
5762 my $cust_main = FS::cust_main->by_key($args{'custnum'});
5764 $cust_main->collect(%args);
5767 sub process_bill_and_collect {
5770 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5771 or die "custnum '$param->{custnum}' not found!\n";
5772 $param->{'job'} = $job;
5773 $param->{'fatal'} = 1; # runs from job queue, will be caught
5774 $param->{'retry'} = 1;
5776 $cust_main->bill_and_collect( %$param );
5779 =item pending_invoice_count
5781 Return number of cust_bill with pending=Y for this customer
5785 sub pending_invoice_count {
5786 FS::cust_bill->count( 'custnum = '.shift->custnum."AND pending = 'Y'" );
5789 #starting to take quite a while for big dbs
5790 # (JRNL: journaled so it only happens once per database)
5791 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5792 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5793 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5794 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5795 # JRNL leading/trailing spaces in first, last, company
5796 # JRNL migrate to cust_payby
5797 # - otaker upgrade? journal and call it good? (double check to make sure
5798 # we're not still setting otaker here)
5800 #only going to get worse with new location stuff...
5802 sub _upgrade_data { #class method
5803 my ($class, %opts) = @_;
5806 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5809 #this seems to be the only expensive one.. why does it take so long?
5810 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5812 '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';
5813 FS::upgrade_journal->set_done('cust_main__signupdate');
5816 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5818 # fix yyyy-m-dd formatted paydates
5819 if ( driver_name =~ /^mysql/i ) {
5821 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5822 } else { # the SQL standard
5824 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5826 FS::upgrade_journal->set_done('cust_main__paydate');
5829 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5831 push @statements, #fix the weird BILL with a cc# in payinfo problem
5833 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5835 FS::upgrade_journal->set_done('cust_main__payinfo');
5840 foreach my $sql ( @statements ) {
5841 my $sth = dbh->prepare($sql) or die dbh->errstr;
5842 $sth->execute or die $sth->errstr;
5843 #warn ( (time - $t). " seconds\n" );
5847 local($ignore_expired_card) = 1;
5848 local($ignore_banned_card) = 1;
5849 local($skip_fuzzyfiles) = 1;
5850 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5852 unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
5854 #we don't want to decrypt them, just stuff them as-is into cust_payby
5855 local(@encrypted_fields) = ();
5857 local($FS::cust_payby::ignore_expired_card) = 1;
5858 local($FS::cust_payby::ignore_banned_card) = 1;
5859 local($FS::cust_payby::ignore_cardtype) = 1;
5861 my @payfields = qw( payby payinfo paycvv paymask
5862 paydate paystart_month paystart_year payissue
5863 payname paystate paytype payip
5866 my $search = new FS::Cursor {
5867 'table' => 'cust_main',
5868 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
5871 while (my $cust_main = $search->fetch) {
5873 unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
5875 my $cust_payby = new FS::cust_payby {
5876 'custnum' => $cust_main->custnum,
5878 map { $_ => $cust_main->$_(); } @payfields
5881 my $error = $cust_payby->insert;
5882 die $error if $error;
5886 # at the time we do this, also migrate paytype into cust_pay_batch
5887 # so that batches that are open before the migration can still be
5889 if ( $cust_main->get('paytype') ) {
5890 my @cust_pay_batch = qsearch('cust_pay_batch', {
5891 'custnum' => $cust_main->custnum,
5895 foreach my $cust_pay_batch (@cust_pay_batch) {
5896 $cust_pay_batch->set('paytype', $cust_main->get('paytype'));
5897 my $error = $cust_pay_batch->replace;
5898 die "$error (setting cust_pay_batch.paytype)" if $error;
5902 $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP';
5904 $cust_main->invoice_attn( $cust_main->payname )
5905 if $cust_main->payby eq 'BILL' && $cust_main->payname;
5906 $cust_main->po_number( $cust_main->payinfo )
5907 if $cust_main->payby eq 'BILL' && $cust_main->payinfo;
5909 $cust_main->setfield($_, '') foreach @payfields;
5910 my $error = $cust_main->replace;
5911 die "Error upgradging payment information for custnum ".
5912 $cust_main->custnum. ": $error"
5917 FS::upgrade_journal->set_done('cust_main__cust_payby');
5920 FS::cust_main::Location->_upgrade_data(%opts);
5922 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5924 foreach my $cust_main ( qsearch({
5925 'table' => 'cust_main',
5927 'extra_sql' => 'WHERE '.
5929 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5930 qw( first last company )
5933 my $error = $cust_main->replace;
5934 die $error if $error;
5937 FS::upgrade_journal->set_done('cust_main__trimspaces');
5941 $class->_upgrade_otaker(%opts);
5943 # turn on encryption as part of regular upgrade, so all new records are immediately encrypted
5944 # existing records will be encrypted in queueable_upgrade (below)
5945 unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) {
5946 eval "use FS::Setup";
5948 FS::Setup::enable_encryption();
5953 sub queueable_upgrade {
5956 ### encryption gets turned on in _upgrade_data, above
5958 eval "use FS::upgrade_journal";
5961 # prior to 2013 (commit f16665c9) payinfo was stored in history if not encrypted,
5962 # clear that out before encrypting/tokenizing anything else
5963 if (!FS::upgrade_journal->is_done('clear_payinfo_history')) {
5964 foreach my $table ('cust_payby','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
5965 my $sql = 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL';
5966 my $sth = dbh->prepare($sql) or die dbh->errstr;
5967 $sth->execute or die $sth->errstr;
5969 FS::upgrade_journal->set_done('clear_payinfo_history');
5972 # fix Tokenized paycardtype and encrypt old records
5973 if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized')
5974 || ! FS::upgrade_journal->is_done('encryption_check')
5978 # allow replacement of closed cust_pay/cust_refund records
5979 local $FS::payinfo_Mixin::allow_closed_replace = 1;
5981 # because it looks like nothing's changing
5982 local $FS::Record::no_update_diff = 1;
5984 # commit everything immediately
5985 local $FS::UID::AutoCommit = 1;
5987 # encrypt what's there
5988 foreach my $table ('cust_payby','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') {
5989 my $tclass = 'FS::'.$table;
5992 while (my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)) {
5993 my $record = $tclass->by_key($recnum);
5994 next unless $record; # small chance it's been deleted, that's ok
5995 next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby;
5996 # window for possible conflict is practically nonexistant,
5997 # but just in case...
5998 $record = $record->select_for_update;
5999 if (!$record->custnum && $table eq 'cust_pay_pending') {
6000 $record->set('custnum_pending',1);
6002 $record->paycardtype('') if $record->paycardtype eq 'Tokenized';
6004 local($ignore_expired_card) = 1;
6005 local($ignore_banned_card) = 1;
6006 local($skip_fuzzyfiles) = 1;
6007 local($import) = 1;#prevent automatic geocoding (need its own variable?)
6009 my $error = $record->replace;
6010 die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error;
6014 FS::upgrade_journal->set_done('paycardtype_Tokenized');
6015 FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption');
6018 # now that everything's encrypted, tokenize...
6019 FS::cust_main::Billing_Realtime::token_check(@_);
6022 # not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum
6023 # cust_payby might get deleted while this runs
6025 sub _upgrade_next_recnum {
6026 my ($dbh,$table,$lastrecnum,$recnums) = @_;
6027 my $recnum = shift @$recnums;
6028 return $recnum if $recnum;
6029 my $tclass = 'FS::'.$table;
6030 my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : '';
6031 my $sql = 'SELECT '.$tclass->primary_key.
6033 ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum.
6034 " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ".
6035 " AND ( length(payinfo) < 80$paycardtypecheck ) ".
6036 ' ORDER BY '.$tclass->primary_key.' LIMIT 500';
6037 my $sth = $dbh->prepare($sql) or die $dbh->errstr;
6038 $sth->execute() or die $sth->errstr;
6040 while (my $rec = $sth->fetchrow_hashref) {
6041 push @$recnums, $rec->{$tclass->primary_key};
6044 $$lastrecnum = $$recnums[-1];
6045 return shift @$recnums;
6054 The delete method should possibly take an FS::cust_main object reference
6055 instead of a scalar customer number.
6057 Bill and collect options should probably be passed as references instead of a
6060 There should probably be a configuration file with a list of allowed credit
6063 No multiple currency support (probably a larger project than just this module).
6065 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
6067 Birthdates rely on negative epoch values.
6069 The payby for card/check batches is broken. With mixed batching, bad
6072 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
6076 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
6077 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
6078 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.