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
23 use Scalar::Util qw( blessed );
24 use Time::Local qw(timelocal);
27 use Digest::MD5 qw(md5_base64);
30 use File::Temp; #qw( tempfile );
31 use Business::CreditCard 0.28;
33 use FS::UID qw( dbh driver_name );
34 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
36 use FS::Misc qw( generate_email send_email generate_ps do_print );
37 use FS::Msgcat qw(gettext);
44 use FS::cust_bill_void;
45 use FS::legacy_cust_bill;
47 use FS::cust_pay_pending;
48 use FS::cust_pay_void;
49 use FS::cust_pay_batch;
52 use FS::part_referral;
53 use FS::cust_main_county;
54 use FS::cust_location;
57 use FS::cust_main_exemption;
58 use FS::cust_tax_adjustment;
59 use FS::cust_tax_location;
60 use FS::agent_currency;
61 use FS::cust_main_invoice;
63 use FS::prepay_credit;
69 use FS::payment_gateway;
70 use FS::agent_payment_gateway;
72 use FS::cust_main_note;
73 use FS::cust_attachment;
76 use FS::upgrade_journal;
81 # 1 is mostly method/subroutine entry and options
82 # 2 traces progress of some operations
83 # 3 is even more information including possibly sensitive data
85 our $me = '[FS::cust_main]';
88 our $ignore_expired_card = 0;
89 our $ignore_banned_card = 0;
90 our $ignore_invalid_card = 0;
92 our $skip_fuzzyfiles = 0;
94 our $ucfirst_nowarn = 0;
96 #this info is in cust_payby as of 4.x
97 #this and the fields themselves can be removed in 5.x
98 our @encrypted_fields = ('payinfo', 'paycvv');
99 sub nohistory_fields { ('payinfo', 'paycvv'); }
102 #ask FS::UID to run this stuff for us later
103 #$FS::UID::callback{'FS::cust_main'} = sub {
104 install_callback FS::UID sub {
105 $conf = new FS::Conf;
106 #yes, need it for stuff below (prolly should be cached)
107 $ignore_invalid_card = $conf->exists('allow_invalid_cards');
112 my ( $hashref, $cache ) = @_;
113 if ( exists $hashref->{'pkgnum'} ) {
114 #@{ $self->{'_pkgnum'} } = ();
115 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
116 $self->{'_pkgnum'} = $subcache;
117 #push @{ $self->{'_pkgnum'} },
118 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
124 FS::cust_main - Object methods for cust_main records
130 $record = new FS::cust_main \%hash;
131 $record = new FS::cust_main { 'column' => 'value' };
133 $error = $record->insert;
135 $error = $new_record->replace($old_record);
137 $error = $record->delete;
139 $error = $record->check;
141 @cust_pkg = $record->all_pkgs;
143 @cust_pkg = $record->ncancelled_pkgs;
145 @cust_pkg = $record->suspended_pkgs;
147 $error = $record->bill;
148 $error = $record->bill %options;
149 $error = $record->bill 'time' => $time;
151 $error = $record->collect;
152 $error = $record->collect %options;
153 $error = $record->collect 'invoice_time' => $time,
158 An FS::cust_main object represents a customer. FS::cust_main inherits from
159 FS::Record. The following fields are currently supported:
165 Primary key (assigned automatically for new customers)
169 Agent (see L<FS::agent>)
173 Advertising source (see L<FS::part_referral>)
185 Cocial security number (optional)
209 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
213 Payment Information (See L<FS::payinfo_Mixin> for data format)
217 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
221 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
225 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
229 Start date month (maestro/solo cards only)
233 Start date year (maestro/solo cards only)
237 Issue number (maestro/solo cards only)
241 Name on card or billing name
245 IP address from which payment information was received
249 Tax exempt, empty or `Y'
253 Order taker (see L<FS::access_user>)
259 =item referral_custnum
261 Referring customer number
265 Enable individual CDR spooling, empty or `Y'
269 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
273 Discourage individual CDR printing, empty or `Y'
277 Allow self-service editing of ticket subjects, empty or 'Y'
279 =item calling_list_exempt
281 Do not call, empty or 'Y'
291 Creates a new customer. To add the customer to the database, see L<"insert">.
293 Note that this stores the hash reference, not a distinct copy of the hash it
294 points to. You can ask the object for a copy with the I<hash> method.
298 sub table { 'cust_main'; }
300 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
302 Adds this customer to the database. If there is an error, returns the error,
303 otherwise returns false.
305 Usually the customer's location will not yet exist in the database, and
306 the C<bill_location> and C<ship_location> pseudo-fields must be set to
307 uninserted L<FS::cust_location> objects. These will be inserted and linked
308 (in both directions) to the new customer record. If they're references
309 to the same object, they will become the same location.
311 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
312 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
313 are inserted atomicly, or the transaction is rolled back. Passing an empty
314 hash reference is equivalent to not supplying this parameter. There should be
315 a better explanation of this, but until then, here's an example:
318 tie %hash, 'Tie::RefHash'; #this part is important
320 $cust_pkg => [ $svc_acct ],
323 $cust_main->insert( \%hash );
325 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
326 be set as the invoicing list (see L<"invoicing_list">). Errors return as
327 expected and rollback the entire transaction; it is not necessary to call
328 check_invoicing_list first. The invoicing_list is set after the records in the
329 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
330 invoicing_list destination to the newly-created svc_acct. Here's an example:
332 $cust_main->insert( {}, [ $email, 'POST' ] );
334 Currently available options are: I<depend_jobnum>, I<noexport>,
335 I<tax_exemption>, I<prospectnum>, I<contact> and I<contact_params>.
337 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
338 on the supplied jobnum (they will not run until the specific job completes).
339 This can be used to defer provisioning until some action completes (such
340 as running the customer's credit card successfully).
342 The I<noexport> option is deprecated. If I<noexport> is set true, no
343 provisioning jobs (exports) are scheduled. (You can schedule them later with
344 the B<reexport> method.)
346 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
347 of tax names and exemption numbers. FS::cust_main_exemption records will be
348 created and inserted.
350 If I<prospectnum> is set, moves contacts and locations from that prospect.
352 If I<contact> is set to an arrayref of FS::contact objects, inserts those
353 new contacts with this new customer.
355 If I<contact_params> is set to a hashref of CGI parameters (and I<contact> is
356 unset), inserts those new contacts with this new customer. Handles CGI
357 paramaters for an "m2" multiple entry field as passed by edit/cust_main.cgi
359 If I<cust_payby_params> is set to a hashref o fCGI parameters, inserts those
360 new stored payment records with this new customer. Handles CGI parameters
361 for an "m2" multiple entry field as passed by edit/cust_main.cgi
367 my $cust_pkgs = @_ ? shift : {};
368 my $invoicing_list = @_ ? shift : '';
370 warn "$me insert called with options ".
371 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
374 local $SIG{HUP} = 'IGNORE';
375 local $SIG{INT} = 'IGNORE';
376 local $SIG{QUIT} = 'IGNORE';
377 local $SIG{TERM} = 'IGNORE';
378 local $SIG{TSTP} = 'IGNORE';
379 local $SIG{PIPE} = 'IGNORE';
381 my $oldAutoCommit = $FS::UID::AutoCommit;
382 local $FS::UID::AutoCommit = 0;
385 my $prepay_identifier = '';
386 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
388 if ( $self->payby eq 'PREPAY' ) {
390 $self->payby(''); #'BILL');
391 $prepay_identifier = $self->payinfo;
394 warn " looking up prepaid card $prepay_identifier\n"
397 my $error = $self->get_prepay( $prepay_identifier,
398 'amount_ref' => \$amount,
399 'seconds_ref' => \$seconds,
400 'upbytes_ref' => \$upbytes,
401 'downbytes_ref' => \$downbytes,
402 'totalbytes_ref' => \$totalbytes,
405 $dbh->rollback if $oldAutoCommit;
406 #return "error applying prepaid card (transaction rolled back): $error";
410 $payby = 'PREP' if $amount;
412 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
415 $self->payby(''); #'BILL');
416 $amount = $self->paid;
421 foreach my $l (qw(bill_location ship_location)) {
423 my $loc = delete $self->hashref->{$l} or next;
425 if ( !$loc->locationnum ) {
426 # warn the location that we're going to insert it with no custnum
427 $loc->set(custnum_pending => 1);
428 warn " inserting $l\n"
430 my $error = $loc->insert;
432 $dbh->rollback if $oldAutoCommit;
433 my $label = $l eq 'ship_location' ? 'service' : 'billing';
434 return "$error (in $label location)";
437 } elsif ( $loc->prospectnum ) {
439 $loc->prospectnum('');
440 $loc->set(custnum_pending => 1);
441 my $error = $loc->replace;
443 $dbh->rollback if $oldAutoCommit;
444 my $label = $l eq 'ship_location' ? 'service' : 'billing';
445 return "$error (moving $label location)";
448 } elsif ( ($loc->custnum || 0) > 0 ) {
449 # then it somehow belongs to another customer--shouldn't happen
450 $dbh->rollback if $oldAutoCommit;
451 return "$l belongs to customer ".$loc->custnum;
453 # else it already belongs to this customer
454 # (happens when ship_location is identical to bill_location)
456 $self->set($l.'num', $loc->locationnum);
458 if ( $self->get($l.'num') eq '' ) {
459 $dbh->rollback if $oldAutoCommit;
464 warn " inserting $self\n"
467 $self->signupdate(time) unless $self->signupdate;
469 $self->auto_agent_custid()
470 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
472 my $error = $self->SUPER::insert;
474 $dbh->rollback if $oldAutoCommit;
475 #return "inserting cust_main record (transaction rolled back): $error";
479 # now set cust_location.custnum
480 foreach my $l (qw(bill_location ship_location)) {
481 warn " setting $l.custnum\n"
483 my $loc = $self->$l or next;
484 unless ( $loc->custnum ) {
485 $loc->set(custnum => $self->custnum);
486 $error ||= $loc->replace;
490 $dbh->rollback if $oldAutoCommit;
491 return "error setting $l custnum: $error";
495 warn " setting invoicing list\n"
498 if ( $invoicing_list ) {
499 $error = $self->check_invoicing_list( $invoicing_list );
501 $dbh->rollback if $oldAutoCommit;
502 #return "checking invoicing_list (transaction rolled back): $error";
505 $self->invoicing_list( $invoicing_list );
508 warn " setting customer tags\n"
511 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
512 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
513 'custnum' => $self->custnum };
514 my $error = $cust_tag->insert;
516 $dbh->rollback if $oldAutoCommit;
521 my $prospectnum = delete $options{'prospectnum'};
522 if ( $prospectnum ) {
524 warn " moving contacts and locations from prospect $prospectnum\n"
528 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
529 unless ( $prospect_main ) {
530 $dbh->rollback if $oldAutoCommit;
531 return "Unknown prospectnum $prospectnum";
533 $prospect_main->custnum($self->custnum);
534 $prospect_main->disabled('Y');
535 my $error = $prospect_main->replace;
537 $dbh->rollback if $oldAutoCommit;
541 foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
542 my $cust_contact = new FS::cust_contact {
543 'custnum' => $self->custnum,
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;
569 warn " setting contacts\n"
572 if ( my $contact = delete $options{'contact'} ) {
574 foreach my $c ( @$contact ) {
575 $c->custnum($self->custnum);
576 my $error = $c->insert;
578 $dbh->rollback if $oldAutoCommit;
584 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
586 my $error = $self->process_o2m( 'table' => 'contact',
587 'fields' => FS::contact->cgi_contact_fields,
588 'params' => $contact_params,
591 $dbh->rollback if $oldAutoCommit;
596 warn " setting cust_payby\n"
599 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
601 my $error = $self->process_o2m(
602 'table' => 'cust_payby',
603 'fields' => FS::cust_payby->cgi_cust_payby_fields,
604 'params' => $cust_payby_params,
605 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
608 $dbh->rollback if $oldAutoCommit;
614 warn " setting cust_main_exemption\n"
617 my $tax_exemption = delete $options{'tax_exemption'};
618 if ( $tax_exemption ) {
620 $tax_exemption = { map { $_ => '' } @$tax_exemption }
621 if ref($tax_exemption) eq 'ARRAY';
623 foreach my $taxname ( keys %$tax_exemption ) {
624 my $cust_main_exemption = new FS::cust_main_exemption {
625 'custnum' => $self->custnum,
626 'taxname' => $taxname,
627 'exempt_number' => $tax_exemption->{$taxname},
629 my $error = $cust_main_exemption->insert;
631 $dbh->rollback if $oldAutoCommit;
632 return "inserting cust_main_exemption (transaction rolled back): $error";
637 warn " ordering packages\n"
640 $error = $self->order_pkgs( $cust_pkgs,
642 'seconds_ref' => \$seconds,
643 'upbytes_ref' => \$upbytes,
644 'downbytes_ref' => \$downbytes,
645 'totalbytes_ref' => \$totalbytes,
648 $dbh->rollback if $oldAutoCommit;
653 $dbh->rollback if $oldAutoCommit;
654 return "No svc_acct record to apply pre-paid time";
656 if ( $upbytes || $downbytes || $totalbytes ) {
657 $dbh->rollback if $oldAutoCommit;
658 return "No svc_acct record to apply pre-paid data";
662 warn " inserting initial $payby payment of $amount\n"
664 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
666 $dbh->rollback if $oldAutoCommit;
667 return "inserting payment (transaction rolled back): $error";
671 unless ( $import || $skip_fuzzyfiles ) {
672 warn " queueing fuzzyfiles update\n"
674 $error = $self->queue_fuzzyfiles_update;
676 $dbh->rollback if $oldAutoCommit;
677 return "updating fuzzy search cache: $error";
681 # FS::geocode_Mixin::after_insert or something?
682 if ( $conf->config('tax_district_method') and !$import ) {
683 # if anything non-empty, try to look it up
684 my $queue = new FS::queue {
685 'job' => 'FS::geocode_Mixin::process_district_update',
686 'custnum' => $self->custnum,
688 my $error = $queue->insert( ref($self), $self->custnum );
690 $dbh->rollback if $oldAutoCommit;
691 return "queueing tax district update: $error";
696 warn " exporting\n" if $DEBUG > 1;
698 my $export_args = $options{'export_args'} || [];
701 map qsearch( 'part_export', {exportnum=>$_} ),
702 $conf->config('cust_main-exports'); #, $agentnum
704 foreach my $part_export ( @part_export ) {
705 my $error = $part_export->export_insert($self, @$export_args);
707 $dbh->rollback if $oldAutoCommit;
708 return "exporting to ". $part_export->exporttype.
709 " (transaction rolled back): $error";
713 #foreach my $depend_jobnum ( @$depend_jobnums ) {
714 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
716 # foreach my $jobnum ( @jobnums ) {
717 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
718 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
720 # my $error = $queue->depend_insert($depend_jobnum);
722 # $dbh->rollback if $oldAutoCommit;
723 # return "error queuing job dependancy: $error";
730 #if ( exists $options{'jobnums'} ) {
731 # push @{ $options{'jobnums'} }, @jobnums;
734 warn " insert complete; committing transaction\n"
737 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
742 use File::CounterFile;
743 sub auto_agent_custid {
746 my $format = $conf->config('cust_main-auto_agent_custid');
748 if ( $format eq '1YMMXXXXXXXX' ) {
750 my $counter = new File::CounterFile 'cust_main.agent_custid';
753 my $ym = 100000000000 + time2str('%y%m00000000', time);
754 if ( $ym > $counter->value ) {
755 $counter->{'value'} = $agent_custid = $ym;
756 $counter->{'updated'} = 1;
758 $agent_custid = $counter->inc;
764 die "Unknown cust_main-auto_agent_custid format: $format";
767 $self->agent_custid($agent_custid);
771 =item PACKAGE METHODS
773 Documentation on customer package methods has been moved to
774 L<FS::cust_main::Packages>.
776 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
778 Recharges this (existing) customer with the specified prepaid card (see
779 L<FS::prepay_credit>), specified either by I<identifier> or as an
780 FS::prepay_credit object. If there is an error, returns the error, otherwise
783 Optionally, five scalar references can be passed as well. They will have their
784 values filled in with the amount, number of seconds, and number of upload,
785 download, and total bytes applied by this prepaid card.
789 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
790 #the only place that uses these args
791 sub recharge_prepay {
792 my( $self, $prepay_credit, $amountref, $secondsref,
793 $upbytesref, $downbytesref, $totalbytesref ) = @_;
795 local $SIG{HUP} = 'IGNORE';
796 local $SIG{INT} = 'IGNORE';
797 local $SIG{QUIT} = 'IGNORE';
798 local $SIG{TERM} = 'IGNORE';
799 local $SIG{TSTP} = 'IGNORE';
800 local $SIG{PIPE} = 'IGNORE';
802 my $oldAutoCommit = $FS::UID::AutoCommit;
803 local $FS::UID::AutoCommit = 0;
806 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
808 my $error = $self->get_prepay( $prepay_credit,
809 'amount_ref' => \$amount,
810 'seconds_ref' => \$seconds,
811 'upbytes_ref' => \$upbytes,
812 'downbytes_ref' => \$downbytes,
813 'totalbytes_ref' => \$totalbytes,
815 || $self->increment_seconds($seconds)
816 || $self->increment_upbytes($upbytes)
817 || $self->increment_downbytes($downbytes)
818 || $self->increment_totalbytes($totalbytes)
819 || $self->insert_cust_pay_prepay( $amount,
821 ? $prepay_credit->identifier
826 $dbh->rollback if $oldAutoCommit;
830 if ( defined($amountref) ) { $$amountref = $amount; }
831 if ( defined($secondsref) ) { $$secondsref = $seconds; }
832 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
833 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
834 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
836 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
841 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
843 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
844 specified either by I<identifier> or as an FS::prepay_credit object.
846 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
847 incremented by the values of the prepaid card.
849 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
850 check or set this customer's I<agentnum>.
852 If there is an error, returns the error, otherwise returns false.
858 my( $self, $prepay_credit, %opt ) = @_;
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 unless ( ref($prepay_credit) ) {
873 my $identifier = $prepay_credit;
875 $prepay_credit = qsearchs(
877 { 'identifier' => $identifier },
882 unless ( $prepay_credit ) {
883 $dbh->rollback if $oldAutoCommit;
884 return "Invalid prepaid card: ". $identifier;
889 if ( $prepay_credit->agentnum ) {
890 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
891 $dbh->rollback if $oldAutoCommit;
892 return "prepaid card not valid for agent ". $self->agentnum;
894 $self->agentnum($prepay_credit->agentnum);
897 my $error = $prepay_credit->delete;
899 $dbh->rollback if $oldAutoCommit;
900 return "removing prepay_credit (transaction rolled back): $error";
903 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
904 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
906 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
911 =item increment_upbytes SECONDS
913 Updates this customer's single or primary account (see L<FS::svc_acct>) by
914 the specified number of upbytes. If there is an error, returns the error,
915 otherwise returns false.
919 sub increment_upbytes {
920 _increment_column( shift, 'upbytes', @_);
923 =item increment_downbytes SECONDS
925 Updates this customer's single or primary account (see L<FS::svc_acct>) by
926 the specified number of downbytes. If there is an error, returns the error,
927 otherwise returns false.
931 sub increment_downbytes {
932 _increment_column( shift, 'downbytes', @_);
935 =item increment_totalbytes SECONDS
937 Updates this customer's single or primary account (see L<FS::svc_acct>) by
938 the specified number of totalbytes. If there is an error, returns the error,
939 otherwise returns false.
943 sub increment_totalbytes {
944 _increment_column( shift, 'totalbytes', @_);
947 =item increment_seconds SECONDS
949 Updates this customer's single or primary account (see L<FS::svc_acct>) by
950 the specified number of seconds. If there is an error, returns the error,
951 otherwise returns false.
955 sub increment_seconds {
956 _increment_column( shift, 'seconds', @_);
959 =item _increment_column AMOUNT
961 Updates this customer's single or primary account (see L<FS::svc_acct>) by
962 the specified number of seconds or bytes. If there is an error, returns
963 the error, otherwise returns false.
967 sub _increment_column {
968 my( $self, $column, $amount ) = @_;
969 warn "$me increment_column called: $column, $amount\n"
972 return '' unless $amount;
974 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
975 $self->ncancelled_pkgs;
978 return 'No packages with primary or single services found'.
979 ' to apply pre-paid time';
980 } elsif ( scalar(@cust_pkg) > 1 ) {
981 #maybe have a way to specify the package/account?
982 return 'Multiple packages found to apply pre-paid time';
985 my $cust_pkg = $cust_pkg[0];
986 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
990 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
993 return 'No account found to apply pre-paid time';
994 } elsif ( scalar(@cust_svc) > 1 ) {
995 return 'Multiple accounts found to apply pre-paid time';
998 my $svc_acct = $cust_svc[0]->svc_x;
999 warn " found service svcnum ". $svc_acct->pkgnum.
1000 ' ('. $svc_acct->email. ")\n"
1003 $column = "increment_$column";
1004 $svc_acct->$column($amount);
1008 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1010 Inserts a prepayment in the specified amount for this customer. An optional
1011 second argument can specify the prepayment identifier for tracking purposes.
1012 If there is an error, returns the error, otherwise returns false.
1016 sub insert_cust_pay_prepay {
1017 shift->insert_cust_pay('PREP', @_);
1020 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1022 Inserts a cash payment in the specified amount for this customer. An optional
1023 second argument can specify the payment identifier for tracking purposes.
1024 If there is an error, returns the error, otherwise returns false.
1028 sub insert_cust_pay_cash {
1029 shift->insert_cust_pay('CASH', @_);
1032 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1034 Inserts a Western Union payment in the specified amount for this customer. An
1035 optional second argument can specify the prepayment identifier for tracking
1036 purposes. If there is an error, returns the error, otherwise returns false.
1040 sub insert_cust_pay_west {
1041 shift->insert_cust_pay('WEST', @_);
1044 sub insert_cust_pay {
1045 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1046 my $payinfo = scalar(@_) ? shift : '';
1048 my $cust_pay = new FS::cust_pay {
1049 'custnum' => $self->custnum,
1050 'paid' => sprintf('%.2f', $amount),
1051 #'_date' => #date the prepaid card was purchased???
1053 'payinfo' => $payinfo,
1059 =item delete [ OPTION => VALUE ... ]
1061 This deletes the customer. If there is an error, returns the error, otherwise
1064 This will completely remove all traces of the customer record. This is not
1065 what you want when a customer cancels service; for that, cancel all of the
1066 customer's packages (see L</cancel>).
1068 If the customer has any uncancelled packages, you need to pass a new (valid)
1069 customer number for those packages to be transferred to, as the "new_customer"
1070 option. Cancelled packages will be deleted. Did I mention that this is NOT
1071 what you want when a customer cancels service and that you really should be
1072 looking at L<FS::cust_pkg/cancel>?
1074 You can't delete a customer with invoices (see L<FS::cust_bill>),
1075 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1076 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1077 set the "delete_financials" option to a true value.
1082 my( $self, %opt ) = @_;
1084 local $SIG{HUP} = 'IGNORE';
1085 local $SIG{INT} = 'IGNORE';
1086 local $SIG{QUIT} = 'IGNORE';
1087 local $SIG{TERM} = 'IGNORE';
1088 local $SIG{TSTP} = 'IGNORE';
1089 local $SIG{PIPE} = 'IGNORE';
1091 my $oldAutoCommit = $FS::UID::AutoCommit;
1092 local $FS::UID::AutoCommit = 0;
1095 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1096 $dbh->rollback if $oldAutoCommit;
1097 return "Can't delete a master agent customer";
1100 #use FS::access_user
1101 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1102 $dbh->rollback if $oldAutoCommit;
1103 return "Can't delete a master employee customer";
1106 tie my %financial_tables, 'Tie::IxHash',
1107 'cust_bill' => 'invoices',
1108 'cust_statement' => 'statements',
1109 'cust_credit' => 'credits',
1110 'cust_pay' => 'payments',
1111 'cust_refund' => 'refunds',
1114 foreach my $table ( keys %financial_tables ) {
1116 my @records = $self->$table();
1118 if ( @records && ! $opt{'delete_financials'} ) {
1119 $dbh->rollback if $oldAutoCommit;
1120 return "Can't delete a customer with ". $financial_tables{$table};
1123 foreach my $record ( @records ) {
1124 my $error = $record->delete;
1126 $dbh->rollback if $oldAutoCommit;
1127 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1133 my @cust_pkg = $self->ncancelled_pkgs;
1135 my $new_custnum = $opt{'new_custnum'};
1136 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1137 $dbh->rollback if $oldAutoCommit;
1138 return "Invalid new customer number: $new_custnum";
1140 foreach my $cust_pkg ( @cust_pkg ) {
1141 my %hash = $cust_pkg->hash;
1142 $hash{'custnum'} = $new_custnum;
1143 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1144 my $error = $new_cust_pkg->replace($cust_pkg,
1145 options => { $cust_pkg->options },
1148 $dbh->rollback if $oldAutoCommit;
1153 my @cancelled_cust_pkg = $self->all_pkgs;
1154 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1155 my $error = $cust_pkg->delete;
1157 $dbh->rollback if $oldAutoCommit;
1162 #cust_tax_adjustment in financials?
1163 #cust_pay_pending? ouch
1164 foreach my $table (qw(
1165 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1166 cust_payby cust_location cust_main_note cust_tax_adjustment
1167 cust_pay_void cust_pay_batch queue cust_tax_exempt
1169 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1170 my $error = $record->delete;
1172 $dbh->rollback if $oldAutoCommit;
1178 my $sth = $dbh->prepare(
1179 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1181 my $errstr = $dbh->errstr;
1182 $dbh->rollback if $oldAutoCommit;
1185 $sth->execute($self->custnum) or do {
1186 my $errstr = $sth->errstr;
1187 $dbh->rollback if $oldAutoCommit;
1193 my $ticket_dbh = '';
1194 if ($conf->config('ticket_system') eq 'RT_Internal') {
1196 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1197 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1198 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1199 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1202 if ( $ticket_dbh ) {
1204 my $ticket_sth = $ticket_dbh->prepare(
1205 'DELETE FROM Links WHERE Target = ?'
1207 my $errstr = $ticket_dbh->errstr;
1208 $dbh->rollback if $oldAutoCommit;
1211 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1213 my $errstr = $ticket_sth->errstr;
1214 $dbh->rollback if $oldAutoCommit;
1218 #check and see if the customer is the only link on the ticket, and
1219 #if so, set the ticket to deleted status in RT?
1220 #maybe someday, for now this will at least fix tickets not displaying
1224 #delete the customer record
1226 my $error = $self->SUPER::delete;
1228 $dbh->rollback if $oldAutoCommit;
1232 # cust_main exports!
1234 #my $export_args = $options{'export_args'} || [];
1237 map qsearch( 'part_export', {exportnum=>$_} ),
1238 $conf->config('cust_main-exports'); #, $agentnum
1240 foreach my $part_export ( @part_export ) {
1241 my $error = $part_export->export_delete( $self ); #, @$export_args);
1243 $dbh->rollback if $oldAutoCommit;
1244 return "exporting to ". $part_export->exporttype.
1245 " (transaction rolled back): $error";
1249 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1254 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1256 Replaces the OLD_RECORD with this one in the database. If there is an error,
1257 returns the error, otherwise returns false.
1259 To change the customer's address, set the pseudo-fields C<bill_location> and
1260 C<ship_location>. The address will still only change if at least one of the
1261 address fields differs from the existing values.
1263 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1264 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1265 expected and rollback the entire transaction; it is not necessary to call
1266 check_invoicing_list first. Here's an example:
1268 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1270 Currently available options are: I<tax_exemption>.
1272 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1273 of tax names and exemption numbers. FS::cust_main_exemption records will be
1274 deleted and inserted as appropriate.
1281 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1283 : $self->replace_old;
1287 warn "$me replace called\n"
1290 my $curuser = $FS::CurrentUser::CurrentUser;
1291 return "You are not permitted to create complimentary accounts."
1292 if $self->complimentary eq 'Y'
1293 && $self->complimentary ne $old->complimentary
1294 && ! $curuser->access_right('Complimentary customer');
1296 local($ignore_expired_card) = 1
1297 if $old->payby =~ /^(CARD|DCRD)$/
1298 && $self->payby =~ /^(CARD|DCRD)$/
1299 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1301 local($ignore_banned_card) = 1
1302 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1303 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1304 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1306 return "Invoicing locale is required"
1309 && $conf->exists('cust_main-require_locale');
1311 local $SIG{HUP} = 'IGNORE';
1312 local $SIG{INT} = 'IGNORE';
1313 local $SIG{QUIT} = 'IGNORE';
1314 local $SIG{TERM} = 'IGNORE';
1315 local $SIG{TSTP} = 'IGNORE';
1316 local $SIG{PIPE} = 'IGNORE';
1318 my $oldAutoCommit = $FS::UID::AutoCommit;
1319 local $FS::UID::AutoCommit = 0;
1322 for my $l (qw(bill_location ship_location)) {
1323 #my $old_loc = $old->$l;
1324 my $new_loc = $self->$l or next;
1326 # find the existing location if there is one
1327 $new_loc->set('custnum' => $self->custnum);
1328 my $error = $new_loc->find_or_insert;
1330 $dbh->rollback if $oldAutoCommit;
1333 $self->set($l.'num', $new_loc->locationnum);
1336 # replace the customer record
1337 my $error = $self->SUPER::replace($old);
1340 $dbh->rollback if $oldAutoCommit;
1344 # now move packages to the new service location
1345 $self->set('ship_location', ''); #flush cache
1346 if ( $old->ship_locationnum and # should only be null during upgrade...
1347 $old->ship_locationnum != $self->ship_locationnum ) {
1348 $error = $old->ship_location->move_to($self->ship_location);
1350 $dbh->rollback if $oldAutoCommit;
1354 # don't move packages based on the billing location, but
1355 # disable it if it's no longer in use
1356 if ( $old->bill_locationnum and
1357 $old->bill_locationnum != $self->bill_locationnum ) {
1358 $error = $old->bill_location->disable_if_unused;
1360 $dbh->rollback if $oldAutoCommit;
1365 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1366 my $invoicing_list = shift @param;
1367 $error = $self->check_invoicing_list( $invoicing_list );
1369 $dbh->rollback if $oldAutoCommit;
1372 $self->invoicing_list( $invoicing_list );
1375 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1377 #this could be more efficient than deleting and re-inserting, if it matters
1378 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1379 my $error = $cust_tag->delete;
1381 $dbh->rollback if $oldAutoCommit;
1385 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1386 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1387 'custnum' => $self->custnum };
1388 my $error = $cust_tag->insert;
1390 $dbh->rollback if $oldAutoCommit;
1397 my %options = @param;
1399 my $tax_exemption = delete $options{'tax_exemption'};
1400 if ( $tax_exemption ) {
1402 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1403 if ref($tax_exemption) eq 'ARRAY';
1405 my %cust_main_exemption =
1406 map { $_->taxname => $_ }
1407 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1409 foreach my $taxname ( keys %$tax_exemption ) {
1411 if ( $cust_main_exemption{$taxname} &&
1412 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1415 delete $cust_main_exemption{$taxname};
1419 my $cust_main_exemption = new FS::cust_main_exemption {
1420 'custnum' => $self->custnum,
1421 'taxname' => $taxname,
1422 'exempt_number' => $tax_exemption->{$taxname},
1424 my $error = $cust_main_exemption->insert;
1426 $dbh->rollback if $oldAutoCommit;
1427 return "inserting cust_main_exemption (transaction rolled back): $error";
1431 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1432 my $error = $cust_main_exemption->delete;
1434 $dbh->rollback if $oldAutoCommit;
1435 return "deleting cust_main_exemption (transaction rolled back): $error";
1441 if ( my $cust_payby_params = delete $options{'cust_payby_params'} ) {
1443 my $error = $self->process_o2m(
1444 'table' => 'cust_payby',
1445 'fields' => FS::cust_payby->cgi_cust_payby_fields,
1446 'params' => $cust_payby_params,
1447 'hash_callback' => \&FS::cust_payby::cgi_hash_callback,
1450 $dbh->rollback if $oldAutoCommit;
1456 unless ( $import || $skip_fuzzyfiles ) {
1457 $error = $self->queue_fuzzyfiles_update;
1459 $dbh->rollback if $oldAutoCommit;
1460 return "updating fuzzy search cache: $error";
1464 # tax district update in cust_location
1466 # cust_main exports!
1468 my $export_args = $options{'export_args'} || [];
1471 map qsearch( 'part_export', {exportnum=>$_} ),
1472 $conf->config('cust_main-exports'); #, $agentnum
1474 foreach my $part_export ( @part_export ) {
1475 my $error = $part_export->export_replace( $self, $old, @$export_args);
1477 $dbh->rollback if $oldAutoCommit;
1478 return "exporting to ". $part_export->exporttype.
1479 " (transaction rolled back): $error";
1483 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1488 =item queue_fuzzyfiles_update
1490 Used by insert & replace to update the fuzzy search cache
1494 use FS::cust_main::Search;
1495 sub queue_fuzzyfiles_update {
1498 local $SIG{HUP} = 'IGNORE';
1499 local $SIG{INT} = 'IGNORE';
1500 local $SIG{QUIT} = 'IGNORE';
1501 local $SIG{TERM} = 'IGNORE';
1502 local $SIG{TSTP} = 'IGNORE';
1503 local $SIG{PIPE} = 'IGNORE';
1505 my $oldAutoCommit = $FS::UID::AutoCommit;
1506 local $FS::UID::AutoCommit = 0;
1509 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1510 my $queue = new FS::queue {
1511 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1513 my @args = "cust_main.$field", $self->get($field);
1514 my $error = $queue->insert( @args );
1516 $dbh->rollback if $oldAutoCommit;
1517 return "queueing job (transaction rolled back): $error";
1522 push @locations, $self->bill_location if $self->bill_locationnum;
1523 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1524 foreach my $location (@locations) {
1525 my $queue = new FS::queue {
1526 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1528 my @args = 'cust_location.address1', $location->address1;
1529 my $error = $queue->insert( @args );
1531 $dbh->rollback if $oldAutoCommit;
1532 return "queueing job (transaction rolled back): $error";
1536 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1543 Checks all fields to make sure this is a valid customer record. If there is
1544 an error, returns the error, otherwise returns false. Called by the insert
1545 and replace methods.
1552 warn "$me check BEFORE: \n". $self->_dump
1556 $self->ut_numbern('custnum')
1557 || $self->ut_number('agentnum')
1558 || $self->ut_textn('agent_custid')
1559 || $self->ut_number('refnum')
1560 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1561 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1562 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1563 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1564 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1565 || $self->ut_textn('custbatch')
1566 || $self->ut_name('last')
1567 || $self->ut_name('first')
1568 || $self->ut_snumbern('signupdate')
1569 || $self->ut_snumbern('birthdate')
1570 || $self->ut_namen('spouse_last')
1571 || $self->ut_namen('spouse_first')
1572 || $self->ut_snumbern('spouse_birthdate')
1573 || $self->ut_snumbern('anniversary_date')
1574 || $self->ut_textn('company')
1575 || $self->ut_textn('ship_company')
1576 || $self->ut_anything('comments')
1577 || $self->ut_numbern('referral_custnum')
1578 || $self->ut_textn('stateid')
1579 || $self->ut_textn('stateid_state')
1580 || $self->ut_textn('invoice_terms')
1581 || $self->ut_floatn('cdr_termination_percentage')
1582 || $self->ut_floatn('credit_limit')
1583 || $self->ut_numbern('billday')
1584 || $self->ut_numbern('prorate_day')
1585 || $self->ut_flag('edit_subject')
1586 || $self->ut_flag('calling_list_exempt')
1587 || $self->ut_flag('invoice_noemail')
1588 || $self->ut_flag('message_noemail')
1589 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1590 || $self->ut_currencyn('currency')
1591 || $self->ut_alphan('po_number')
1592 || $self->ut_enum('complimentary', [ '', 'Y' ])
1595 foreach (qw(company ship_company)) {
1596 my $company = $self->get($_);
1597 $company =~ s/^\s+//;
1598 $company =~ s/\s+$//;
1599 $company =~ s/\s+/ /g;
1600 $self->set($_, $company);
1603 #barf. need message catalogs. i18n. etc.
1604 $error .= "Please select an advertising source."
1605 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1606 return $error if $error;
1608 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1609 or return "Unknown agent";
1611 if ( $self->currency ) {
1612 my $agent_currency = qsearchs( 'agent_currency', {
1613 'agentnum' => $agent->agentnum,
1614 'currency' => $self->currency,
1616 or return "Agent ". $agent->agent.
1617 " not permitted to offer ". $self->currency. " invoicing";
1620 return "Unknown refnum"
1621 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1623 return "Unknown referring custnum: ". $self->referral_custnum
1624 unless ! $self->referral_custnum
1625 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1627 if ( $self->ss eq '' ) {
1632 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1633 or return "Illegal social security number: ". $self->ss;
1634 $self->ss("$1-$2-$3");
1637 # cust_main_county verification now handled by cust_location check
1640 $self->ut_phonen('daytime', $self->country)
1641 || $self->ut_phonen('night', $self->country)
1642 || $self->ut_phonen('fax', $self->country)
1643 || $self->ut_phonen('mobile', $self->country)
1645 return $error if $error;
1647 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1649 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1652 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1654 : FS::Msgcat::_gettext('daytime');
1655 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1657 : FS::Msgcat::_gettext('night');
1659 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1661 : FS::Msgcat::_gettext('mobile');
1663 return "$daytime_label, $night_label or $mobile_label is required"
1667 ### start of stuff moved to cust_payby
1668 # then mostly kept here to support upgrades (can remove in 5.x)
1669 # but modified to allow everything to be empty
1671 if ( $self->payby ) {
1672 FS::payby->can_payby($self->table, $self->payby)
1673 or return "Illegal payby: ". $self->payby;
1678 $error = $self->ut_numbern('paystart_month')
1679 || $self->ut_numbern('paystart_year')
1680 || $self->ut_numbern('payissue')
1681 || $self->ut_textn('paytype')
1683 return $error if $error;
1685 if ( $self->payip eq '' ) {
1688 $error = $self->ut_ip('payip');
1689 return $error if $error;
1692 # If it is encrypted and the private key is not availaible then we can't
1693 # check the credit card.
1694 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1696 # Need some kind of global flag to accept invalid cards, for testing
1698 if ( !$import && !$ignore_invalid_card && $check_payinfo &&
1699 $self->payby =~ /^(CARD|DCRD)$/ ) {
1701 my $payinfo = $self->payinfo;
1702 $payinfo =~ s/\D//g;
1703 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1704 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1706 $self->payinfo($payinfo);
1708 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1710 return gettext('unknown_card_type')
1711 if $self->payinfo !~ /^99\d{14}$/ #token
1712 && cardtype($self->payinfo) eq "Unknown";
1714 unless ( $ignore_banned_card ) {
1715 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1717 if ( $ban->bantype eq 'warn' ) {
1718 #or others depending on value of $ban->reason ?
1719 return '_duplicate_card'.
1720 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1721 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1722 ' (ban# '. $ban->bannum. ')'
1723 unless $self->override_ban_warn;
1725 return 'Banned credit card: banned on '.
1726 time2str('%a %h %o at %r', $ban->_date).
1727 ' by '. $ban->otaker.
1728 ' (ban# '. $ban->bannum. ')';
1733 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1734 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1735 $self->paycvv =~ /^(\d{4})$/
1736 or return "CVV2 (CID) for American Express cards is four digits.";
1739 $self->paycvv =~ /^(\d{3})$/
1740 or return "CVV2 (CVC2/CID) is three digits.";
1747 my $cardtype = cardtype($payinfo);
1748 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1750 return "Start date or issue number is required for $cardtype cards"
1751 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1753 return "Start month must be between 1 and 12"
1754 if $self->paystart_month
1755 and $self->paystart_month < 1 || $self->paystart_month > 12;
1757 return "Start year must be 1990 or later"
1758 if $self->paystart_year
1759 and $self->paystart_year < 1990;
1761 return "Issue number must be beween 1 and 99"
1763 and $self->payissue < 1 || $self->payissue > 99;
1766 $self->paystart_month('');
1767 $self->paystart_year('');
1768 $self->payissue('');
1771 } elsif ( !$ignore_invalid_card && $check_payinfo &&
1772 $self->payby =~ /^(CHEK|DCHK)$/ ) {
1774 my $payinfo = $self->payinfo;
1775 $payinfo =~ s/[^\d\@\.]//g;
1776 if ( $conf->config('echeck-country') eq 'CA' ) {
1777 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1778 or return 'invalid echeck account@branch.bank';
1779 $payinfo = "$1\@$2.$3";
1780 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1781 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1782 $payinfo = "$1\@$2";
1784 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1785 $payinfo = "$1\@$2";
1787 $self->payinfo($payinfo);
1790 unless ( $ignore_banned_card ) {
1791 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1793 if ( $ban->bantype eq 'warn' ) {
1794 #or others depending on value of $ban->reason ?
1795 return '_duplicate_ach' unless $self->override_ban_warn;
1797 return 'Banned ACH account: banned on '.
1798 time2str('%a %h %o at %r', $ban->_date).
1799 ' by '. $ban->otaker.
1800 ' (ban# '. $ban->bannum. ')';
1805 } elsif ( $self->payby eq 'LECB' ) {
1807 my $payinfo = $self->payinfo;
1808 $payinfo =~ s/\D//g;
1809 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1811 $self->payinfo($payinfo);
1814 } elsif ( $self->payby eq 'BILL' ) {
1816 $error = $self->ut_textn('payinfo');
1817 return "Illegal P.O. number: ". $self->payinfo if $error;
1820 } elsif ( $self->payby eq 'COMP' ) {
1822 my $curuser = $FS::CurrentUser::CurrentUser;
1823 if ( ! $self->custnum
1824 && ! $curuser->access_right('Complimentary customer')
1827 return "You are not permitted to create complimentary accounts."
1830 $error = $self->ut_textn('payinfo');
1831 return "Illegal comp account issuer: ". $self->payinfo if $error;
1834 } elsif ( $self->payby eq 'PREPAY' ) {
1836 my $payinfo = $self->payinfo;
1837 $payinfo =~ s/\W//g; #anything else would just confuse things
1838 $self->payinfo($payinfo);
1839 $error = $self->ut_alpha('payinfo');
1840 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1841 return "Unknown prepayment identifier"
1842 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1847 return "You are not permitted to create complimentary accounts."
1849 && $self->complimentary eq 'Y'
1850 && ! $FS::CurrentUser->CurrentUser->access_right('Complimentary customer');
1852 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1853 return "Expiration date required"
1854 # shouldn't payinfo_check do this?
1855 unless ! $self->payby
1856 || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
1860 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1861 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1862 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1863 ( $m, $y ) = ( $2, "19$1" );
1864 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1865 ( $m, $y ) = ( $3, "20$2" );
1867 return "Illegal expiration date: ". $self->paydate;
1869 $m = sprintf('%02d',$m);
1870 $self->paydate("$y-$m-01");
1871 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1872 return gettext('expired_card')
1874 && !$ignore_expired_card
1875 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1878 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1879 ( ! $conf->exists('require_cardname')
1880 || $self->payby !~ /^(CARD|DCRD)$/ )
1882 $self->payname( $self->first. " ". $self->getfield('last') );
1885 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
1886 $self->payname =~ /^([\w \,\.\-\']*)$/
1887 or return gettext('illegal_name'). " payname: ". $self->payname;
1890 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
1891 or return gettext('illegal_name'). " payname: ". $self->payname;
1897 ### end of stuff moved to cust_payby
1899 return "Please select an invoicing locale"
1902 && $conf->exists('cust_main-require_locale');
1904 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1905 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1909 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1911 warn "$me check AFTER: \n". $self->_dump
1914 $self->SUPER::check;
1919 Returns a list of fields which have ship_ duplicates.
1924 qw( last first company
1926 address1 address2 city county state zip country
1928 daytime night fax mobile
1932 =item has_ship_address
1934 Returns true if this customer record has a separate shipping address.
1938 sub has_ship_address {
1940 $self->bill_locationnum != $self->ship_locationnum;
1945 Returns a list of key/value pairs, with the following keys: address1,
1946 adddress2, city, county, state, zip, country, district, and geocode. The
1947 shipping address is used if present.
1953 $self->ship_location->location_hash;
1958 Returns all locations (see L<FS::cust_location>) for this customer.
1964 qsearch('cust_location', { 'custnum' => $self->custnum,
1965 'prospectnum' => '' } );
1970 Returns all contact associations (see L<FS::cust_contact>) for this customer.
1976 qsearch('cust_contact', { 'custnum' => $self->custnum } );
1981 Returns all payment methods (see L<FS::cust_payby>) for this customer.
1988 'table' => 'cust_payby',
1989 'hashref' => { 'custnum' => $self->custnum },
1990 'order_by' => "ORDER BY payby IN ('CARD','CHEK') DESC, weight ASC",
1996 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1997 and L<FS::cust_pkg>) for this customer, except those on hold.
1999 Returns a list: an empty list on success or a list of errors.
2005 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2010 Unsuspends all suspended packages in the on-hold state (those without setup
2011 dates) for this customer.
2017 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2022 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2024 Returns a list: an empty list on success or a list of errors.
2030 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2033 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2035 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2036 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2037 of a list of pkgparts; the hashref has the following keys:
2041 =item pkgparts - listref of pkgparts
2043 =item (other options are passed to the suspend method)
2048 Returns a list: an empty list on success or a list of errors.
2052 sub suspend_if_pkgpart {
2054 my (@pkgparts, %opt);
2055 if (ref($_[0]) eq 'HASH'){
2056 @pkgparts = @{$_[0]{pkgparts}};
2061 grep { $_->suspend(%opt) }
2062 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2063 $self->unsuspended_pkgs;
2066 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2068 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2069 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2070 instead of a list of pkgparts; the hashref has the following keys:
2074 =item pkgparts - listref of pkgparts
2076 =item (other options are passed to the suspend method)
2080 Returns a list: an empty list on success or a list of errors.
2084 sub suspend_unless_pkgpart {
2086 my (@pkgparts, %opt);
2087 if (ref($_[0]) eq 'HASH'){
2088 @pkgparts = @{$_[0]{pkgparts}};
2093 grep { $_->suspend(%opt) }
2094 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2095 $self->unsuspended_pkgs;
2098 =item cancel [ OPTION => VALUE ... ]
2100 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2102 Available options are:
2106 =item quiet - can be set true to supress email cancellation notices.
2108 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
2110 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2112 =item nobill - can be set true to skip billing if it might otherwise be done.
2116 Always returns a list: an empty list on success or a list of errors.
2120 # nb that dates are not specified as valid options to this method
2123 my( $self, %opt ) = @_;
2125 warn "$me cancel called on customer ". $self->custnum. " with options ".
2126 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2129 return ( 'access denied' )
2130 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2132 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2134 #should try decryption (we might have the private key)
2135 # and if not maybe queue a job for the server that does?
2136 return ( "Can't (yet) ban encrypted credit cards" )
2137 if $self->is_encrypted($self->payinfo);
2139 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2140 my $error = $ban->insert;
2141 return ( $error ) if $error;
2145 my @pkgs = $self->ncancelled_pkgs;
2147 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2149 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2150 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2154 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2155 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2158 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2161 sub _banned_pay_hashref {
2172 'payby' => $payby2ban{$self->payby},
2173 'payinfo' => $self->payinfo,
2174 #don't ever *search* on reason! #'reason' =>
2178 sub _new_banned_pay_hashref {
2180 my $hr = $self->_banned_pay_hashref;
2181 $hr->{payinfo} = md5_base64($hr->{payinfo});
2187 Returns all notes (see L<FS::cust_main_note>) for this customer.
2192 my($self,$orderby_classnum) = (shift,shift);
2193 my $orderby = "sticky DESC, _date DESC";
2194 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2195 qsearch( 'cust_main_note',
2196 { 'custnum' => $self->custnum },
2198 "ORDER BY $orderby",
2204 Returns the agent (see L<FS::agent>) for this customer.
2208 Returns the agent name (see L<FS::agent>) for this customer.
2214 $self->agent->agent;
2219 Returns any tags associated with this customer, as FS::cust_tag objects,
2220 or an empty list if there are no tags.
2224 Returns any tags associated with this customer, as FS::part_tag objects,
2225 or an empty list if there are no tags.
2231 map $_->part_tag, $self->cust_tag;
2237 Returns the customer class, as an FS::cust_class object, or the empty string
2238 if there is no customer class.
2242 Returns the customer category name, or the empty string if there is no customer
2249 my $cust_class = $self->cust_class;
2251 ? $cust_class->categoryname
2257 Returns the customer class name, or the empty string if there is no customer
2264 my $cust_class = $self->cust_class;
2266 ? $cust_class->classname
2272 Returns the external tax status, as an FS::tax_status object, or the empty
2273 string if there is no tax status.
2279 if ( $self->taxstatusnum ) {
2280 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2288 Returns the tax status code if there is one.
2294 my $tax_status = $self->tax_status;
2296 ? $tax_status->taxstatus
2300 =item BILLING METHODS
2302 Documentation on billing methods has been moved to
2303 L<FS::cust_main::Billing>.
2305 =item REALTIME BILLING METHODS
2307 Documentation on realtime billing methods has been moved to
2308 L<FS::cust_main::Billing_Realtime>.
2312 Removes the I<paycvv> field from the database directly.
2314 If there is an error, returns the error, otherwise returns false.
2320 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2321 or return dbh->errstr;
2322 $sth->execute($self->custnum)
2323 or return $sth->errstr;
2330 Returns the total owed for this customer on all invoices
2331 (see L<FS::cust_bill/owed>).
2337 $self->total_owed_date(2145859200); #12/31/2037
2340 =item total_owed_date TIME
2342 Returns the total owed for this customer on all invoices with date earlier than
2343 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2344 see L<Time::Local> and L<Date::Parse> for conversion functions.
2348 sub total_owed_date {
2352 my $custnum = $self->custnum;
2354 my $owed_sql = FS::cust_bill->owed_sql;
2357 SELECT SUM($owed_sql) FROM cust_bill
2358 WHERE custnum = $custnum
2362 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2366 =item total_owed_pkgnum PKGNUM
2368 Returns the total owed on all invoices for this customer's specific package
2369 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2373 sub total_owed_pkgnum {
2374 my( $self, $pkgnum ) = @_;
2375 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2378 =item total_owed_date_pkgnum TIME PKGNUM
2380 Returns the total owed for this customer's specific package when using
2381 experimental package balances on all invoices with date earlier than
2382 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2383 see L<Time::Local> and L<Date::Parse> for conversion functions.
2387 sub total_owed_date_pkgnum {
2388 my( $self, $time, $pkgnum ) = @_;
2391 foreach my $cust_bill (
2392 grep { $_->_date <= $time }
2393 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2395 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2397 sprintf( "%.2f", $total_bill );
2403 Returns the total amount of all payments.
2410 $total += $_->paid foreach $self->cust_pay;
2411 sprintf( "%.2f", $total );
2414 =item total_unapplied_credits
2416 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2417 customer. See L<FS::cust_credit/credited>.
2419 =item total_credited
2421 Old name for total_unapplied_credits. Don't use.
2425 sub total_credited {
2426 #carp "total_credited deprecated, use total_unapplied_credits";
2427 shift->total_unapplied_credits(@_);
2430 sub total_unapplied_credits {
2433 my $custnum = $self->custnum;
2435 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2438 SELECT SUM($unapplied_sql) FROM cust_credit
2439 WHERE custnum = $custnum
2442 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2446 =item total_unapplied_credits_pkgnum PKGNUM
2448 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2449 customer. See L<FS::cust_credit/credited>.
2453 sub total_unapplied_credits_pkgnum {
2454 my( $self, $pkgnum ) = @_;
2455 my $total_credit = 0;
2456 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2457 sprintf( "%.2f", $total_credit );
2461 =item total_unapplied_payments
2463 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2464 See L<FS::cust_pay/unapplied>.
2468 sub total_unapplied_payments {
2471 my $custnum = $self->custnum;
2473 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2476 SELECT SUM($unapplied_sql) FROM cust_pay
2477 WHERE custnum = $custnum
2480 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2484 =item total_unapplied_payments_pkgnum PKGNUM
2486 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2487 specific package when using experimental package balances. See
2488 L<FS::cust_pay/unapplied>.
2492 sub total_unapplied_payments_pkgnum {
2493 my( $self, $pkgnum ) = @_;
2494 my $total_unapplied = 0;
2495 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2496 sprintf( "%.2f", $total_unapplied );
2500 =item total_unapplied_refunds
2502 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2503 customer. See L<FS::cust_refund/unapplied>.
2507 sub total_unapplied_refunds {
2509 my $custnum = $self->custnum;
2511 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2514 SELECT SUM($unapplied_sql) FROM cust_refund
2515 WHERE custnum = $custnum
2518 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2524 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2525 total_unapplied_credits minus total_unapplied_payments).
2531 $self->balance_date_range;
2534 =item balance_date TIME
2536 Returns the balance for this customer, only considering invoices with date
2537 earlier than TIME (total_owed_date minus total_credited minus
2538 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2539 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2546 $self->balance_date_range(shift);
2549 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2551 Returns the balance for this customer, optionally considering invoices with
2552 date earlier than START_TIME, and not later than END_TIME
2553 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2555 Times are specified as SQL fragments or numeric
2556 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2557 L<Date::Parse> for conversion functions. The empty string can be passed
2558 to disable that time constraint completely.
2560 Accepts the same options as L<balance_date_sql>:
2564 =item unapplied_date
2566 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)
2570 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2571 time will be ignored. Note that START_TIME and END_TIME only limit the date
2572 range for invoices and I<unapplied> payments, credits, and refunds.
2578 sub balance_date_range {
2580 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2581 ') FROM cust_main WHERE custnum='. $self->custnum;
2582 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2585 =item balance_pkgnum PKGNUM
2587 Returns the balance for this customer's specific package when using
2588 experimental package balances (total_owed plus total_unrefunded, minus
2589 total_unapplied_credits minus total_unapplied_payments)
2593 sub balance_pkgnum {
2594 my( $self, $pkgnum ) = @_;
2597 $self->total_owed_pkgnum($pkgnum)
2598 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2599 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2600 - $self->total_unapplied_credits_pkgnum($pkgnum)
2601 - $self->total_unapplied_payments_pkgnum($pkgnum)
2607 Returns a hash of useful information for making a payment.
2617 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2618 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2619 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2623 For credit card transactions:
2635 For electronic check transactions:
2650 $return{balance} = $self->balance;
2652 $return{payname} = $self->payname
2653 || ( $self->first. ' '. $self->get('last') );
2655 $return{$_} = $self->bill_location->$_
2656 for qw(address1 address2 city state zip);
2658 $return{payby} = $self->payby;
2659 $return{stateid_state} = $self->stateid_state;
2661 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2662 $return{card_type} = cardtype($self->payinfo);
2663 $return{payinfo} = $self->paymask;
2665 @return{'month', 'year'} = $self->paydate_monthyear;
2669 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2670 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2671 $return{payinfo1} = $payinfo1;
2672 $return{payinfo2} = $payinfo2;
2673 $return{paytype} = $self->paytype;
2674 $return{paystate} = $self->paystate;
2678 #doubleclick protection
2680 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2686 =item paydate_monthyear
2688 Returns a two-element list consisting of the month and year of this customer's
2689 paydate (credit card expiration date for CARD customers)
2693 sub paydate_monthyear {
2695 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2697 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2706 Returns the exact time in seconds corresponding to the payment method
2707 expiration date. For CARD/DCRD customers this is the end of the month;
2708 for others (COMP is the only other payby that uses paydate) it's the start.
2709 Returns 0 if the paydate is empty or set to the far future.
2715 my ($month, $year) = $self->paydate_monthyear;
2716 return 0 if !$year or $year >= 2037;
2717 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2719 if ( $month == 13 ) {
2723 return timelocal(0,0,0,1,$month-1,$year) - 1;
2726 return timelocal(0,0,0,1,$month-1,$year);
2730 =item paydate_epoch_sql
2732 Class method. Returns an SQL expression to obtain the payment expiration date
2733 as a number of seconds.
2737 # Special expiration date behavior for non-CARD/DCRD customers has been
2738 # carefully preserved. Do we really use that?
2739 sub paydate_epoch_sql {
2741 my $table = shift || 'cust_main';
2742 my ($case1, $case2);
2743 if ( driver_name eq 'Pg' ) {
2744 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
2745 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
2747 elsif ( lc(driver_name) eq 'mysql' ) {
2748 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
2749 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
2752 return "CASE WHEN $table.payby IN('CARD','DCRD')
2758 =item tax_exemption TAXNAME
2763 my( $self, $taxname ) = @_;
2765 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2766 'taxname' => $taxname,
2771 =item cust_main_exemption
2773 =item invoicing_list [ ARRAYREF ]
2775 If an arguement is given, sets these email addresses as invoice recipients
2776 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2777 (except as warnings), so use check_invoicing_list first.
2779 Returns a list of email addresses (with svcnum entries expanded).
2781 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2782 check it without disturbing anything by passing nothing.
2784 This interface may change in the future.
2788 sub invoicing_list {
2789 my( $self, $arrayref ) = @_;
2792 my @cust_main_invoice;
2793 if ( $self->custnum ) {
2794 @cust_main_invoice =
2795 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2797 @cust_main_invoice = ();
2799 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2800 #warn $cust_main_invoice->destnum;
2801 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2802 #warn $cust_main_invoice->destnum;
2803 my $error = $cust_main_invoice->delete;
2804 warn $error if $error;
2807 if ( $self->custnum ) {
2808 @cust_main_invoice =
2809 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2811 @cust_main_invoice = ();
2813 my %seen = map { $_->address => 1 } @cust_main_invoice;
2814 foreach my $address ( @{$arrayref} ) {
2815 next if exists $seen{$address} && $seen{$address};
2816 $seen{$address} = 1;
2817 my $cust_main_invoice = new FS::cust_main_invoice ( {
2818 'custnum' => $self->custnum,
2821 my $error = $cust_main_invoice->insert;
2822 warn $error if $error;
2826 if ( $self->custnum ) {
2828 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2835 =item check_invoicing_list ARRAYREF
2837 Checks these arguements as valid input for the invoicing_list method. If there
2838 is an error, returns the error, otherwise returns false.
2842 sub check_invoicing_list {
2843 my( $self, $arrayref ) = @_;
2845 foreach my $address ( @$arrayref ) {
2847 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2848 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2851 my $cust_main_invoice = new FS::cust_main_invoice ( {
2852 'custnum' => $self->custnum,
2855 my $error = $self->custnum
2856 ? $cust_main_invoice->check
2857 : $cust_main_invoice->checkdest
2859 return $error if $error;
2863 return "Email address required"
2864 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2865 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2870 =item set_default_invoicing_list
2872 Sets the invoicing list to all accounts associated with this customer,
2873 overwriting any previous invoicing list.
2877 sub set_default_invoicing_list {
2879 $self->invoicing_list($self->all_emails);
2884 Returns the email addresses of all accounts provisioned for this customer.
2891 foreach my $cust_pkg ( $self->all_pkgs ) {
2892 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2894 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2895 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2897 $list{$_}=1 foreach map { $_->email } @svc_acct;
2902 =item invoicing_list_addpost
2904 Adds postal invoicing to this customer. If this customer is already configured
2905 to receive postal invoices, does nothing.
2909 sub invoicing_list_addpost {
2911 return if grep { $_ eq 'POST' } $self->invoicing_list;
2912 my @invoicing_list = $self->invoicing_list;
2913 push @invoicing_list, 'POST';
2914 $self->invoicing_list(\@invoicing_list);
2917 =item invoicing_list_emailonly
2919 Returns the list of email invoice recipients (invoicing_list without non-email
2920 destinations such as POST and FAX).
2924 sub invoicing_list_emailonly {
2926 warn "$me invoicing_list_emailonly called"
2928 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
2931 =item invoicing_list_emailonly_scalar
2933 Returns the list of email invoice recipients (invoicing_list without non-email
2934 destinations such as POST and FAX) as a comma-separated scalar.
2938 sub invoicing_list_emailonly_scalar {
2940 warn "$me invoicing_list_emailonly_scalar called"
2942 join(', ', $self->invoicing_list_emailonly);
2945 =item referral_custnum_cust_main
2947 Returns the customer who referred this customer (or the empty string, if
2948 this customer was not referred).
2950 Note the difference with referral_cust_main method: This method,
2951 referral_custnum_cust_main returns the single customer (if any) who referred
2952 this customer, while referral_cust_main returns an array of customers referred
2957 sub referral_custnum_cust_main {
2959 return '' unless $self->referral_custnum;
2960 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2963 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2965 Returns an array of customers referred by this customer (referral_custnum set
2966 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2967 customers referred by customers referred by this customer and so on, inclusive.
2968 The default behavior is DEPTH 1 (no recursion).
2970 Note the difference with referral_custnum_cust_main method: This method,
2971 referral_cust_main, returns an array of customers referred BY this customer,
2972 while referral_custnum_cust_main returns the single customer (if any) who
2973 referred this customer.
2977 sub referral_cust_main {
2979 my $depth = @_ ? shift : 1;
2980 my $exclude = @_ ? shift : {};
2983 map { $exclude->{$_->custnum}++; $_; }
2984 grep { ! $exclude->{ $_->custnum } }
2985 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2989 map { $_->referral_cust_main($depth-1, $exclude) }
2996 =item referral_cust_main_ncancelled
2998 Same as referral_cust_main, except only returns customers with uncancelled
3003 sub referral_cust_main_ncancelled {
3005 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3008 =item referral_cust_pkg [ DEPTH ]
3010 Like referral_cust_main, except returns a flat list of all unsuspended (and
3011 uncancelled) packages for each customer. The number of items in this list may
3012 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3016 sub referral_cust_pkg {
3018 my $depth = @_ ? shift : 1;
3020 map { $_->unsuspended_pkgs }
3021 grep { $_->unsuspended_pkgs }
3022 $self->referral_cust_main($depth);
3025 =item referring_cust_main
3027 Returns the single cust_main record for the customer who referred this customer
3028 (referral_custnum), or false.
3032 sub referring_cust_main {
3034 return '' unless $self->referral_custnum;
3035 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3038 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3040 Applies a credit to this customer. If there is an error, returns the error,
3041 otherwise returns false.
3043 REASON can be a text string, an FS::reason object, or a scalar reference to
3044 a reasonnum. If a text string, it will be automatically inserted as a new
3045 reason, and a 'reason_type' option must be passed to indicate the
3046 FS::reason_type for the new reason.
3048 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3049 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3050 I<commission_pkgnum>.
3052 Any other options are passed to FS::cust_credit::insert.
3057 my( $self, $amount, $reason, %options ) = @_;
3059 my $cust_credit = new FS::cust_credit {
3060 'custnum' => $self->custnum,
3061 'amount' => $amount,
3064 if ( ref($reason) ) {
3066 if ( ref($reason) eq 'SCALAR' ) {
3067 $cust_credit->reasonnum( $$reason );
3069 $cust_credit->reasonnum( $reason->reasonnum );
3073 $cust_credit->set('reason', $reason)
3076 $cust_credit->$_( delete $options{$_} )
3077 foreach grep exists($options{$_}),
3078 qw( addlinfo eventnum ),
3079 map "commission_$_", qw( agentnum salesnum pkgnum );
3081 $cust_credit->insert(%options);
3085 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3087 Creates a one-time charge for this customer. If there is an error, returns
3088 the error, otherwise returns false.
3090 New-style, with a hashref of options:
3092 my $error = $cust_main->charge(
3096 'start_date' => str2time('7/4/2009'),
3097 'pkg' => 'Description',
3098 'comment' => 'Comment',
3099 'additional' => [], #extra invoice detail
3100 'classnum' => 1, #pkg_class
3102 'setuptax' => '', # or 'Y' for tax exempt
3104 'locationnum'=> 1234, # optional
3107 'taxclass' => 'Tax class',
3110 'taxproduct' => 2, #part_pkg_taxproduct
3111 'override' => {}, #XXX describe
3113 #will be filled in with the new object
3114 'cust_pkg_ref' => \$cust_pkg,
3116 #generate an invoice immediately
3118 'invoice_terms' => '', #with these terms
3124 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3128 #super false laziness w/quotation::charge
3131 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3132 my ( $pkg, $comment, $additional );
3133 my ( $setuptax, $taxclass ); #internal taxes
3134 my ( $taxproduct, $override ); #vendor (CCH) taxes
3136 my $separate_bill = '';
3137 my $cust_pkg_ref = '';
3138 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3140 if ( ref( $_[0] ) ) {
3141 $amount = $_[0]->{amount};
3142 $setup_cost = $_[0]->{setup_cost};
3143 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3144 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3145 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3146 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3147 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3148 : '$'. sprintf("%.2f",$amount);
3149 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3150 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3151 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3152 $additional = $_[0]->{additional} || [];
3153 $taxproduct = $_[0]->{taxproductnum};
3154 $override = { '' => $_[0]->{tax_override} };
3155 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3156 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3157 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3158 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3159 $separate_bill = $_[0]->{separate_bill} || '';
3165 $pkg = @_ ? shift : 'One-time charge';
3166 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3168 $taxclass = @_ ? shift : '';
3172 local $SIG{HUP} = 'IGNORE';
3173 local $SIG{INT} = 'IGNORE';
3174 local $SIG{QUIT} = 'IGNORE';
3175 local $SIG{TERM} = 'IGNORE';
3176 local $SIG{TSTP} = 'IGNORE';
3177 local $SIG{PIPE} = 'IGNORE';
3179 my $oldAutoCommit = $FS::UID::AutoCommit;
3180 local $FS::UID::AutoCommit = 0;
3183 my $part_pkg = new FS::part_pkg ( {
3185 'comment' => $comment,
3189 'classnum' => ( $classnum ? $classnum : '' ),
3190 'setuptax' => $setuptax,
3191 'taxclass' => $taxclass,
3192 'taxproductnum' => $taxproduct,
3193 'setup_cost' => $setup_cost,
3196 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3197 ( 0 .. @$additional - 1 )
3199 'additional_count' => scalar(@$additional),
3200 'setup_fee' => $amount,
3203 my $error = $part_pkg->insert( options => \%options,
3204 tax_overrides => $override,
3207 $dbh->rollback if $oldAutoCommit;
3211 my $pkgpart = $part_pkg->pkgpart;
3212 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3213 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3214 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3215 $error = $type_pkgs->insert;
3217 $dbh->rollback if $oldAutoCommit;
3222 my $cust_pkg = new FS::cust_pkg ( {
3223 'custnum' => $self->custnum,
3224 'pkgpart' => $pkgpart,
3225 'quantity' => $quantity,
3226 'start_date' => $start_date,
3227 'no_auto' => $no_auto,
3228 'separate_bill' => $separate_bill,
3229 'locationnum'=> $locationnum,
3232 $error = $cust_pkg->insert;
3234 $dbh->rollback if $oldAutoCommit;
3236 } elsif ( $cust_pkg_ref ) {
3237 ${$cust_pkg_ref} = $cust_pkg;
3241 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3242 'pkg_list' => [ $cust_pkg ],
3245 $dbh->rollback if $oldAutoCommit;
3250 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3255 #=item charge_postal_fee
3257 #Applies a one time charge this customer. If there is an error,
3258 #returns the error, returns the cust_pkg charge object or false
3259 #if there was no charge.
3263 # This should be a customer event. For that to work requires that bill
3264 # also be a customer event.
3266 sub charge_postal_fee {
3269 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3270 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3272 my $cust_pkg = new FS::cust_pkg ( {
3273 'custnum' => $self->custnum,
3274 'pkgpart' => $pkgpart,
3278 my $error = $cust_pkg->insert;
3279 $error ? $error : $cust_pkg;
3282 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3284 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3286 Optionally, a list or hashref of additional arguments to the qsearch call can
3293 my $opt = ref($_[0]) ? shift : { @_ };
3295 #return $self->num_cust_bill unless wantarray || keys %$opt;
3297 $opt->{'table'} = 'cust_bill';
3298 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3299 $opt->{'hashref'}{'custnum'} = $self->custnum;
3300 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3302 map { $_ } #behavior of sort undefined in scalar context
3303 sort { $a->_date <=> $b->_date }
3307 =item open_cust_bill
3309 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3314 sub open_cust_bill {
3318 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3324 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3326 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3330 sub legacy_cust_bill {
3333 #return $self->num_legacy_cust_bill unless wantarray;
3335 map { $_ } #behavior of sort undefined in scalar context
3336 sort { $a->_date <=> $b->_date }
3337 qsearch({ 'table' => 'legacy_cust_bill',
3338 'hashref' => { 'custnum' => $self->custnum, },
3339 'order_by' => 'ORDER BY _date ASC',
3343 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3345 Returns all the statements (see L<FS::cust_statement>) for this customer.
3347 Optionally, a list or hashref of additional arguments to the qsearch call can
3352 =item cust_bill_void
3354 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3358 sub cust_bill_void {
3361 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3362 sort { $a->_date <=> $b->_date }
3363 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3366 sub cust_statement {
3368 my $opt = ref($_[0]) ? shift : { @_ };
3370 #return $self->num_cust_statement unless wantarray || keys %$opt;
3372 $opt->{'table'} = 'cust_statement';
3373 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3374 $opt->{'hashref'}{'custnum'} = $self->custnum;
3375 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3377 map { $_ } #behavior of sort undefined in scalar context
3378 sort { $a->_date <=> $b->_date }
3382 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3384 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3386 Optionally, a list or hashref of additional arguments to the qsearch call can
3387 be passed following the SVCDB.
3394 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3395 warn "$me svc_x requires a svcdb";
3398 my $opt = ref($_[0]) ? shift : { @_ };
3400 $opt->{'table'} = $svcdb;
3401 $opt->{'addl_from'} =
3402 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3403 ($opt->{'addl_from'} || '');
3405 my $custnum = $self->custnum;
3406 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3407 my $where = "cust_pkg.custnum = $custnum";
3409 my $extra_sql = $opt->{'extra_sql'} || '';
3410 if ( keys %{ $opt->{'hashref'} } ) {
3411 $extra_sql = " AND $where $extra_sql";
3414 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3415 $extra_sql = "WHERE $where AND $1";
3418 $extra_sql = "WHERE $where $extra_sql";
3421 $opt->{'extra_sql'} = $extra_sql;
3426 # required for use as an eventtable;
3429 $self->svc_x('svc_acct', @_);
3434 Returns all the credits (see L<FS::cust_credit>) for this customer.
3440 map { $_ } #return $self->num_cust_credit unless wantarray;
3441 sort { $a->_date <=> $b->_date }
3442 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3445 =item cust_credit_pkgnum
3447 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3448 package when using experimental package balances.
3452 sub cust_credit_pkgnum {
3453 my( $self, $pkgnum ) = @_;
3454 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3455 sort { $a->_date <=> $b->_date }
3456 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3457 'pkgnum' => $pkgnum,
3462 =item cust_credit_void
3464 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3468 sub cust_credit_void {
3471 sort { $a->_date <=> $b->_date }
3472 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3477 Returns all the payments (see L<FS::cust_pay>) for this customer.
3483 my $opt = ref($_[0]) ? shift : { @_ };
3485 return $self->num_cust_pay unless wantarray || keys %$opt;
3487 $opt->{'table'} = 'cust_pay';
3488 $opt->{'hashref'}{'custnum'} = $self->custnum;
3490 map { $_ } #behavior of sort undefined in scalar context
3491 sort { $a->_date <=> $b->_date }
3498 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3499 called automatically when the cust_pay method is used in a scalar context.
3505 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3506 my $sth = dbh->prepare($sql) or die dbh->errstr;
3507 $sth->execute($self->custnum) or die $sth->errstr;
3508 $sth->fetchrow_arrayref->[0];
3511 =item unapplied_cust_pay
3513 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3517 sub unapplied_cust_pay {
3521 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3527 =item cust_pay_pkgnum
3529 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3530 package when using experimental package balances.
3534 sub cust_pay_pkgnum {
3535 my( $self, $pkgnum ) = @_;
3536 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3537 sort { $a->_date <=> $b->_date }
3538 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3539 'pkgnum' => $pkgnum,
3546 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3552 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3553 sort { $a->_date <=> $b->_date }
3554 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3557 =item cust_pay_pending
3559 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3560 (without status "done").
3564 sub cust_pay_pending {
3566 return $self->num_cust_pay_pending unless wantarray;
3567 sort { $a->_date <=> $b->_date }
3568 qsearch( 'cust_pay_pending', {
3569 'custnum' => $self->custnum,
3570 'status' => { op=>'!=', value=>'done' },
3575 =item cust_pay_pending_attempt
3577 Returns all payment attempts / declined payments for this customer, as pending
3578 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3579 a corresponding payment (see L<FS::cust_pay>).
3583 sub cust_pay_pending_attempt {
3585 return $self->num_cust_pay_pending_attempt unless wantarray;
3586 sort { $a->_date <=> $b->_date }
3587 qsearch( 'cust_pay_pending', {
3588 'custnum' => $self->custnum,
3595 =item num_cust_pay_pending
3597 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3598 customer (without status "done"). Also called automatically when the
3599 cust_pay_pending method is used in a scalar context.
3603 sub num_cust_pay_pending {
3606 " SELECT COUNT(*) FROM cust_pay_pending ".
3607 " WHERE custnum = ? AND status != 'done' ",
3612 =item num_cust_pay_pending_attempt
3614 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3615 customer, with status "done" but without a corresp. Also called automatically when the
3616 cust_pay_pending method is used in a scalar context.
3620 sub num_cust_pay_pending_attempt {
3623 " SELECT COUNT(*) FROM cust_pay_pending ".
3624 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3631 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3637 map { $_ } #return $self->num_cust_refund unless wantarray;
3638 sort { $a->_date <=> $b->_date }
3639 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3642 =item display_custnum
3644 Returns the displayed customer number for this customer: agent_custid if
3645 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3649 sub display_custnum {
3652 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3653 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3654 if ( $special eq 'CoStAg' ) {
3655 $prefix = uc( join('',
3657 ($self->state =~ /^(..)/),
3658 $prefix || ($self->agent->agent =~ /^(..)/)
3661 elsif ( $special eq 'CoStCl' ) {
3662 $prefix = uc( join('',
3664 ($self->state =~ /^(..)/),
3665 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3668 # add any others here if needed
3671 my $length = $conf->config('cust_main-custnum-display_length');
3672 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3673 return $self->agent_custid;
3674 } elsif ( $prefix ) {
3675 $length = 8 if !defined($length);
3677 sprintf('%0'.$length.'d', $self->custnum)
3678 } elsif ( $length ) {
3679 return sprintf('%0'.$length.'d', $self->custnum);
3681 return $self->custnum;
3687 Returns a name string for this customer, either "Company (Last, First)" or
3694 my $name = $self->contact;
3695 $name = $self->company. " ($name)" if $self->company;
3699 =item service_contact
3701 Returns the L<FS::contact> object for this customer that has the 'Service'
3702 contact class, or undef if there is no such contact. Deprecated; don't use
3707 sub service_contact {
3709 if ( !exists($self->{service_contact}) ) {
3710 my $classnum = $self->scalar_sql(
3711 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3712 ) || 0; #if it's zero, qsearchs will return nothing
3713 my $cust_contact = qsearchs('cust_contact', {
3714 'classnum' => $classnum,
3715 'custnum' => $self->custnum,
3717 $self->{service_contact} = $cust_contact->contact if $cust_contact;
3719 $self->{service_contact};
3724 Returns a name string for this (service/shipping) contact, either
3725 "Company (Last, First)" or "Last, First".
3732 my $name = $self->ship_contact;
3733 $name = $self->company. " ($name)" if $self->company;
3739 Returns a name string for this customer, either "Company" or "First Last".
3745 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3748 =item ship_name_short
3750 Returns a name string for this (service/shipping) contact, either "Company"
3755 sub ship_name_short {
3757 $self->service_contact
3758 ? $self->ship_contact_firstlast
3764 Returns this customer's full (billing) contact name only, "Last, First"
3770 $self->get('last'). ', '. $self->first;
3775 Returns this customer's full (shipping) contact name only, "Last, First"
3781 my $contact = $self->service_contact || $self;
3782 $contact->get('last') . ', ' . $contact->get('first');
3785 =item contact_firstlast
3787 Returns this customers full (billing) contact name only, "First Last".
3791 sub contact_firstlast {
3793 $self->first. ' '. $self->get('last');
3796 =item ship_contact_firstlast
3798 Returns this customer's full (shipping) contact name only, "First Last".
3802 sub ship_contact_firstlast {
3804 my $contact = $self->service_contact || $self;
3805 $contact->get('first') . ' '. $contact->get('last');
3808 #XXX this doesn't work in 3.x+
3811 #Returns this customer's full country name
3817 # code2country($self->country);
3820 sub bill_country_full {
3822 code2country($self->bill_location->country);
3825 sub ship_country_full {
3827 code2country($self->ship_location->country);
3830 =item county_state_county [ PREFIX ]
3832 Returns a string consisting of just the county, state and country.
3836 sub county_state_country {
3839 if ( @_ && $_[0] && $self->has_ship_address ) {
3840 $locationnum = $self->ship_locationnum;
3842 $locationnum = $self->bill_locationnum;
3844 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
3845 $cust_location->county_state_country;
3848 =item geocode DATA_VENDOR
3850 Returns a value for the customer location as encoded by DATA_VENDOR.
3851 Currently this only makes sense for "CCH" as DATA_VENDOR.
3859 Returns a status string for this customer, currently:
3865 No packages have ever been ordered. Displayed as "No packages".
3869 Recurring packages all are new (not yet billed).
3873 One or more recurring packages is active.
3877 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
3881 All non-cancelled recurring packages are suspended.
3885 All recurring packages are cancelled.
3889 Behavior of inactive vs. cancelled edge cases can be adjusted with the
3890 cust_main-status_module configuration option.
3894 sub status { shift->cust_status(@_); }
3898 for my $status ( FS::cust_main->statuses() ) {
3899 my $method = $status.'_sql';
3900 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3901 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3902 $sth->execute( ($self->custnum) x $numnum )
3903 or die "Error executing 'SELECT $sql': ". $sth->errstr;
3904 return $status if $sth->fetchrow_arrayref->[0];
3908 =item is_status_delay_cancel
3910 Returns true if customer status is 'suspended'
3911 and all suspended cust_pkg return true for
3912 cust_pkg->is_status_delay_cancel.
3914 This is not a real status, this only meant for hacking display
3915 values, because otherwise treating the customer as suspended is
3916 really the whole point of the delay_cancel option.
3920 sub is_status_delay_cancel {
3922 return 0 unless $self->status eq 'suspended';
3923 foreach my $cust_pkg ($self->ncancelled_pkgs) {
3924 return 0 unless $cust_pkg->is_status_delay_cancel;
3929 =item ucfirst_cust_status
3931 =item ucfirst_status
3933 Deprecated, use the cust_status_label method instead.
3935 Returns the status with the first character capitalized.
3939 sub ucfirst_status {
3940 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3941 local($ucfirst_nowarn) = 1;
3942 shift->ucfirst_cust_status(@_);
3945 sub ucfirst_cust_status {
3946 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3948 ucfirst($self->cust_status);
3951 =item cust_status_label
3955 Returns the display label for this status.
3959 sub status_label { shift->cust_status_label(@_); }
3961 sub cust_status_label {
3963 __PACKAGE__->statuslabels->{$self->cust_status};
3968 Returns a hex triplet color string for this customer's status.
3972 sub statuscolor { shift->cust_statuscolor(@_); }
3974 sub cust_statuscolor {
3976 __PACKAGE__->statuscolors->{$self->cust_status};
3979 =item tickets [ STATUS ]
3981 Returns an array of hashes representing the customer's RT tickets.
3983 An optional status (or arrayref or hashref of statuses) may be specified.
3989 my $status = ( @_ && $_[0] ) ? shift : '';
3991 my $num = $conf->config('cust_main-max_tickets') || 10;
3994 if ( $conf->config('ticket_system') ) {
3995 unless ( $conf->config('ticket_system-custom_priority_field') ) {
3997 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4006 foreach my $priority (
4007 $conf->config('ticket_system-custom_priority_field-values'), ''
4009 last if scalar(@tickets) >= $num;
4011 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4012 $num - scalar(@tickets),
4023 # Return services representing svc_accts in customer support packages
4024 sub support_services {
4026 my %packages = map { $_ => 1 } $conf->config('support_packages');
4028 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4029 grep { $_->part_svc->svcdb eq 'svc_acct' }
4030 map { $_->cust_svc }
4031 grep { exists $packages{ $_->pkgpart } }
4032 $self->ncancelled_pkgs;
4036 # Return a list of latitude/longitude for one of the services (if any)
4037 sub service_coordinates {
4041 grep { $_->latitude && $_->longitude }
4043 map { $_->cust_svc }
4044 $self->ncancelled_pkgs;
4046 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4051 Returns a masked version of the named field
4056 my ($self,$field) = @_;
4060 'x'x(length($self->getfield($field))-4).
4061 substr($self->getfield($field), (length($self->getfield($field))-4));
4067 =head1 CLASS METHODS
4073 Class method that returns the list of possible status strings for customers
4074 (see L<the status method|/status>). For example:
4076 @statuses = FS::cust_main->statuses();
4082 keys %{ $self->statuscolors };
4085 =item cust_status_sql
4087 Returns an SQL fragment to determine the status of a cust_main record, as a
4092 sub cust_status_sql {
4094 for my $status ( FS::cust_main->statuses() ) {
4095 my $method = $status.'_sql';
4096 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4105 Returns an SQL expression identifying prospective cust_main records (customers
4106 with no packages ever ordered)
4110 use vars qw($select_count_pkgs);
4111 $select_count_pkgs =
4112 "SELECT COUNT(*) FROM cust_pkg
4113 WHERE cust_pkg.custnum = cust_main.custnum";
4115 sub select_count_pkgs_sql {
4120 " 0 = ( $select_count_pkgs ) ";
4125 Returns an SQL expression identifying ordered cust_main records (customers with
4126 no active packages, but recurring packages not yet setup or one time charges
4132 FS::cust_main->none_active_sql.
4133 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4138 Returns an SQL expression identifying active cust_main records (customers with
4139 active recurring packages).
4144 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4147 =item none_active_sql
4149 Returns an SQL expression identifying cust_main records with no active
4150 recurring packages. This includes customers of status prospect, ordered,
4151 inactive, and suspended.
4155 sub none_active_sql {
4156 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4161 Returns an SQL expression identifying inactive cust_main records (customers with
4162 no active recurring packages, but otherwise unsuspended/uncancelled).
4167 FS::cust_main->none_active_sql.
4168 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4174 Returns an SQL expression identifying suspended cust_main records.
4179 sub suspended_sql { susp_sql(@_); }
4181 FS::cust_main->none_active_sql.
4182 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4188 Returns an SQL expression identifying cancelled cust_main records.
4192 sub cancel_sql { shift->cancelled_sql(@_); }
4195 =item uncancelled_sql
4197 Returns an SQL expression identifying un-cancelled cust_main records.
4201 sub uncancelled_sql { uncancel_sql(@_); }
4202 sub uncancel_sql { "
4203 ( 0 < ( $select_count_pkgs
4204 AND ( cust_pkg.cancel IS NULL
4205 OR cust_pkg.cancel = 0
4208 OR 0 = ( $select_count_pkgs )
4214 Returns an SQL fragment to retreive the balance.
4219 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4220 WHERE cust_bill.custnum = cust_main.custnum )
4221 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4222 WHERE cust_pay.custnum = cust_main.custnum )
4223 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4224 WHERE cust_credit.custnum = cust_main.custnum )
4225 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4226 WHERE cust_refund.custnum = cust_main.custnum )
4229 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4231 Returns an SQL fragment to retreive the balance for this customer, optionally
4232 considering invoices with date earlier than START_TIME, and not
4233 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4234 total_unapplied_payments).
4236 Times are specified as SQL fragments or numeric
4237 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4238 L<Date::Parse> for conversion functions. The empty string can be passed
4239 to disable that time constraint completely.
4241 Available options are:
4245 =item unapplied_date
4247 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)
4252 set to true to remove all customer comparison clauses, for totals
4257 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4262 JOIN clause (typically used with the total option)
4266 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4267 time will be ignored. Note that START_TIME and END_TIME only limit the date
4268 range for invoices and I<unapplied> payments, credits, and refunds.
4274 sub balance_date_sql {
4275 my( $class, $start, $end, %opt ) = @_;
4277 my $cutoff = $opt{'cutoff'};
4279 my $owed = FS::cust_bill->owed_sql($cutoff);
4280 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4281 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4282 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4284 my $j = $opt{'join'} || '';
4286 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4287 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4288 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4289 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4291 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4292 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4293 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4294 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4299 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4301 Returns an SQL fragment to retreive the total unapplied payments for this
4302 customer, only considering payments with date earlier than START_TIME, and
4303 optionally not later than END_TIME.
4305 Times are specified as SQL fragments or numeric
4306 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4307 L<Date::Parse> for conversion functions. The empty string can be passed
4308 to disable that time constraint completely.
4310 Available options are:
4314 sub unapplied_payments_date_sql {
4315 my( $class, $start, $end, %opt ) = @_;
4317 my $cutoff = $opt{'cutoff'};
4319 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4321 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4322 'unapplied_date'=>1 );
4324 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4327 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4329 Helper method for balance_date_sql; name (and usage) subject to change
4330 (suggestions welcome).
4332 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4333 cust_refund, cust_credit or cust_pay).
4335 If TABLE is "cust_bill" or the unapplied_date option is true, only
4336 considers records with date earlier than START_TIME, and optionally not
4337 later than END_TIME .
4341 sub _money_table_where {
4342 my( $class, $table, $start, $end, %opt ) = @_;
4345 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4346 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4347 push @where, "$table._date <= $start" if defined($start) && length($start);
4348 push @where, "$table._date > $end" if defined($end) && length($end);
4350 push @where, @{$opt{'where'}} if $opt{'where'};
4351 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4357 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4358 use FS::cust_main::Search;
4361 FS::cust_main::Search->search(@_);
4370 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4372 Deprecated. Use event notification and message templates
4373 (L<FS::msg_template>) instead.
4375 Sends a templated email notification to the customer (see L<Text::Template>).
4377 OPTIONS is a hash and may include
4379 I<from> - the email sender (default is invoice_from)
4381 I<to> - comma-separated scalar or arrayref of recipients
4382 (default is invoicing_list)
4384 I<subject> - The subject line of the sent email notification
4385 (default is "Notice from company_name")
4387 I<extra_fields> - a hashref of name/value pairs which will be substituted
4390 The following variables are vavailable in the template.
4392 I<$first> - the customer first name
4393 I<$last> - the customer last name
4394 I<$company> - the customer company
4395 I<$payby> - a description of the method of payment for the customer
4396 # would be nice to use FS::payby::shortname
4397 I<$payinfo> - the account information used to collect for this customer
4398 I<$expdate> - the expiration of the customer payment in seconds from epoch
4403 my ($self, $template, %options) = @_;
4405 return unless $conf->exists($template);
4407 my $from = $conf->invoice_from_full($self->agentnum)
4408 if $conf->exists('invoice_from', $self->agentnum);
4409 $from = $options{from} if exists($options{from});
4411 my $to = join(',', $self->invoicing_list_emailonly);
4412 $to = $options{to} if exists($options{to});
4414 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4415 if $conf->exists('company_name', $self->agentnum);
4416 $subject = $options{subject} if exists($options{subject});
4418 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4419 SOURCE => [ map "$_\n",
4420 $conf->config($template)]
4422 or die "can't create new Text::Template object: Text::Template::ERROR";
4423 $notify_template->compile()
4424 or die "can't compile template: Text::Template::ERROR";
4426 $FS::notify_template::_template::company_name =
4427 $conf->config('company_name', $self->agentnum);
4428 $FS::notify_template::_template::company_address =
4429 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4431 my $paydate = $self->paydate || '2037-12-31';
4432 $FS::notify_template::_template::first = $self->first;
4433 $FS::notify_template::_template::last = $self->last;
4434 $FS::notify_template::_template::company = $self->company;
4435 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4436 my $payby = $self->payby;
4437 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4438 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4440 #credit cards expire at the end of the month/year of their exp date
4441 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4442 $FS::notify_template::_template::payby = 'credit card';
4443 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4444 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4446 }elsif ($payby eq 'COMP') {
4447 $FS::notify_template::_template::payby = 'complimentary account';
4449 $FS::notify_template::_template::payby = 'current method';
4451 $FS::notify_template::_template::expdate = $expire_time;
4453 for (keys %{$options{extra_fields}}){
4455 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4458 send_email(from => $from,
4460 subject => $subject,
4461 body => $notify_template->fill_in( PACKAGE =>
4462 'FS::notify_template::_template' ),
4467 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4469 Generates a templated notification to the customer (see L<Text::Template>).
4471 OPTIONS is a hash and may include
4473 I<extra_fields> - a hashref of name/value pairs which will be substituted
4474 into the template. These values may override values mentioned below
4475 and those from the customer record.
4477 The following variables are available in the template instead of or in addition
4478 to the fields of the customer record.
4480 I<$payby> - a description of the method of payment for the customer
4481 # would be nice to use FS::payby::shortname
4482 I<$payinfo> - the masked account information used to collect for this customer
4483 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4484 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4488 # a lot like cust_bill::print_latex
4489 sub generate_letter {
4490 my ($self, $template, %options) = @_;
4492 return unless $conf->exists($template);
4494 my $letter_template = new Text::Template
4496 SOURCE => [ map "$_\n", $conf->config($template)],
4497 DELIMITERS => [ '[@--', '--@]' ],
4499 or die "can't create new Text::Template object: Text::Template::ERROR";
4501 $letter_template->compile()
4502 or die "can't compile template: Text::Template::ERROR";
4504 my %letter_data = map { $_ => $self->$_ } $self->fields;
4505 $letter_data{payinfo} = $self->mask_payinfo;
4507 #my $paydate = $self->paydate || '2037-12-31';
4508 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4510 my $payby = $self->payby;
4511 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4512 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4514 #credit cards expire at the end of the month/year of their exp date
4515 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4516 $letter_data{payby} = 'credit card';
4517 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4518 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4520 }elsif ($payby eq 'COMP') {
4521 $letter_data{payby} = 'complimentary account';
4523 $letter_data{payby} = 'current method';
4525 $letter_data{expdate} = $expire_time;
4527 for (keys %{$options{extra_fields}}){
4528 $letter_data{$_} = $options{extra_fields}->{$_};
4531 unless(exists($letter_data{returnaddress})){
4532 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4533 $self->agent_template)
4535 if ( length($retadd) ) {
4536 $letter_data{returnaddress} = $retadd;
4537 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4538 $letter_data{returnaddress} =
4539 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4543 ( $conf->config('company_name', $self->agentnum),
4544 $conf->config('company_address', $self->agentnum),
4548 $letter_data{returnaddress} = '~';
4552 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4554 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4556 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4558 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4562 ) or die "can't open temp file: $!\n";
4563 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4564 or die "can't write temp file: $!\n";
4566 $letter_data{'logo_file'} = $lh->filename;
4568 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4572 ) or die "can't open temp file: $!\n";
4574 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4576 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4577 return ($1, $letter_data{'logo_file'});
4581 =item print_ps TEMPLATE
4583 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4589 my($file, $lfile) = $self->generate_letter(@_);
4590 my $ps = FS::Misc::generate_ps($file);
4591 unlink($file.'.tex');
4597 =item print TEMPLATE
4599 Prints the filled in template.
4601 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4605 sub queueable_print {
4608 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4609 or die "invalid customer number: " . $opt{custnum};
4611 my $error = $self->print( { 'template' => $opt{template} } );
4612 die $error if $error;
4616 my ($self, $template) = (shift, shift);
4618 [ $self->print_ps($template) ],
4619 'agentnum' => $self->agentnum,
4623 #these three subs should just go away once agent stuff is all config overrides
4625 sub agent_template {
4627 $self->_agent_plandata('agent_templatename');
4630 sub agent_invoice_from {
4632 $self->_agent_plandata('agent_invoice_from');
4635 sub _agent_plandata {
4636 my( $self, $option ) = @_;
4638 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4639 #agent-specific Conf
4641 use FS::part_event::Condition;
4643 my $agentnum = $self->agentnum;
4645 my $regexp = regexp_sql();
4647 my $part_event_option =
4649 'select' => 'part_event_option.*',
4650 'table' => 'part_event_option',
4652 LEFT JOIN part_event USING ( eventpart )
4653 LEFT JOIN part_event_option AS peo_agentnum
4654 ON ( part_event.eventpart = peo_agentnum.eventpart
4655 AND peo_agentnum.optionname = 'agentnum'
4656 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4658 LEFT JOIN part_event_condition
4659 ON ( part_event.eventpart = part_event_condition.eventpart
4660 AND part_event_condition.conditionname = 'cust_bill_age'
4662 LEFT JOIN part_event_condition_option
4663 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4664 AND part_event_condition_option.optionname = 'age'
4667 #'hashref' => { 'optionname' => $option },
4668 #'hashref' => { 'part_event_option.optionname' => $option },
4670 " WHERE part_event_option.optionname = ". dbh->quote($option).
4671 " AND action = 'cust_bill_send_agent' ".
4672 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4673 " AND peo_agentnum.optionname = 'agentnum' ".
4674 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4676 CASE WHEN part_event_condition_option.optionname IS NULL
4678 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4680 , part_event.weight".
4684 unless ( $part_event_option ) {
4685 return $self->agent->invoice_template || ''
4686 if $option eq 'agent_templatename';
4690 $part_event_option->optionvalue;
4694 sub process_o2m_qsearch {
4697 return qsearch($table, @_) unless $table eq 'contact';
4699 my $hashref = shift;
4700 my %hash = %$hashref;
4701 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4702 or die 'guru meditation #4343';
4704 qsearch({ 'table' => 'contact',
4705 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4706 'hashref' => \%hash,
4707 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4708 " cust_contact.custnum = $custnum "
4712 sub process_o2m_qsearchs {
4715 return qsearchs($table, @_) unless $table eq 'contact';
4717 my $hashref = shift;
4718 my %hash = %$hashref;
4719 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4720 or die 'guru meditation #2121';
4722 qsearchs({ 'table' => 'contact',
4723 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4724 'hashref' => \%hash,
4725 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4726 " cust_contact.custnum = $custnum "
4730 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4732 Subroutine (not a method), designed to be called from the queue.
4734 Takes a list of options and values.
4736 Pulls up the customer record via the custnum option and calls bill_and_collect.
4741 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4743 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4744 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4746 #without this errors don't get rolled back
4747 $args{'fatal'} = 1; # runs from job queue, will be caught
4749 $cust_main->bill_and_collect( %args );
4752 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4754 Like queued_bill, but instead of C<bill_and_collect>, just runs the
4755 C<collect> part. This is used in batch tax calculation, where invoice
4756 generation and collection events have to be completely separated.
4760 sub queued_collect {
4762 my $cust_main = FS::cust_main->by_key($args{'custnum'});
4764 $cust_main->collect(%args);
4767 sub process_bill_and_collect {
4770 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4771 or die "custnum '$param->{custnum}' not found!\n";
4772 $param->{'job'} = $job;
4773 $param->{'fatal'} = 1; # runs from job queue, will be caught
4774 $param->{'retry'} = 1;
4776 $cust_main->bill_and_collect( %$param );
4779 #starting to take quite a while for big dbs
4780 # (JRNL: journaled so it only happens once per database)
4781 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
4782 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
4783 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
4784 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
4785 # JRNL leading/trailing spaces in first, last, company
4786 # JRNL migrate to cust_payby
4787 # - otaker upgrade? journal and call it good? (double check to make sure
4788 # we're not still setting otaker here)
4790 #only going to get worse with new location stuff...
4792 sub _upgrade_data { #class method
4793 my ($class, %opts) = @_;
4796 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
4799 #this seems to be the only expensive one.. why does it take so long?
4800 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
4802 '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';
4803 FS::upgrade_journal->set_done('cust_main__signupdate');
4806 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
4808 # fix yyyy-m-dd formatted paydates
4809 if ( driver_name =~ /^mysql/i ) {
4811 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4812 } else { # the SQL standard
4814 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4816 FS::upgrade_journal->set_done('cust_main__paydate');
4819 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
4821 push @statements, #fix the weird BILL with a cc# in payinfo problem
4823 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
4825 FS::upgrade_journal->set_done('cust_main__payinfo');
4830 foreach my $sql ( @statements ) {
4831 my $sth = dbh->prepare($sql) or die dbh->errstr;
4832 $sth->execute or die $sth->errstr;
4833 #warn ( (time - $t). " seconds\n" );
4837 local($ignore_expired_card) = 1;
4838 local($ignore_banned_card) = 1;
4839 local($skip_fuzzyfiles) = 1;
4840 local($import) = 1; #prevent automatic geocoding (need its own variable?)
4842 FS::cust_main::Location->_upgrade_data(%opts);
4844 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
4846 foreach my $cust_main ( qsearch({
4847 'table' => 'cust_main',
4849 'extra_sql' => 'WHERE '.
4851 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
4852 qw( first last company )
4855 my $error = $cust_main->replace;
4856 die $error if $error;
4859 FS::upgrade_journal->set_done('cust_main__trimspaces');
4863 unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
4865 #we don't want to decrypt them, just stuff them as-is into cust_payby
4866 local(@encrypted_fields) = ();
4868 local($FS::cust_payby::ignore_expired_card) = 1;
4869 local($FS::cust_payby::ignore_banned_card) = 1;
4871 my @payfields = qw( payby payinfo paycvv paymask
4872 paydate paystart_month paystart_year payissue
4873 payname paystate paytype payip
4876 my $search = new FS::Cursor {
4877 'table' => 'cust_main',
4878 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
4881 while (my $cust_main = $search->fetch) {
4883 unless ( $cust_main->payby =~ /^(BILL|COMP)$/ ) {
4885 my $cust_payby = new FS::cust_payby {
4886 'custnum' => $cust_main->custnum,
4888 map { $_ => $cust_main->$_(); } @payfields
4891 my $error = $cust_payby->insert;
4892 die $error if $error;
4896 $cust_main->complimentary('Y') if $cust_main->payby eq 'COMP';
4898 $cust_main->invoice_attn( $cust_main->payname )
4899 if $cust_main->payby eq 'BILL' && $cust_main->payname;
4900 $cust_main->po_number( $cust_main->payinfo )
4901 if $cust_main->payby eq 'BILL' && $cust_main->payinfo;
4903 $cust_main->setfield($_, '') foreach @payfields;
4904 my $error = $cust_main->replace;
4905 die "Error upgradging payment information for custnum ".
4906 $cust_main->custnum. ": $error"
4911 FS::upgrade_journal->set_done('cust_main__cust_payby');
4914 $class->_upgrade_otaker(%opts);
4924 The delete method should possibly take an FS::cust_main object reference
4925 instead of a scalar customer number.
4927 Bill and collect options should probably be passed as references instead of a
4930 There should probably be a configuration file with a list of allowed credit
4933 No multiple currency support (probably a larger project than just this module).
4935 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4937 Birthdates rely on negative epoch values.
4939 The payby for card/check batches is broken. With mixed batching, bad
4942 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4946 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4947 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4948 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.