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;
80 # 1 is mostly method/subroutine entry and options
81 # 2 traces progress of some operations
82 # 3 is even more information including possibly sensitive data
84 our $me = '[FS::cust_main]';
87 our $ignore_expired_card = 0;
88 our $ignore_banned_card = 0;
89 our $ignore_invalid_card = 0;
91 our $skip_fuzzyfiles = 0;
93 our $ucfirst_nowarn = 0;
95 our @encrypted_fields = ('payinfo', 'paycvv');
96 sub nohistory_fields { ('payinfo', 'paycvv'); }
98 our @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
101 #ask FS::UID to run this stuff for us later
102 #$FS::UID::callback{'FS::cust_main'} = sub {
103 install_callback FS::UID sub {
104 $conf = new FS::Conf;
105 #yes, need it for stuff below (prolly should be cached)
106 $ignore_invalid_card = $conf->exists('allow_invalid_cards');
111 my ( $hashref, $cache ) = @_;
112 if ( exists $hashref->{'pkgnum'} ) {
113 #@{ $self->{'_pkgnum'} } = ();
114 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
115 $self->{'_pkgnum'} = $subcache;
116 #push @{ $self->{'_pkgnum'} },
117 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
123 FS::cust_main - Object methods for cust_main records
129 $record = new FS::cust_main \%hash;
130 $record = new FS::cust_main { 'column' => 'value' };
132 $error = $record->insert;
134 $error = $new_record->replace($old_record);
136 $error = $record->delete;
138 $error = $record->check;
140 @cust_pkg = $record->all_pkgs;
142 @cust_pkg = $record->ncancelled_pkgs;
144 @cust_pkg = $record->suspended_pkgs;
146 $error = $record->bill;
147 $error = $record->bill %options;
148 $error = $record->bill 'time' => $time;
150 $error = $record->collect;
151 $error = $record->collect %options;
152 $error = $record->collect 'invoice_time' => $time,
157 An FS::cust_main object represents a customer. FS::cust_main inherits from
158 FS::Record. The following fields are currently supported:
164 Primary key (assigned automatically for new customers)
168 Agent (see L<FS::agent>)
172 Advertising source (see L<FS::part_referral>)
184 Cocial security number (optional)
208 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
212 Payment Information (See L<FS::payinfo_Mixin> for data format)
216 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
220 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
224 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
228 Start date month (maestro/solo cards only)
232 Start date year (maestro/solo cards only)
236 Issue number (maestro/solo cards only)
240 Name on card or billing name
244 IP address from which payment information was received
248 Tax exempt, empty or `Y'
252 Order taker (see L<FS::access_user>)
258 =item referral_custnum
260 Referring customer number
264 Enable individual CDR spooling, empty or `Y'
268 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
272 Discourage individual CDR printing, empty or `Y'
276 Allow self-service editing of ticket subjects, empty or 'Y'
278 =item calling_list_exempt
280 Do not call, empty or 'Y'
290 Creates a new customer. To add the customer to the database, see L<"insert">.
292 Note that this stores the hash reference, not a distinct copy of the hash it
293 points to. You can ask the object for a copy with the I<hash> method.
297 sub table { 'cust_main'; }
299 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
301 Adds this customer to the database. If there is an error, returns the error,
302 otherwise returns false.
304 Usually the customer's location will not yet exist in the database, and
305 the C<bill_location> and C<ship_location> pseudo-fields must be set to
306 uninserted L<FS::cust_location> objects. These will be inserted and linked
307 (in both directions) to the new customer record. If they're references
308 to the same object, they will become the same location.
310 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
311 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
312 are inserted atomicly, or the transaction is rolled back. Passing an empty
313 hash reference is equivalent to not supplying this parameter. There should be
314 a better explanation of this, but until then, here's an example:
317 tie %hash, 'Tie::RefHash'; #this part is important
319 $cust_pkg => [ $svc_acct ],
322 $cust_main->insert( \%hash );
324 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
325 be set as the invoicing list (see L<"invoicing_list">). Errors return as
326 expected and rollback the entire transaction; it is not necessary to call
327 check_invoicing_list first. The invoicing_list is set after the records in the
328 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
329 invoicing_list destination to the newly-created svc_acct. Here's an example:
331 $cust_main->insert( {}, [ $email, 'POST' ] );
333 Currently available options are: I<depend_jobnum>, I<noexport>,
334 I<tax_exemption> and I<prospectnum>.
336 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
337 on the supplied jobnum (they will not run until the specific job completes).
338 This can be used to defer provisioning until some action completes (such
339 as running the customer's credit card successfully).
341 The I<noexport> option is deprecated. If I<noexport> is set true, no
342 provisioning jobs (exports) are scheduled. (You can schedule them later with
343 the B<reexport> method.)
345 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
346 of tax names and exemption numbers. FS::cust_main_exemption records will be
347 created and inserted.
349 If I<prospectnum> is set, moves contacts and locations from that prospect.
351 If I<contact> is set to an arrayref of FS::contact objects, inserts those
352 new contacts with this new customer.
358 my $cust_pkgs = @_ ? shift : {};
359 my $invoicing_list = @_ ? shift : '';
361 warn "$me insert called with options ".
362 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
365 local $SIG{HUP} = 'IGNORE';
366 local $SIG{INT} = 'IGNORE';
367 local $SIG{QUIT} = 'IGNORE';
368 local $SIG{TERM} = 'IGNORE';
369 local $SIG{TSTP} = 'IGNORE';
370 local $SIG{PIPE} = 'IGNORE';
372 my $oldAutoCommit = $FS::UID::AutoCommit;
373 local $FS::UID::AutoCommit = 0;
376 my $prepay_identifier = '';
377 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
379 if ( $self->payby eq 'PREPAY' ) {
381 $self->payby('BILL');
382 $prepay_identifier = $self->payinfo;
385 warn " looking up prepaid card $prepay_identifier\n"
388 my $error = $self->get_prepay( $prepay_identifier,
389 'amount_ref' => \$amount,
390 'seconds_ref' => \$seconds,
391 'upbytes_ref' => \$upbytes,
392 'downbytes_ref' => \$downbytes,
393 'totalbytes_ref' => \$totalbytes,
396 $dbh->rollback if $oldAutoCommit;
397 #return "error applying prepaid card (transaction rolled back): $error";
401 $payby = 'PREP' if $amount;
403 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
406 $self->payby('BILL');
407 $amount = $self->paid;
412 foreach my $l (qw(bill_location ship_location)) {
414 my $loc = delete $self->hashref->{$l} or next;
416 if ( !$loc->locationnum ) {
417 # warn the location that we're going to insert it with no custnum
418 $loc->set(custnum_pending => 1);
419 warn " inserting $l\n"
421 my $error = $loc->insert;
423 $dbh->rollback if $oldAutoCommit;
424 my $label = $l eq 'ship_location' ? 'service' : 'billing';
425 return "$error (in $label location)";
428 } elsif ( $loc->prospectnum ) {
430 $loc->prospectnum('');
431 $loc->set(custnum_pending => 1);
432 my $error = $loc->replace;
434 $dbh->rollback if $oldAutoCommit;
435 my $label = $l eq 'ship_location' ? 'service' : 'billing';
436 return "$error (moving $label location)";
439 } elsif ( ($loc->custnum || 0) > 0 ) {
440 # then it somehow belongs to another customer--shouldn't happen
441 $dbh->rollback if $oldAutoCommit;
442 return "$l belongs to customer ".$loc->custnum;
444 # else it already belongs to this customer
445 # (happens when ship_location is identical to bill_location)
447 $self->set($l.'num', $loc->locationnum);
449 if ( $self->get($l.'num') eq '' ) {
450 $dbh->rollback if $oldAutoCommit;
455 warn " inserting $self\n"
458 $self->signupdate(time) unless $self->signupdate;
460 $self->auto_agent_custid()
461 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
463 my $error = $self->SUPER::insert;
465 $dbh->rollback if $oldAutoCommit;
466 #return "inserting cust_main record (transaction rolled back): $error";
470 # now set cust_location.custnum
471 foreach my $l (qw(bill_location ship_location)) {
472 warn " setting $l.custnum\n"
474 my $loc = $self->$l or next;
475 unless ( $loc->custnum ) {
476 $loc->set(custnum => $self->custnum);
477 $error ||= $loc->replace;
481 $dbh->rollback if $oldAutoCommit;
482 return "error setting $l custnum: $error";
486 warn " setting invoicing list\n"
489 if ( $invoicing_list ) {
490 $error = $self->check_invoicing_list( $invoicing_list );
492 $dbh->rollback if $oldAutoCommit;
493 #return "checking invoicing_list (transaction rolled back): $error";
496 $self->invoicing_list( $invoicing_list );
499 warn " setting customer tags\n"
502 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
503 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
504 'custnum' => $self->custnum };
505 my $error = $cust_tag->insert;
507 $dbh->rollback if $oldAutoCommit;
512 my $prospectnum = delete $options{'prospectnum'};
513 if ( $prospectnum ) {
515 warn " moving contacts and locations from prospect $prospectnum\n"
519 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
520 unless ( $prospect_main ) {
521 $dbh->rollback if $oldAutoCommit;
522 return "Unknown prospectnum $prospectnum";
524 $prospect_main->custnum($self->custnum);
525 $prospect_main->disabled('Y');
526 my $error = $prospect_main->replace;
528 $dbh->rollback if $oldAutoCommit;
532 foreach my $prospect_contact ( $prospect_main->prospect_contact ) {
533 my $cust_contact = new FS::cust_contact {
534 'custnum' => $self->custnum,
535 map { $_ => $prospect_contact->$_() } qw( contactnum classnum comment )
537 my $error = $cust_contact->insert
538 || $prospect_contact->delete;
540 $dbh->rollback if $oldAutoCommit;
545 my @cust_location = $prospect_main->cust_location;
546 my @qual = $prospect_main->qual;
548 foreach my $r ( @cust_location, @qual ) {
550 $r->custnum($self->custnum);
551 my $error = $r->replace;
553 $dbh->rollback if $oldAutoCommit;
560 my $contact = delete $options{'contact'};
563 foreach my $c ( @$contact ) {
564 $c->custnum($self->custnum);
565 my $error = $c->insert;
567 $dbh->rollback if $oldAutoCommit;
575 warn " setting cust_main_exemption\n"
578 my $tax_exemption = delete $options{'tax_exemption'};
579 if ( $tax_exemption ) {
581 $tax_exemption = { map { $_ => '' } @$tax_exemption }
582 if ref($tax_exemption) eq 'ARRAY';
584 foreach my $taxname ( keys %$tax_exemption ) {
585 my $cust_main_exemption = new FS::cust_main_exemption {
586 'custnum' => $self->custnum,
587 'taxname' => $taxname,
588 'exempt_number' => $tax_exemption->{$taxname},
590 my $error = $cust_main_exemption->insert;
592 $dbh->rollback if $oldAutoCommit;
593 return "inserting cust_main_exemption (transaction rolled back): $error";
598 warn " ordering packages\n"
601 $error = $self->order_pkgs( $cust_pkgs,
603 'seconds_ref' => \$seconds,
604 'upbytes_ref' => \$upbytes,
605 'downbytes_ref' => \$downbytes,
606 'totalbytes_ref' => \$totalbytes,
609 $dbh->rollback if $oldAutoCommit;
614 $dbh->rollback if $oldAutoCommit;
615 return "No svc_acct record to apply pre-paid time";
617 if ( $upbytes || $downbytes || $totalbytes ) {
618 $dbh->rollback if $oldAutoCommit;
619 return "No svc_acct record to apply pre-paid data";
623 warn " inserting initial $payby payment of $amount\n"
625 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
627 $dbh->rollback if $oldAutoCommit;
628 return "inserting payment (transaction rolled back): $error";
632 unless ( $import || $skip_fuzzyfiles ) {
633 warn " queueing fuzzyfiles update\n"
635 $error = $self->queue_fuzzyfiles_update;
637 $dbh->rollback if $oldAutoCommit;
638 return "updating fuzzy search cache: $error";
642 # FS::geocode_Mixin::after_insert or something?
643 if ( $conf->config('tax_district_method') and !$import ) {
644 # if anything non-empty, try to look it up
645 my $queue = new FS::queue {
646 'job' => 'FS::geocode_Mixin::process_district_update',
647 'custnum' => $self->custnum,
649 my $error = $queue->insert( ref($self), $self->custnum );
651 $dbh->rollback if $oldAutoCommit;
652 return "queueing tax district update: $error";
657 warn " exporting\n" if $DEBUG > 1;
659 my $export_args = $options{'export_args'} || [];
662 map qsearch( 'part_export', {exportnum=>$_} ),
663 $conf->config('cust_main-exports'); #, $agentnum
665 foreach my $part_export ( @part_export ) {
666 my $error = $part_export->export_insert($self, @$export_args);
668 $dbh->rollback if $oldAutoCommit;
669 return "exporting to ". $part_export->exporttype.
670 " (transaction rolled back): $error";
674 #foreach my $depend_jobnum ( @$depend_jobnums ) {
675 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
677 # foreach my $jobnum ( @jobnums ) {
678 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
679 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
681 # my $error = $queue->depend_insert($depend_jobnum);
683 # $dbh->rollback if $oldAutoCommit;
684 # return "error queuing job dependancy: $error";
691 #if ( exists $options{'jobnums'} ) {
692 # push @{ $options{'jobnums'} }, @jobnums;
695 warn " insert complete; committing transaction\n"
698 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
703 use File::CounterFile;
704 sub auto_agent_custid {
707 my $format = $conf->config('cust_main-auto_agent_custid');
709 if ( $format eq '1YMMXXXXXXXX' ) {
711 my $counter = new File::CounterFile 'cust_main.agent_custid';
714 my $ym = 100000000000 + time2str('%y%m00000000', time);
715 if ( $ym > $counter->value ) {
716 $counter->{'value'} = $agent_custid = $ym;
717 $counter->{'updated'} = 1;
719 $agent_custid = $counter->inc;
725 die "Unknown cust_main-auto_agent_custid format: $format";
728 $self->agent_custid($agent_custid);
732 =item PACKAGE METHODS
734 Documentation on customer package methods has been moved to
735 L<FS::cust_main::Packages>.
737 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
739 Recharges this (existing) customer with the specified prepaid card (see
740 L<FS::prepay_credit>), specified either by I<identifier> or as an
741 FS::prepay_credit object. If there is an error, returns the error, otherwise
744 Optionally, five scalar references can be passed as well. They will have their
745 values filled in with the amount, number of seconds, and number of upload,
746 download, and total bytes applied by this prepaid card.
750 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
751 #the only place that uses these args
752 sub recharge_prepay {
753 my( $self, $prepay_credit, $amountref, $secondsref,
754 $upbytesref, $downbytesref, $totalbytesref ) = @_;
756 local $SIG{HUP} = 'IGNORE';
757 local $SIG{INT} = 'IGNORE';
758 local $SIG{QUIT} = 'IGNORE';
759 local $SIG{TERM} = 'IGNORE';
760 local $SIG{TSTP} = 'IGNORE';
761 local $SIG{PIPE} = 'IGNORE';
763 my $oldAutoCommit = $FS::UID::AutoCommit;
764 local $FS::UID::AutoCommit = 0;
767 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
769 my $error = $self->get_prepay( $prepay_credit,
770 'amount_ref' => \$amount,
771 'seconds_ref' => \$seconds,
772 'upbytes_ref' => \$upbytes,
773 'downbytes_ref' => \$downbytes,
774 'totalbytes_ref' => \$totalbytes,
776 || $self->increment_seconds($seconds)
777 || $self->increment_upbytes($upbytes)
778 || $self->increment_downbytes($downbytes)
779 || $self->increment_totalbytes($totalbytes)
780 || $self->insert_cust_pay_prepay( $amount,
782 ? $prepay_credit->identifier
787 $dbh->rollback if $oldAutoCommit;
791 if ( defined($amountref) ) { $$amountref = $amount; }
792 if ( defined($secondsref) ) { $$secondsref = $seconds; }
793 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
794 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
795 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
797 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
802 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
804 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
805 specified either by I<identifier> or as an FS::prepay_credit object.
807 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
808 incremented by the values of the prepaid card.
810 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
811 check or set this customer's I<agentnum>.
813 If there is an error, returns the error, otherwise returns false.
819 my( $self, $prepay_credit, %opt ) = @_;
821 local $SIG{HUP} = 'IGNORE';
822 local $SIG{INT} = 'IGNORE';
823 local $SIG{QUIT} = 'IGNORE';
824 local $SIG{TERM} = 'IGNORE';
825 local $SIG{TSTP} = 'IGNORE';
826 local $SIG{PIPE} = 'IGNORE';
828 my $oldAutoCommit = $FS::UID::AutoCommit;
829 local $FS::UID::AutoCommit = 0;
832 unless ( ref($prepay_credit) ) {
834 my $identifier = $prepay_credit;
836 $prepay_credit = qsearchs(
838 { 'identifier' => $identifier },
843 unless ( $prepay_credit ) {
844 $dbh->rollback if $oldAutoCommit;
845 return "Invalid prepaid card: ". $identifier;
850 if ( $prepay_credit->agentnum ) {
851 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
852 $dbh->rollback if $oldAutoCommit;
853 return "prepaid card not valid for agent ". $self->agentnum;
855 $self->agentnum($prepay_credit->agentnum);
858 my $error = $prepay_credit->delete;
860 $dbh->rollback if $oldAutoCommit;
861 return "removing prepay_credit (transaction rolled back): $error";
864 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
865 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
867 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
872 =item increment_upbytes SECONDS
874 Updates this customer's single or primary account (see L<FS::svc_acct>) by
875 the specified number of upbytes. If there is an error, returns the error,
876 otherwise returns false.
880 sub increment_upbytes {
881 _increment_column( shift, 'upbytes', @_);
884 =item increment_downbytes SECONDS
886 Updates this customer's single or primary account (see L<FS::svc_acct>) by
887 the specified number of downbytes. If there is an error, returns the error,
888 otherwise returns false.
892 sub increment_downbytes {
893 _increment_column( shift, 'downbytes', @_);
896 =item increment_totalbytes SECONDS
898 Updates this customer's single or primary account (see L<FS::svc_acct>) by
899 the specified number of totalbytes. If there is an error, returns the error,
900 otherwise returns false.
904 sub increment_totalbytes {
905 _increment_column( shift, 'totalbytes', @_);
908 =item increment_seconds SECONDS
910 Updates this customer's single or primary account (see L<FS::svc_acct>) by
911 the specified number of seconds. If there is an error, returns the error,
912 otherwise returns false.
916 sub increment_seconds {
917 _increment_column( shift, 'seconds', @_);
920 =item _increment_column AMOUNT
922 Updates this customer's single or primary account (see L<FS::svc_acct>) by
923 the specified number of seconds or bytes. If there is an error, returns
924 the error, otherwise returns false.
928 sub _increment_column {
929 my( $self, $column, $amount ) = @_;
930 warn "$me increment_column called: $column, $amount\n"
933 return '' unless $amount;
935 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
936 $self->ncancelled_pkgs;
939 return 'No packages with primary or single services found'.
940 ' to apply pre-paid time';
941 } elsif ( scalar(@cust_pkg) > 1 ) {
942 #maybe have a way to specify the package/account?
943 return 'Multiple packages found to apply pre-paid time';
946 my $cust_pkg = $cust_pkg[0];
947 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
951 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
954 return 'No account found to apply pre-paid time';
955 } elsif ( scalar(@cust_svc) > 1 ) {
956 return 'Multiple accounts found to apply pre-paid time';
959 my $svc_acct = $cust_svc[0]->svc_x;
960 warn " found service svcnum ". $svc_acct->pkgnum.
961 ' ('. $svc_acct->email. ")\n"
964 $column = "increment_$column";
965 $svc_acct->$column($amount);
969 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
971 Inserts a prepayment in the specified amount for this customer. An optional
972 second argument can specify the prepayment identifier for tracking purposes.
973 If there is an error, returns the error, otherwise returns false.
977 sub insert_cust_pay_prepay {
978 shift->insert_cust_pay('PREP', @_);
981 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
983 Inserts a cash payment in the specified amount for this customer. An optional
984 second argument can specify the payment identifier for tracking purposes.
985 If there is an error, returns the error, otherwise returns false.
989 sub insert_cust_pay_cash {
990 shift->insert_cust_pay('CASH', @_);
993 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
995 Inserts a Western Union payment in the specified amount for this customer. An
996 optional second argument can specify the prepayment identifier for tracking
997 purposes. If there is an error, returns the error, otherwise returns false.
1001 sub insert_cust_pay_west {
1002 shift->insert_cust_pay('WEST', @_);
1005 sub insert_cust_pay {
1006 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1007 my $payinfo = scalar(@_) ? shift : '';
1009 my $cust_pay = new FS::cust_pay {
1010 'custnum' => $self->custnum,
1011 'paid' => sprintf('%.2f', $amount),
1012 #'_date' => #date the prepaid card was purchased???
1014 'payinfo' => $payinfo,
1020 =item delete [ OPTION => VALUE ... ]
1022 This deletes the customer. If there is an error, returns the error, otherwise
1025 This will completely remove all traces of the customer record. This is not
1026 what you want when a customer cancels service; for that, cancel all of the
1027 customer's packages (see L</cancel>).
1029 If the customer has any uncancelled packages, you need to pass a new (valid)
1030 customer number for those packages to be transferred to, as the "new_customer"
1031 option. Cancelled packages will be deleted. Did I mention that this is NOT
1032 what you want when a customer cancels service and that you really should be
1033 looking at L<FS::cust_pkg/cancel>?
1035 You can't delete a customer with invoices (see L<FS::cust_bill>),
1036 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1037 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1038 set the "delete_financials" option to a true value.
1043 my( $self, %opt ) = @_;
1045 local $SIG{HUP} = 'IGNORE';
1046 local $SIG{INT} = 'IGNORE';
1047 local $SIG{QUIT} = 'IGNORE';
1048 local $SIG{TERM} = 'IGNORE';
1049 local $SIG{TSTP} = 'IGNORE';
1050 local $SIG{PIPE} = 'IGNORE';
1052 my $oldAutoCommit = $FS::UID::AutoCommit;
1053 local $FS::UID::AutoCommit = 0;
1056 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1057 $dbh->rollback if $oldAutoCommit;
1058 return "Can't delete a master agent customer";
1061 #use FS::access_user
1062 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1063 $dbh->rollback if $oldAutoCommit;
1064 return "Can't delete a master employee customer";
1067 tie my %financial_tables, 'Tie::IxHash',
1068 'cust_bill' => 'invoices',
1069 'cust_statement' => 'statements',
1070 'cust_credit' => 'credits',
1071 'cust_pay' => 'payments',
1072 'cust_refund' => 'refunds',
1075 foreach my $table ( keys %financial_tables ) {
1077 my @records = $self->$table();
1079 if ( @records && ! $opt{'delete_financials'} ) {
1080 $dbh->rollback if $oldAutoCommit;
1081 return "Can't delete a customer with ". $financial_tables{$table};
1084 foreach my $record ( @records ) {
1085 my $error = $record->delete;
1087 $dbh->rollback if $oldAutoCommit;
1088 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1094 my @cust_pkg = $self->ncancelled_pkgs;
1096 my $new_custnum = $opt{'new_custnum'};
1097 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1098 $dbh->rollback if $oldAutoCommit;
1099 return "Invalid new customer number: $new_custnum";
1101 foreach my $cust_pkg ( @cust_pkg ) {
1102 my %hash = $cust_pkg->hash;
1103 $hash{'custnum'} = $new_custnum;
1104 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1105 my $error = $new_cust_pkg->replace($cust_pkg,
1106 options => { $cust_pkg->options },
1109 $dbh->rollback if $oldAutoCommit;
1114 my @cancelled_cust_pkg = $self->all_pkgs;
1115 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1116 my $error = $cust_pkg->delete;
1118 $dbh->rollback if $oldAutoCommit;
1123 #cust_tax_adjustment in financials?
1124 #cust_pay_pending? ouch
1126 foreach my $table (qw(
1127 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1128 cust_location cust_main_note cust_tax_adjustment
1129 cust_pay_void cust_pay_batch queue cust_tax_exempt
1131 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1132 my $error = $record->delete;
1134 $dbh->rollback if $oldAutoCommit;
1140 my $sth = $dbh->prepare(
1141 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1143 my $errstr = $dbh->errstr;
1144 $dbh->rollback if $oldAutoCommit;
1147 $sth->execute($self->custnum) or do {
1148 my $errstr = $sth->errstr;
1149 $dbh->rollback if $oldAutoCommit;
1155 my $ticket_dbh = '';
1156 if ($conf->config('ticket_system') eq 'RT_Internal') {
1158 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1159 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1160 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1161 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1164 if ( $ticket_dbh ) {
1166 my $ticket_sth = $ticket_dbh->prepare(
1167 'DELETE FROM Links WHERE Target = ?'
1169 my $errstr = $ticket_dbh->errstr;
1170 $dbh->rollback if $oldAutoCommit;
1173 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1175 my $errstr = $ticket_sth->errstr;
1176 $dbh->rollback if $oldAutoCommit;
1180 #check and see if the customer is the only link on the ticket, and
1181 #if so, set the ticket to deleted status in RT?
1182 #maybe someday, for now this will at least fix tickets not displaying
1186 #delete the customer record
1188 my $error = $self->SUPER::delete;
1190 $dbh->rollback if $oldAutoCommit;
1194 # cust_main exports!
1196 #my $export_args = $options{'export_args'} || [];
1199 map qsearch( 'part_export', {exportnum=>$_} ),
1200 $conf->config('cust_main-exports'); #, $agentnum
1202 foreach my $part_export ( @part_export ) {
1203 my $error = $part_export->export_delete( $self ); #, @$export_args);
1205 $dbh->rollback if $oldAutoCommit;
1206 return "exporting to ". $part_export->exporttype.
1207 " (transaction rolled back): $error";
1211 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1216 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1218 Replaces the OLD_RECORD with this one in the database. If there is an error,
1219 returns the error, otherwise returns false.
1221 To change the customer's address, set the pseudo-fields C<bill_location> and
1222 C<ship_location>. The address will still only change if at least one of the
1223 address fields differs from the existing values.
1225 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1226 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1227 expected and rollback the entire transaction; it is not necessary to call
1228 check_invoicing_list first. Here's an example:
1230 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1232 Currently available options are: I<tax_exemption>.
1234 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1235 of tax names and exemption numbers. FS::cust_main_exemption records will be
1236 deleted and inserted as appropriate.
1243 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1245 : $self->replace_old;
1249 warn "$me replace called\n"
1252 my $curuser = $FS::CurrentUser::CurrentUser;
1253 if ( $self->payby eq 'COMP'
1254 && $self->payby ne $old->payby
1255 && ! $curuser->access_right('Complimentary customer')
1258 return "You are not permitted to create complimentary accounts.";
1261 local($ignore_expired_card) = 1
1262 if $old->payby =~ /^(CARD|DCRD)$/
1263 && $self->payby =~ /^(CARD|DCRD)$/
1264 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1266 local($ignore_banned_card) = 1
1267 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1268 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1269 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1271 return "Invoicing locale is required"
1274 && $conf->exists('cust_main-require_locale');
1276 local $SIG{HUP} = 'IGNORE';
1277 local $SIG{INT} = 'IGNORE';
1278 local $SIG{QUIT} = 'IGNORE';
1279 local $SIG{TERM} = 'IGNORE';
1280 local $SIG{TSTP} = 'IGNORE';
1281 local $SIG{PIPE} = 'IGNORE';
1283 my $oldAutoCommit = $FS::UID::AutoCommit;
1284 local $FS::UID::AutoCommit = 0;
1287 for my $l (qw(bill_location ship_location)) {
1288 my $old_loc = $old->$l;
1289 my $new_loc = $self->$l;
1291 # find the existing location if there is one
1292 $new_loc->set('custnum' => $self->custnum);
1293 my $error = $new_loc->find_or_insert;
1295 $dbh->rollback if $oldAutoCommit;
1298 $self->set($l.'num', $new_loc->locationnum);
1301 # replace the customer record
1302 my $error = $self->SUPER::replace($old);
1305 $dbh->rollback if $oldAutoCommit;
1309 # now move packages to the new service location
1310 $self->set('ship_location', ''); #flush cache
1311 if ( $old->ship_locationnum and # should only be null during upgrade...
1312 $old->ship_locationnum != $self->ship_locationnum ) {
1313 $error = $old->ship_location->move_to($self->ship_location);
1315 $dbh->rollback if $oldAutoCommit;
1319 # don't move packages based on the billing location, but
1320 # disable it if it's no longer in use
1321 if ( $old->bill_locationnum and
1322 $old->bill_locationnum != $self->bill_locationnum ) {
1323 $error = $old->bill_location->disable_if_unused;
1325 $dbh->rollback if $oldAutoCommit;
1330 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1331 my $invoicing_list = shift @param;
1332 $error = $self->check_invoicing_list( $invoicing_list );
1334 $dbh->rollback if $oldAutoCommit;
1337 $self->invoicing_list( $invoicing_list );
1340 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1342 #this could be more efficient than deleting and re-inserting, if it matters
1343 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1344 my $error = $cust_tag->delete;
1346 $dbh->rollback if $oldAutoCommit;
1350 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1351 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1352 'custnum' => $self->custnum };
1353 my $error = $cust_tag->insert;
1355 $dbh->rollback if $oldAutoCommit;
1362 my %options = @param;
1364 my $tax_exemption = delete $options{'tax_exemption'};
1365 if ( $tax_exemption ) {
1367 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1368 if ref($tax_exemption) eq 'ARRAY';
1370 my %cust_main_exemption =
1371 map { $_->taxname => $_ }
1372 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1374 foreach my $taxname ( keys %$tax_exemption ) {
1376 if ( $cust_main_exemption{$taxname} &&
1377 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1380 delete $cust_main_exemption{$taxname};
1384 my $cust_main_exemption = new FS::cust_main_exemption {
1385 'custnum' => $self->custnum,
1386 'taxname' => $taxname,
1387 'exempt_number' => $tax_exemption->{$taxname},
1389 my $error = $cust_main_exemption->insert;
1391 $dbh->rollback if $oldAutoCommit;
1392 return "inserting cust_main_exemption (transaction rolled back): $error";
1396 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1397 my $error = $cust_main_exemption->delete;
1399 $dbh->rollback if $oldAutoCommit;
1400 return "deleting cust_main_exemption (transaction rolled back): $error";
1406 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1407 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1408 && $self->get('payinfo') !~ /^99\d{14}$/
1410 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1415 # card/check/lec info has changed, want to retry realtime_ invoice events
1416 my $error = $self->retry_realtime;
1418 $dbh->rollback if $oldAutoCommit;
1423 unless ( $import || $skip_fuzzyfiles ) {
1424 $error = $self->queue_fuzzyfiles_update;
1426 $dbh->rollback if $oldAutoCommit;
1427 return "updating fuzzy search cache: $error";
1431 # tax district update in cust_location
1433 # cust_main exports!
1435 my $export_args = $options{'export_args'} || [];
1438 map qsearch( 'part_export', {exportnum=>$_} ),
1439 $conf->config('cust_main-exports'); #, $agentnum
1441 foreach my $part_export ( @part_export ) {
1442 my $error = $part_export->export_replace( $self, $old, @$export_args);
1444 $dbh->rollback if $oldAutoCommit;
1445 return "exporting to ". $part_export->exporttype.
1446 " (transaction rolled back): $error";
1450 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1455 =item queue_fuzzyfiles_update
1457 Used by insert & replace to update the fuzzy search cache
1461 use FS::cust_main::Search;
1462 sub queue_fuzzyfiles_update {
1465 local $SIG{HUP} = 'IGNORE';
1466 local $SIG{INT} = 'IGNORE';
1467 local $SIG{QUIT} = 'IGNORE';
1468 local $SIG{TERM} = 'IGNORE';
1469 local $SIG{TSTP} = 'IGNORE';
1470 local $SIG{PIPE} = 'IGNORE';
1472 my $oldAutoCommit = $FS::UID::AutoCommit;
1473 local $FS::UID::AutoCommit = 0;
1476 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1477 my $queue = new FS::queue {
1478 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1480 my @args = "cust_main.$field", $self->get($field);
1481 my $error = $queue->insert( @args );
1483 $dbh->rollback if $oldAutoCommit;
1484 return "queueing job (transaction rolled back): $error";
1489 push @locations, $self->bill_location if $self->bill_locationnum;
1490 push @locations, $self->ship_location if @locations && $self->has_ship_address;
1491 foreach my $location (@locations) {
1492 my $queue = new FS::queue {
1493 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1495 my @args = 'cust_location.address1', $location->address1;
1496 my $error = $queue->insert( @args );
1498 $dbh->rollback if $oldAutoCommit;
1499 return "queueing job (transaction rolled back): $error";
1503 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1510 Checks all fields to make sure this is a valid customer record. If there is
1511 an error, returns the error, otherwise returns false. Called by the insert
1512 and replace methods.
1519 warn "$me check BEFORE: \n". $self->_dump
1523 $self->ut_numbern('custnum')
1524 || $self->ut_number('agentnum')
1525 || $self->ut_textn('agent_custid')
1526 || $self->ut_number('refnum')
1527 || $self->ut_foreign_keyn('bill_locationnum', 'cust_location','locationnum')
1528 || $self->ut_foreign_keyn('ship_locationnum', 'cust_location','locationnum')
1529 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1530 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1531 || $self->ut_foreign_keyn('taxstatusnum', 'tax_status', 'taxstatusnum')
1532 || $self->ut_textn('custbatch')
1533 || $self->ut_name('last')
1534 || $self->ut_name('first')
1535 || $self->ut_snumbern('signupdate')
1536 || $self->ut_snumbern('birthdate')
1537 || $self->ut_namen('spouse_last')
1538 || $self->ut_namen('spouse_first')
1539 || $self->ut_snumbern('spouse_birthdate')
1540 || $self->ut_snumbern('anniversary_date')
1541 || $self->ut_textn('company')
1542 || $self->ut_textn('ship_company')
1543 || $self->ut_anything('comments')
1544 || $self->ut_numbern('referral_custnum')
1545 || $self->ut_textn('stateid')
1546 || $self->ut_textn('stateid_state')
1547 || $self->ut_textn('invoice_terms')
1548 || $self->ut_floatn('cdr_termination_percentage')
1549 || $self->ut_floatn('credit_limit')
1550 || $self->ut_numbern('billday')
1551 || $self->ut_numbern('prorate_day')
1552 || $self->ut_flag('edit_subject')
1553 || $self->ut_flag('calling_list_exempt')
1554 || $self->ut_flag('invoice_noemail')
1555 || $self->ut_flag('message_noemail')
1556 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1557 || $self->ut_currencyn('currency')
1560 foreach (qw(company ship_company)) {
1561 my $company = $self->get($_);
1562 $company =~ s/^\s+//;
1563 $company =~ s/\s+$//;
1564 $company =~ s/\s+/ /g;
1565 $self->set($_, $company);
1568 #barf. need message catalogs. i18n. etc.
1569 $error .= "Please select an advertising source."
1570 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1571 return $error if $error;
1573 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1574 or return "Unknown agent";
1576 if ( $self->currency ) {
1577 my $agent_currency = qsearchs( 'agent_currency', {
1578 'agentnum' => $agent->agentnum,
1579 'currency' => $self->currency,
1581 or return "Agent ". $agent->agent.
1582 " not permitted to offer ". $self->currency. " invoicing";
1585 return "Unknown refnum"
1586 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1588 return "Unknown referring custnum: ". $self->referral_custnum
1589 unless ! $self->referral_custnum
1590 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1592 if ( $self->ss eq '' ) {
1597 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1598 or return "Illegal social security number: ". $self->ss;
1599 $self->ss("$1-$2-$3");
1602 # cust_main_county verification now handled by cust_location check
1605 $self->ut_phonen('daytime', $self->country)
1606 || $self->ut_phonen('night', $self->country)
1607 || $self->ut_phonen('fax', $self->country)
1608 || $self->ut_phonen('mobile', $self->country)
1610 return $error if $error;
1612 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1614 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1617 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1619 : FS::Msgcat::_gettext('daytime');
1620 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1622 : FS::Msgcat::_gettext('night');
1624 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1626 : FS::Msgcat::_gettext('mobile');
1628 return "$daytime_label, $night_label or $mobile_label is required"
1632 ### start of stuff moved to cust_payby
1633 # then mostly kept here to support upgrades (can remove in 5.x)
1634 # but modified to allow everything to be empty
1636 if ( $self->payby ) {
1637 FS::payby->can_payby($self->table, $self->payby)
1638 or return "Illegal payby: ". $self->payby;
1643 $error = $self->ut_numbern('paystart_month')
1644 || $self->ut_numbern('paystart_year')
1645 || $self->ut_numbern('payissue')
1646 || $self->ut_textn('paytype')
1648 return $error if $error;
1650 if ( $self->payip eq '' ) {
1653 $error = $self->ut_ip('payip');
1654 return $error if $error;
1657 # If it is encrypted and the private key is not availaible then we can't
1658 # check the credit card.
1659 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1661 # Need some kind of global flag to accept invalid cards, for testing
1663 if ( !$import && !$ignore_invalid_card && $check_payinfo &&
1664 $self->payby =~ /^(CARD|DCRD)$/ ) {
1666 my $payinfo = $self->payinfo;
1667 $payinfo =~ s/\D//g;
1668 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1669 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1671 $self->payinfo($payinfo);
1673 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1675 return gettext('unknown_card_type')
1676 if $self->payinfo !~ /^99\d{14}$/ #token
1677 && cardtype($self->payinfo) eq "Unknown";
1679 unless ( $ignore_banned_card ) {
1680 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1682 if ( $ban->bantype eq 'warn' ) {
1683 #or others depending on value of $ban->reason ?
1684 return '_duplicate_card'.
1685 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1686 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1687 ' (ban# '. $ban->bannum. ')'
1688 unless $self->override_ban_warn;
1690 return 'Banned credit card: banned on '.
1691 time2str('%a %h %o at %r', $ban->_date).
1692 ' by '. $ban->otaker.
1693 ' (ban# '. $ban->bannum. ')';
1698 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1699 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1700 $self->paycvv =~ /^(\d{4})$/
1701 or return "CVV2 (CID) for American Express cards is four digits.";
1704 $self->paycvv =~ /^(\d{3})$/
1705 or return "CVV2 (CVC2/CID) is three digits.";
1712 my $cardtype = cardtype($payinfo);
1713 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1715 return "Start date or issue number is required for $cardtype cards"
1716 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1718 return "Start month must be between 1 and 12"
1719 if $self->paystart_month
1720 and $self->paystart_month < 1 || $self->paystart_month > 12;
1722 return "Start year must be 1990 or later"
1723 if $self->paystart_year
1724 and $self->paystart_year < 1990;
1726 return "Issue number must be beween 1 and 99"
1728 and $self->payissue < 1 || $self->payissue > 99;
1731 $self->paystart_month('');
1732 $self->paystart_year('');
1733 $self->payissue('');
1736 } elsif ( !$ignore_invalid_card && $check_payinfo &&
1737 $self->payby =~ /^(CHEK|DCHK)$/ ) {
1739 my $payinfo = $self->payinfo;
1740 $payinfo =~ s/[^\d\@\.]//g;
1741 if ( $conf->config('echeck-country') eq 'CA' ) {
1742 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1743 or return 'invalid echeck account@branch.bank';
1744 $payinfo = "$1\@$2.$3";
1745 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1746 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1747 $payinfo = "$1\@$2";
1749 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1750 $payinfo = "$1\@$2";
1752 $self->payinfo($payinfo);
1755 unless ( $ignore_banned_card ) {
1756 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1758 if ( $ban->bantype eq 'warn' ) {
1759 #or others depending on value of $ban->reason ?
1760 return '_duplicate_ach' unless $self->override_ban_warn;
1762 return 'Banned ACH account: banned on '.
1763 time2str('%a %h %o at %r', $ban->_date).
1764 ' by '. $ban->otaker.
1765 ' (ban# '. $ban->bannum. ')';
1770 } elsif ( $self->payby eq 'LECB' ) {
1772 my $payinfo = $self->payinfo;
1773 $payinfo =~ s/\D//g;
1774 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1776 $self->payinfo($payinfo);
1779 } elsif ( $self->payby eq 'BILL' ) {
1781 $error = $self->ut_textn('payinfo');
1782 return "Illegal P.O. number: ". $self->payinfo if $error;
1785 } elsif ( $self->payby eq 'COMP' ) {
1787 my $curuser = $FS::CurrentUser::CurrentUser;
1788 if ( ! $self->custnum
1789 && ! $curuser->access_right('Complimentary customer')
1792 return "You are not permitted to create complimentary accounts."
1795 $error = $self->ut_textn('payinfo');
1796 return "Illegal comp account issuer: ". $self->payinfo if $error;
1799 } elsif ( $self->payby eq 'PREPAY' ) {
1801 my $payinfo = $self->payinfo;
1802 $payinfo =~ s/\W//g; #anything else would just confuse things
1803 $self->payinfo($payinfo);
1804 $error = $self->ut_alpha('payinfo');
1805 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1806 return "Unknown prepayment identifier"
1807 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1812 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1813 return "Expiration date required"
1814 # shouldn't payinfo_check do this?
1815 unless ! $self->payby
1816 || $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
1820 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1821 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1822 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1823 ( $m, $y ) = ( $2, "19$1" );
1824 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1825 ( $m, $y ) = ( $3, "20$2" );
1827 return "Illegal expiration date: ". $self->paydate;
1829 $m = sprintf('%02d',$m);
1830 $self->paydate("$y-$m-01");
1831 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1832 return gettext('expired_card')
1834 && !$ignore_expired_card
1835 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1838 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1839 ( ! $conf->exists('require_cardname')
1840 || $self->payby !~ /^(CARD|DCRD)$/ )
1842 $self->payname( $self->first. " ". $self->getfield('last') );
1845 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
1846 $self->payname =~ /^([\w \,\.\-\']*)$/
1847 or return gettext('illegal_name'). " payname: ". $self->payname;
1850 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
1851 or return gettext('illegal_name'). " payname: ". $self->payname;
1857 ### end of stuff moved to cust_payby
1859 return "Please select an invoicing locale"
1862 && $conf->exists('cust_main-require_locale');
1864 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1865 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1869 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1871 warn "$me check AFTER: \n". $self->_dump
1874 $self->SUPER::check;
1879 Returns a list of fields which have ship_ duplicates.
1884 qw( last first company
1886 address1 address2 city county state zip country
1888 daytime night fax mobile
1892 =item has_ship_address
1894 Returns true if this customer record has a separate shipping address.
1898 sub has_ship_address {
1900 $self->bill_locationnum != $self->ship_locationnum;
1905 Returns a list of key/value pairs, with the following keys: address1,
1906 adddress2, city, county, state, zip, country, district, and geocode. The
1907 shipping address is used if present.
1913 $self->ship_location->location_hash;
1918 Returns all locations (see L<FS::cust_location>) for this customer.
1924 qsearch('cust_location', { 'custnum' => $self->custnum,
1925 'prospectnum' => '' } );
1930 Returns all contact associations (see L<FS::cust_contact>) for this customer.
1936 qsearch('cust_contact', { 'custnum' => $self->custnum } );
1941 Returns all payment methods (see L<FS::cust_payby>) for this customer.
1948 'table' => 'cust_payby',
1949 'hashref' => { 'custnum' => $self->custnum },
1950 'order_by' => 'ORDER BY weight ASC',
1956 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1957 and L<FS::cust_pkg>) for this customer, except those on hold.
1959 Returns a list: an empty list on success or a list of errors.
1965 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
1970 Unsuspends all suspended packages in the on-hold state (those without setup
1971 dates) for this customer.
1977 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
1982 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1984 Returns a list: an empty list on success or a list of errors.
1990 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1993 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1995 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1996 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
1997 of a list of pkgparts; the hashref has the following keys:
2001 =item pkgparts - listref of pkgparts
2003 =item (other options are passed to the suspend method)
2008 Returns a list: an empty list on success or a list of errors.
2012 sub suspend_if_pkgpart {
2014 my (@pkgparts, %opt);
2015 if (ref($_[0]) eq 'HASH'){
2016 @pkgparts = @{$_[0]{pkgparts}};
2021 grep { $_->suspend(%opt) }
2022 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2023 $self->unsuspended_pkgs;
2026 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2028 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2029 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2030 instead of a list of pkgparts; the hashref has the following keys:
2034 =item pkgparts - listref of pkgparts
2036 =item (other options are passed to the suspend method)
2040 Returns a list: an empty list on success or a list of errors.
2044 sub suspend_unless_pkgpart {
2046 my (@pkgparts, %opt);
2047 if (ref($_[0]) eq 'HASH'){
2048 @pkgparts = @{$_[0]{pkgparts}};
2053 grep { $_->suspend(%opt) }
2054 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2055 $self->unsuspended_pkgs;
2058 =item cancel [ OPTION => VALUE ... ]
2060 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2062 Available options are:
2066 =item quiet - can be set true to supress email cancellation notices.
2068 =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.
2070 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2072 =item nobill - can be set true to skip billing if it might otherwise be done.
2076 Always returns a list: an empty list on success or a list of errors.
2080 # nb that dates are not specified as valid options to this method
2083 my( $self, %opt ) = @_;
2085 warn "$me cancel called on customer ". $self->custnum. " with options ".
2086 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2089 return ( 'access denied' )
2090 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2092 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2094 #should try decryption (we might have the private key)
2095 # and if not maybe queue a job for the server that does?
2096 return ( "Can't (yet) ban encrypted credit cards" )
2097 if $self->is_encrypted($self->payinfo);
2099 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2100 my $error = $ban->insert;
2101 return ( $error ) if $error;
2105 my @pkgs = $self->ncancelled_pkgs;
2107 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2109 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2110 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2114 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2115 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2118 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2121 sub _banned_pay_hashref {
2132 'payby' => $payby2ban{$self->payby},
2133 'payinfo' => $self->payinfo,
2134 #don't ever *search* on reason! #'reason' =>
2138 sub _new_banned_pay_hashref {
2140 my $hr = $self->_banned_pay_hashref;
2141 $hr->{payinfo} = md5_base64($hr->{payinfo});
2147 Returns all notes (see L<FS::cust_main_note>) for this customer.
2152 my($self,$orderby_classnum) = (shift,shift);
2153 my $orderby = "sticky DESC, _date DESC";
2154 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2155 qsearch( 'cust_main_note',
2156 { 'custnum' => $self->custnum },
2158 "ORDER BY $orderby",
2164 Returns the agent (see L<FS::agent>) for this customer.
2168 Returns the agent name (see L<FS::agent>) for this customer.
2174 $self->agent->agent;
2179 Returns any tags associated with this customer, as FS::cust_tag objects,
2180 or an empty list if there are no tags.
2184 Returns any tags associated with this customer, as FS::part_tag objects,
2185 or an empty list if there are no tags.
2191 map $_->part_tag, $self->cust_tag;
2197 Returns the customer class, as an FS::cust_class object, or the empty string
2198 if there is no customer class.
2202 Returns the customer category name, or the empty string if there is no customer
2209 my $cust_class = $self->cust_class;
2211 ? $cust_class->categoryname
2217 Returns the customer class name, or the empty string if there is no customer
2224 my $cust_class = $self->cust_class;
2226 ? $cust_class->classname
2232 Returns the external tax status, as an FS::tax_status object, or the empty
2233 string if there is no tax status.
2239 if ( $self->taxstatusnum ) {
2240 qsearchs('tax_status', { 'taxstatusnum' => $self->taxstatusnum } );
2248 Returns the tax status code if there is one.
2254 my $tax_status = $self->tax_status;
2256 ? $tax_status->taxstatus
2260 =item BILLING METHODS
2262 Documentation on billing methods has been moved to
2263 L<FS::cust_main::Billing>.
2265 =item REALTIME BILLING METHODS
2267 Documentation on realtime billing methods has been moved to
2268 L<FS::cust_main::Billing_Realtime>.
2272 Removes the I<paycvv> field from the database directly.
2274 If there is an error, returns the error, otherwise returns false.
2280 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2281 or return dbh->errstr;
2282 $sth->execute($self->custnum)
2283 or return $sth->errstr;
2290 Returns the total owed for this customer on all invoices
2291 (see L<FS::cust_bill/owed>).
2297 $self->total_owed_date(2145859200); #12/31/2037
2300 =item total_owed_date TIME
2302 Returns the total owed for this customer on all invoices with date earlier than
2303 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2304 see L<Time::Local> and L<Date::Parse> for conversion functions.
2308 sub total_owed_date {
2312 my $custnum = $self->custnum;
2314 my $owed_sql = FS::cust_bill->owed_sql;
2317 SELECT SUM($owed_sql) FROM cust_bill
2318 WHERE custnum = $custnum
2322 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2326 =item total_owed_pkgnum PKGNUM
2328 Returns the total owed on all invoices for this customer's specific package
2329 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2333 sub total_owed_pkgnum {
2334 my( $self, $pkgnum ) = @_;
2335 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2338 =item total_owed_date_pkgnum TIME PKGNUM
2340 Returns the total owed for this customer's specific package when using
2341 experimental package balances on all invoices with date earlier than
2342 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2343 see L<Time::Local> and L<Date::Parse> for conversion functions.
2347 sub total_owed_date_pkgnum {
2348 my( $self, $time, $pkgnum ) = @_;
2351 foreach my $cust_bill (
2352 grep { $_->_date <= $time }
2353 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2355 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2357 sprintf( "%.2f", $total_bill );
2363 Returns the total amount of all payments.
2370 $total += $_->paid foreach $self->cust_pay;
2371 sprintf( "%.2f", $total );
2374 =item total_unapplied_credits
2376 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2377 customer. See L<FS::cust_credit/credited>.
2379 =item total_credited
2381 Old name for total_unapplied_credits. Don't use.
2385 sub total_credited {
2386 #carp "total_credited deprecated, use total_unapplied_credits";
2387 shift->total_unapplied_credits(@_);
2390 sub total_unapplied_credits {
2393 my $custnum = $self->custnum;
2395 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2398 SELECT SUM($unapplied_sql) FROM cust_credit
2399 WHERE custnum = $custnum
2402 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2406 =item total_unapplied_credits_pkgnum PKGNUM
2408 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2409 customer. See L<FS::cust_credit/credited>.
2413 sub total_unapplied_credits_pkgnum {
2414 my( $self, $pkgnum ) = @_;
2415 my $total_credit = 0;
2416 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2417 sprintf( "%.2f", $total_credit );
2421 =item total_unapplied_payments
2423 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2424 See L<FS::cust_pay/unapplied>.
2428 sub total_unapplied_payments {
2431 my $custnum = $self->custnum;
2433 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2436 SELECT SUM($unapplied_sql) FROM cust_pay
2437 WHERE custnum = $custnum
2440 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2444 =item total_unapplied_payments_pkgnum PKGNUM
2446 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2447 specific package when using experimental package balances. See
2448 L<FS::cust_pay/unapplied>.
2452 sub total_unapplied_payments_pkgnum {
2453 my( $self, $pkgnum ) = @_;
2454 my $total_unapplied = 0;
2455 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2456 sprintf( "%.2f", $total_unapplied );
2460 =item total_unapplied_refunds
2462 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2463 customer. See L<FS::cust_refund/unapplied>.
2467 sub total_unapplied_refunds {
2469 my $custnum = $self->custnum;
2471 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2474 SELECT SUM($unapplied_sql) FROM cust_refund
2475 WHERE custnum = $custnum
2478 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2484 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2485 total_unapplied_credits minus total_unapplied_payments).
2491 $self->balance_date_range;
2494 =item balance_date TIME
2496 Returns the balance for this customer, only considering invoices with date
2497 earlier than TIME (total_owed_date minus total_credited minus
2498 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2499 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2506 $self->balance_date_range(shift);
2509 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2511 Returns the balance for this customer, optionally considering invoices with
2512 date earlier than START_TIME, and not later than END_TIME
2513 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2515 Times are specified as SQL fragments or numeric
2516 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2517 L<Date::Parse> for conversion functions. The empty string can be passed
2518 to disable that time constraint completely.
2520 Accepts the same options as L<balance_date_sql>:
2524 =item unapplied_date
2526 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)
2530 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2531 time will be ignored. Note that START_TIME and END_TIME only limit the date
2532 range for invoices and I<unapplied> payments, credits, and refunds.
2538 sub balance_date_range {
2540 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2541 ') FROM cust_main WHERE custnum='. $self->custnum;
2542 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2545 =item balance_pkgnum PKGNUM
2547 Returns the balance for this customer's specific package when using
2548 experimental package balances (total_owed plus total_unrefunded, minus
2549 total_unapplied_credits minus total_unapplied_payments)
2553 sub balance_pkgnum {
2554 my( $self, $pkgnum ) = @_;
2557 $self->total_owed_pkgnum($pkgnum)
2558 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2559 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2560 - $self->total_unapplied_credits_pkgnum($pkgnum)
2561 - $self->total_unapplied_payments_pkgnum($pkgnum)
2567 Returns a hash of useful information for making a payment.
2577 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2578 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2579 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2583 For credit card transactions:
2595 For electronic check transactions:
2610 $return{balance} = $self->balance;
2612 $return{payname} = $self->payname
2613 || ( $self->first. ' '. $self->get('last') );
2615 $return{$_} = $self->bill_location->$_
2616 for qw(address1 address2 city state zip);
2618 $return{payby} = $self->payby;
2619 $return{stateid_state} = $self->stateid_state;
2621 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2622 $return{card_type} = cardtype($self->payinfo);
2623 $return{payinfo} = $self->paymask;
2625 @return{'month', 'year'} = $self->paydate_monthyear;
2629 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2630 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2631 $return{payinfo1} = $payinfo1;
2632 $return{payinfo2} = $payinfo2;
2633 $return{paytype} = $self->paytype;
2634 $return{paystate} = $self->paystate;
2638 #doubleclick protection
2640 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2646 =item paydate_monthyear
2648 Returns a two-element list consisting of the month and year of this customer's
2649 paydate (credit card expiration date for CARD customers)
2653 sub paydate_monthyear {
2655 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2657 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2666 Returns the exact time in seconds corresponding to the payment method
2667 expiration date. For CARD/DCRD customers this is the end of the month;
2668 for others (COMP is the only other payby that uses paydate) it's the start.
2669 Returns 0 if the paydate is empty or set to the far future.
2675 my ($month, $year) = $self->paydate_monthyear;
2676 return 0 if !$year or $year >= 2037;
2677 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2679 if ( $month == 13 ) {
2683 return timelocal(0,0,0,1,$month-1,$year) - 1;
2686 return timelocal(0,0,0,1,$month-1,$year);
2690 =item paydate_epoch_sql
2692 Class method. Returns an SQL expression to obtain the payment expiration date
2693 as a number of seconds.
2697 # Special expiration date behavior for non-CARD/DCRD customers has been
2698 # carefully preserved. Do we really use that?
2699 sub paydate_epoch_sql {
2701 my $table = shift || 'cust_main';
2702 my ($case1, $case2);
2703 if ( driver_name eq 'Pg' ) {
2704 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
2705 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
2707 elsif ( lc(driver_name) eq 'mysql' ) {
2708 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
2709 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
2712 return "CASE WHEN $table.payby IN('CARD','DCRD')
2718 =item tax_exemption TAXNAME
2723 my( $self, $taxname ) = @_;
2725 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2726 'taxname' => $taxname,
2731 =item cust_main_exemption
2733 =item invoicing_list [ ARRAYREF ]
2735 If an arguement is given, sets these email addresses as invoice recipients
2736 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2737 (except as warnings), so use check_invoicing_list first.
2739 Returns a list of email addresses (with svcnum entries expanded).
2741 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2742 check it without disturbing anything by passing nothing.
2744 This interface may change in the future.
2748 sub invoicing_list {
2749 my( $self, $arrayref ) = @_;
2752 my @cust_main_invoice;
2753 if ( $self->custnum ) {
2754 @cust_main_invoice =
2755 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2757 @cust_main_invoice = ();
2759 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2760 #warn $cust_main_invoice->destnum;
2761 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2762 #warn $cust_main_invoice->destnum;
2763 my $error = $cust_main_invoice->delete;
2764 warn $error if $error;
2767 if ( $self->custnum ) {
2768 @cust_main_invoice =
2769 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2771 @cust_main_invoice = ();
2773 my %seen = map { $_->address => 1 } @cust_main_invoice;
2774 foreach my $address ( @{$arrayref} ) {
2775 next if exists $seen{$address} && $seen{$address};
2776 $seen{$address} = 1;
2777 my $cust_main_invoice = new FS::cust_main_invoice ( {
2778 'custnum' => $self->custnum,
2781 my $error = $cust_main_invoice->insert;
2782 warn $error if $error;
2786 if ( $self->custnum ) {
2788 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2795 =item check_invoicing_list ARRAYREF
2797 Checks these arguements as valid input for the invoicing_list method. If there
2798 is an error, returns the error, otherwise returns false.
2802 sub check_invoicing_list {
2803 my( $self, $arrayref ) = @_;
2805 foreach my $address ( @$arrayref ) {
2807 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2808 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2811 my $cust_main_invoice = new FS::cust_main_invoice ( {
2812 'custnum' => $self->custnum,
2815 my $error = $self->custnum
2816 ? $cust_main_invoice->check
2817 : $cust_main_invoice->checkdest
2819 return $error if $error;
2823 return "Email address required"
2824 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
2825 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2830 =item set_default_invoicing_list
2832 Sets the invoicing list to all accounts associated with this customer,
2833 overwriting any previous invoicing list.
2837 sub set_default_invoicing_list {
2839 $self->invoicing_list($self->all_emails);
2844 Returns the email addresses of all accounts provisioned for this customer.
2851 foreach my $cust_pkg ( $self->all_pkgs ) {
2852 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2854 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2855 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2857 $list{$_}=1 foreach map { $_->email } @svc_acct;
2862 =item invoicing_list_addpost
2864 Adds postal invoicing to this customer. If this customer is already configured
2865 to receive postal invoices, does nothing.
2869 sub invoicing_list_addpost {
2871 return if grep { $_ eq 'POST' } $self->invoicing_list;
2872 my @invoicing_list = $self->invoicing_list;
2873 push @invoicing_list, 'POST';
2874 $self->invoicing_list(\@invoicing_list);
2877 =item invoicing_list_emailonly
2879 Returns the list of email invoice recipients (invoicing_list without non-email
2880 destinations such as POST and FAX).
2884 sub invoicing_list_emailonly {
2886 warn "$me invoicing_list_emailonly called"
2888 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
2891 =item invoicing_list_emailonly_scalar
2893 Returns the list of email invoice recipients (invoicing_list without non-email
2894 destinations such as POST and FAX) as a comma-separated scalar.
2898 sub invoicing_list_emailonly_scalar {
2900 warn "$me invoicing_list_emailonly_scalar called"
2902 join(', ', $self->invoicing_list_emailonly);
2905 =item referral_custnum_cust_main
2907 Returns the customer who referred this customer (or the empty string, if
2908 this customer was not referred).
2910 Note the difference with referral_cust_main method: This method,
2911 referral_custnum_cust_main returns the single customer (if any) who referred
2912 this customer, while referral_cust_main returns an array of customers referred
2917 sub referral_custnum_cust_main {
2919 return '' unless $self->referral_custnum;
2920 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2923 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2925 Returns an array of customers referred by this customer (referral_custnum set
2926 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2927 customers referred by customers referred by this customer and so on, inclusive.
2928 The default behavior is DEPTH 1 (no recursion).
2930 Note the difference with referral_custnum_cust_main method: This method,
2931 referral_cust_main, returns an array of customers referred BY this customer,
2932 while referral_custnum_cust_main returns the single customer (if any) who
2933 referred this customer.
2937 sub referral_cust_main {
2939 my $depth = @_ ? shift : 1;
2940 my $exclude = @_ ? shift : {};
2943 map { $exclude->{$_->custnum}++; $_; }
2944 grep { ! $exclude->{ $_->custnum } }
2945 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2949 map { $_->referral_cust_main($depth-1, $exclude) }
2956 =item referral_cust_main_ncancelled
2958 Same as referral_cust_main, except only returns customers with uncancelled
2963 sub referral_cust_main_ncancelled {
2965 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2968 =item referral_cust_pkg [ DEPTH ]
2970 Like referral_cust_main, except returns a flat list of all unsuspended (and
2971 uncancelled) packages for each customer. The number of items in this list may
2972 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2976 sub referral_cust_pkg {
2978 my $depth = @_ ? shift : 1;
2980 map { $_->unsuspended_pkgs }
2981 grep { $_->unsuspended_pkgs }
2982 $self->referral_cust_main($depth);
2985 =item referring_cust_main
2987 Returns the single cust_main record for the customer who referred this customer
2988 (referral_custnum), or false.
2992 sub referring_cust_main {
2994 return '' unless $self->referral_custnum;
2995 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2998 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3000 Applies a credit to this customer. If there is an error, returns the error,
3001 otherwise returns false.
3003 REASON can be a text string, an FS::reason object, or a scalar reference to
3004 a reasonnum. If a text string, it will be automatically inserted as a new
3005 reason, and a 'reason_type' option must be passed to indicate the
3006 FS::reason_type for the new reason.
3008 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3009 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3010 I<commission_pkgnum>.
3012 Any other options are passed to FS::cust_credit::insert.
3017 my( $self, $amount, $reason, %options ) = @_;
3019 my $cust_credit = new FS::cust_credit {
3020 'custnum' => $self->custnum,
3021 'amount' => $amount,
3024 if ( ref($reason) ) {
3026 if ( ref($reason) eq 'SCALAR' ) {
3027 $cust_credit->reasonnum( $$reason );
3029 $cust_credit->reasonnum( $reason->reasonnum );
3033 $cust_credit->set('reason', $reason)
3036 $cust_credit->$_( delete $options{$_} )
3037 foreach grep exists($options{$_}),
3038 qw( addlinfo eventnum ),
3039 map "commission_$_", qw( agentnum salesnum pkgnum );
3041 $cust_credit->insert(%options);
3045 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3047 Creates a one-time charge for this customer. If there is an error, returns
3048 the error, otherwise returns false.
3050 New-style, with a hashref of options:
3052 my $error = $cust_main->charge(
3056 'start_date' => str2time('7/4/2009'),
3057 'pkg' => 'Description',
3058 'comment' => 'Comment',
3059 'additional' => [], #extra invoice detail
3060 'classnum' => 1, #pkg_class
3062 'setuptax' => '', # or 'Y' for tax exempt
3064 'locationnum'=> 1234, # optional
3067 'taxclass' => 'Tax class',
3070 'taxproduct' => 2, #part_pkg_taxproduct
3071 'override' => {}, #XXX describe
3073 #will be filled in with the new object
3074 'cust_pkg_ref' => \$cust_pkg,
3076 #generate an invoice immediately
3078 'invoice_terms' => '', #with these terms
3084 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3088 #super false laziness w/quotation::charge
3091 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3092 my ( $pkg, $comment, $additional );
3093 my ( $setuptax, $taxclass ); #internal taxes
3094 my ( $taxproduct, $override ); #vendor (CCH) taxes
3096 my $cust_pkg_ref = '';
3097 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3099 if ( ref( $_[0] ) ) {
3100 $amount = $_[0]->{amount};
3101 $setup_cost = $_[0]->{setup_cost};
3102 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3103 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3104 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3105 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3106 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3107 : '$'. sprintf("%.2f",$amount);
3108 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3109 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3110 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3111 $additional = $_[0]->{additional} || [];
3112 $taxproduct = $_[0]->{taxproductnum};
3113 $override = { '' => $_[0]->{tax_override} };
3114 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3115 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3116 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3117 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3123 $pkg = @_ ? shift : 'One-time charge';
3124 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3126 $taxclass = @_ ? shift : '';
3130 local $SIG{HUP} = 'IGNORE';
3131 local $SIG{INT} = 'IGNORE';
3132 local $SIG{QUIT} = 'IGNORE';
3133 local $SIG{TERM} = 'IGNORE';
3134 local $SIG{TSTP} = 'IGNORE';
3135 local $SIG{PIPE} = 'IGNORE';
3137 my $oldAutoCommit = $FS::UID::AutoCommit;
3138 local $FS::UID::AutoCommit = 0;
3141 my $part_pkg = new FS::part_pkg ( {
3143 'comment' => $comment,
3147 'classnum' => ( $classnum ? $classnum : '' ),
3148 'setuptax' => $setuptax,
3149 'taxclass' => $taxclass,
3150 'taxproductnum' => $taxproduct,
3151 'setup_cost' => $setup_cost,
3154 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3155 ( 0 .. @$additional - 1 )
3157 'additional_count' => scalar(@$additional),
3158 'setup_fee' => $amount,
3161 my $error = $part_pkg->insert( options => \%options,
3162 tax_overrides => $override,
3165 $dbh->rollback if $oldAutoCommit;
3169 my $pkgpart = $part_pkg->pkgpart;
3170 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3171 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3172 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3173 $error = $type_pkgs->insert;
3175 $dbh->rollback if $oldAutoCommit;
3180 my $cust_pkg = new FS::cust_pkg ( {
3181 'custnum' => $self->custnum,
3182 'pkgpart' => $pkgpart,
3183 'quantity' => $quantity,
3184 'start_date' => $start_date,
3185 'no_auto' => $no_auto,
3186 'locationnum'=> $locationnum,
3189 $error = $cust_pkg->insert;
3191 $dbh->rollback if $oldAutoCommit;
3193 } elsif ( $cust_pkg_ref ) {
3194 ${$cust_pkg_ref} = $cust_pkg;
3198 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3199 'pkg_list' => [ $cust_pkg ],
3202 $dbh->rollback if $oldAutoCommit;
3207 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3212 #=item charge_postal_fee
3214 #Applies a one time charge this customer. If there is an error,
3215 #returns the error, returns the cust_pkg charge object or false
3216 #if there was no charge.
3220 # This should be a customer event. For that to work requires that bill
3221 # also be a customer event.
3223 sub charge_postal_fee {
3226 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3227 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3229 my $cust_pkg = new FS::cust_pkg ( {
3230 'custnum' => $self->custnum,
3231 'pkgpart' => $pkgpart,
3235 my $error = $cust_pkg->insert;
3236 $error ? $error : $cust_pkg;
3239 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3241 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3243 Optionally, a list or hashref of additional arguments to the qsearch call can
3250 my $opt = ref($_[0]) ? shift : { @_ };
3252 #return $self->num_cust_bill unless wantarray || keys %$opt;
3254 $opt->{'table'} = 'cust_bill';
3255 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3256 $opt->{'hashref'}{'custnum'} = $self->custnum;
3257 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3259 map { $_ } #behavior of sort undefined in scalar context
3260 sort { $a->_date <=> $b->_date }
3264 =item open_cust_bill
3266 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3271 sub open_cust_bill {
3275 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3281 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3283 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3287 sub legacy_cust_bill {
3290 #return $self->num_legacy_cust_bill unless wantarray;
3292 map { $_ } #behavior of sort undefined in scalar context
3293 sort { $a->_date <=> $b->_date }
3294 qsearch({ 'table' => 'legacy_cust_bill',
3295 'hashref' => { 'custnum' => $self->custnum, },
3296 'order_by' => 'ORDER BY _date ASC',
3300 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3302 Returns all the statements (see L<FS::cust_statement>) for this customer.
3304 Optionally, a list or hashref of additional arguments to the qsearch call can
3309 =item cust_bill_void
3311 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3315 sub cust_bill_void {
3318 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3319 sort { $a->_date <=> $b->_date }
3320 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3323 sub cust_statement {
3325 my $opt = ref($_[0]) ? shift : { @_ };
3327 #return $self->num_cust_statement unless wantarray || keys %$opt;
3329 $opt->{'table'} = 'cust_statement';
3330 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3331 $opt->{'hashref'}{'custnum'} = $self->custnum;
3332 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3334 map { $_ } #behavior of sort undefined in scalar context
3335 sort { $a->_date <=> $b->_date }
3339 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3341 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3343 Optionally, a list or hashref of additional arguments to the qsearch call can
3344 be passed following the SVCDB.
3351 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3352 warn "$me svc_x requires a svcdb";
3355 my $opt = ref($_[0]) ? shift : { @_ };
3357 $opt->{'table'} = $svcdb;
3358 $opt->{'addl_from'} =
3359 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3360 ($opt->{'addl_from'} || '');
3362 my $custnum = $self->custnum;
3363 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3364 my $where = "cust_pkg.custnum = $custnum";
3366 my $extra_sql = $opt->{'extra_sql'} || '';
3367 if ( keys %{ $opt->{'hashref'} } ) {
3368 $extra_sql = " AND $where $extra_sql";
3371 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3372 $extra_sql = "WHERE $where AND $1";
3375 $extra_sql = "WHERE $where $extra_sql";
3378 $opt->{'extra_sql'} = $extra_sql;
3383 # required for use as an eventtable;
3386 $self->svc_x('svc_acct', @_);
3391 Returns all the credits (see L<FS::cust_credit>) for this customer.
3397 map { $_ } #return $self->num_cust_credit unless wantarray;
3398 sort { $a->_date <=> $b->_date }
3399 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3402 =item cust_credit_pkgnum
3404 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3405 package when using experimental package balances.
3409 sub cust_credit_pkgnum {
3410 my( $self, $pkgnum ) = @_;
3411 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3412 sort { $a->_date <=> $b->_date }
3413 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3414 'pkgnum' => $pkgnum,
3419 =item cust_credit_void
3421 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3425 sub cust_credit_void {
3428 sort { $a->_date <=> $b->_date }
3429 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3434 Returns all the payments (see L<FS::cust_pay>) for this customer.
3440 my $opt = ref($_[0]) ? shift : { @_ };
3442 return $self->num_cust_pay unless wantarray || keys %$opt;
3444 $opt->{'table'} = 'cust_pay';
3445 $opt->{'hashref'}{'custnum'} = $self->custnum;
3447 map { $_ } #behavior of sort undefined in scalar context
3448 sort { $a->_date <=> $b->_date }
3455 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3456 called automatically when the cust_pay method is used in a scalar context.
3462 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3463 my $sth = dbh->prepare($sql) or die dbh->errstr;
3464 $sth->execute($self->custnum) or die $sth->errstr;
3465 $sth->fetchrow_arrayref->[0];
3468 =item unapplied_cust_pay
3470 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3474 sub unapplied_cust_pay {
3478 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3484 =item cust_pay_pkgnum
3486 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3487 package when using experimental package balances.
3491 sub cust_pay_pkgnum {
3492 my( $self, $pkgnum ) = @_;
3493 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3494 sort { $a->_date <=> $b->_date }
3495 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3496 'pkgnum' => $pkgnum,
3503 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3509 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3510 sort { $a->_date <=> $b->_date }
3511 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3514 =item cust_pay_pending
3516 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3517 (without status "done").
3521 sub cust_pay_pending {
3523 return $self->num_cust_pay_pending unless wantarray;
3524 sort { $a->_date <=> $b->_date }
3525 qsearch( 'cust_pay_pending', {
3526 'custnum' => $self->custnum,
3527 'status' => { op=>'!=', value=>'done' },
3532 =item cust_pay_pending_attempt
3534 Returns all payment attempts / declined payments for this customer, as pending
3535 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3536 a corresponding payment (see L<FS::cust_pay>).
3540 sub cust_pay_pending_attempt {
3542 return $self->num_cust_pay_pending_attempt unless wantarray;
3543 sort { $a->_date <=> $b->_date }
3544 qsearch( 'cust_pay_pending', {
3545 'custnum' => $self->custnum,
3552 =item num_cust_pay_pending
3554 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3555 customer (without status "done"). Also called automatically when the
3556 cust_pay_pending method is used in a scalar context.
3560 sub num_cust_pay_pending {
3563 " SELECT COUNT(*) FROM cust_pay_pending ".
3564 " WHERE custnum = ? AND status != 'done' ",
3569 =item num_cust_pay_pending_attempt
3571 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3572 customer, with status "done" but without a corresp. Also called automatically when the
3573 cust_pay_pending method is used in a scalar context.
3577 sub num_cust_pay_pending_attempt {
3580 " SELECT COUNT(*) FROM cust_pay_pending ".
3581 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3588 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3594 map { $_ } #return $self->num_cust_refund unless wantarray;
3595 sort { $a->_date <=> $b->_date }
3596 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3599 =item display_custnum
3601 Returns the displayed customer number for this customer: agent_custid if
3602 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3606 sub display_custnum {
3609 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3610 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3611 if ( $special eq 'CoStAg' ) {
3612 $prefix = uc( join('',
3614 ($self->state =~ /^(..)/),
3615 $prefix || ($self->agent->agent =~ /^(..)/)
3618 elsif ( $special eq 'CoStCl' ) {
3619 $prefix = uc( join('',
3621 ($self->state =~ /^(..)/),
3622 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3625 # add any others here if needed
3628 my $length = $conf->config('cust_main-custnum-display_length');
3629 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3630 return $self->agent_custid;
3631 } elsif ( $prefix ) {
3632 $length = 8 if !defined($length);
3634 sprintf('%0'.$length.'d', $self->custnum)
3635 } elsif ( $length ) {
3636 return sprintf('%0'.$length.'d', $self->custnum);
3638 return $self->custnum;
3644 Returns a name string for this customer, either "Company (Last, First)" or
3651 my $name = $self->contact;
3652 $name = $self->company. " ($name)" if $self->company;
3656 =item service_contact
3658 Returns the L<FS::contact> object for this customer that has the 'Service'
3659 contact class, or undef if there is no such contact. Deprecated; don't use
3664 sub service_contact {
3666 if ( !exists($self->{service_contact}) ) {
3667 my $classnum = $self->scalar_sql(
3668 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3669 ) || 0; #if it's zero, qsearchs will return nothing
3670 my $cust_contact = qsearchs('cust_contact', {
3671 'classnum' => $classnum,
3672 'custnum' => $self->custnum,
3674 $self->{service_contact} = $cust_contact->contact if $cust_contact;
3676 $self->{service_contact};
3681 Returns a name string for this (service/shipping) contact, either
3682 "Company (Last, First)" or "Last, First".
3689 my $name = $self->ship_contact;
3690 $name = $self->company. " ($name)" if $self->company;
3696 Returns a name string for this customer, either "Company" or "First Last".
3702 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3705 =item ship_name_short
3707 Returns a name string for this (service/shipping) contact, either "Company"
3712 sub ship_name_short {
3714 $self->service_contact
3715 ? $self->ship_contact_firstlast
3721 Returns this customer's full (billing) contact name only, "Last, First"
3727 $self->get('last'). ', '. $self->first;
3732 Returns this customer's full (shipping) contact name only, "Last, First"
3738 my $contact = $self->service_contact || $self;
3739 $contact->get('last') . ', ' . $contact->get('first');
3742 =item contact_firstlast
3744 Returns this customers full (billing) contact name only, "First Last".
3748 sub contact_firstlast {
3750 $self->first. ' '. $self->get('last');
3753 =item ship_contact_firstlast
3755 Returns this customer's full (shipping) contact name only, "First Last".
3759 sub ship_contact_firstlast {
3761 my $contact = $self->service_contact || $self;
3762 $contact->get('first') . ' '. $contact->get('last');
3765 #XXX this doesn't work in 3.x+
3768 #Returns this customer's full country name
3774 # code2country($self->country);
3777 sub bill_country_full {
3779 code2country($self->bill_location->country);
3782 sub ship_country_full {
3784 code2country($self->ship_location->country);
3787 =item county_state_county [ PREFIX ]
3789 Returns a string consisting of just the county, state and country.
3793 sub county_state_country {
3796 if ( @_ && $_[0] && $self->has_ship_address ) {
3797 $locationnum = $self->ship_locationnum;
3799 $locationnum = $self->bill_locationnum;
3801 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
3802 $cust_location->county_state_country;
3805 =item geocode DATA_VENDOR
3807 Returns a value for the customer location as encoded by DATA_VENDOR.
3808 Currently this only makes sense for "CCH" as DATA_VENDOR.
3816 Returns a status string for this customer, currently:
3822 No packages have ever been ordered. Displayed as "No packages".
3826 Recurring packages all are new (not yet billed).
3830 One or more recurring packages is active.
3834 No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled).
3838 All non-cancelled recurring packages are suspended.
3842 All recurring packages are cancelled.
3846 Behavior of inactive vs. cancelled edge cases can be adjusted with the
3847 cust_main-status_module configuration option.
3851 sub status { shift->cust_status(@_); }
3855 for my $status ( FS::cust_main->statuses() ) {
3856 my $method = $status.'_sql';
3857 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3858 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3859 $sth->execute( ($self->custnum) x $numnum )
3860 or die "Error executing 'SELECT $sql': ". $sth->errstr;
3861 return $status if $sth->fetchrow_arrayref->[0];
3865 =item ucfirst_cust_status
3867 =item ucfirst_status
3869 Deprecated, use the cust_status_label method instead.
3871 Returns the status with the first character capitalized.
3875 sub ucfirst_status {
3876 carp "ucfirst_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3877 local($ucfirst_nowarn) = 1;
3878 shift->ucfirst_cust_status(@_);
3881 sub ucfirst_cust_status {
3882 carp "ucfirst_cust_status deprecated, use cust_status_label" unless $ucfirst_nowarn;
3884 ucfirst($self->cust_status);
3887 =item cust_status_label
3891 Returns the display label for this status.
3895 sub status_label { shift->cust_status_label(@_); }
3897 sub cust_status_label {
3899 __PACKAGE__->statuslabels->{$self->cust_status};
3904 Returns a hex triplet color string for this customer's status.
3908 sub statuscolor { shift->cust_statuscolor(@_); }
3910 sub cust_statuscolor {
3912 __PACKAGE__->statuscolors->{$self->cust_status};
3915 =item tickets [ STATUS ]
3917 Returns an array of hashes representing the customer's RT tickets.
3919 An optional status (or arrayref or hashref of statuses) may be specified.
3925 my $status = ( @_ && $_[0] ) ? shift : '';
3927 my $num = $conf->config('cust_main-max_tickets') || 10;
3930 if ( $conf->config('ticket_system') ) {
3931 unless ( $conf->config('ticket_system-custom_priority_field') ) {
3933 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
3942 foreach my $priority (
3943 $conf->config('ticket_system-custom_priority_field-values'), ''
3945 last if scalar(@tickets) >= $num;
3947 @{ FS::TicketSystem->customer_tickets( $self->custnum,
3948 $num - scalar(@tickets),
3959 # Return services representing svc_accts in customer support packages
3960 sub support_services {
3962 my %packages = map { $_ => 1 } $conf->config('support_packages');
3964 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
3965 grep { $_->part_svc->svcdb eq 'svc_acct' }
3966 map { $_->cust_svc }
3967 grep { exists $packages{ $_->pkgpart } }
3968 $self->ncancelled_pkgs;
3972 # Return a list of latitude/longitude for one of the services (if any)
3973 sub service_coordinates {
3977 grep { $_->latitude && $_->longitude }
3979 map { $_->cust_svc }
3980 $self->ncancelled_pkgs;
3982 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
3987 Returns a masked version of the named field
3992 my ($self,$field) = @_;
3996 'x'x(length($self->getfield($field))-4).
3997 substr($self->getfield($field), (length($self->getfield($field))-4));
4003 =head1 CLASS METHODS
4009 Class method that returns the list of possible status strings for customers
4010 (see L<the status method|/status>). For example:
4012 @statuses = FS::cust_main->statuses();
4018 keys %{ $self->statuscolors };
4021 =item cust_status_sql
4023 Returns an SQL fragment to determine the status of a cust_main record, as a
4028 sub cust_status_sql {
4030 for my $status ( FS::cust_main->statuses() ) {
4031 my $method = $status.'_sql';
4032 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4041 Returns an SQL expression identifying prospective cust_main records (customers
4042 with no packages ever ordered)
4046 use vars qw($select_count_pkgs);
4047 $select_count_pkgs =
4048 "SELECT COUNT(*) FROM cust_pkg
4049 WHERE cust_pkg.custnum = cust_main.custnum";
4051 sub select_count_pkgs_sql {
4056 " 0 = ( $select_count_pkgs ) ";
4061 Returns an SQL expression identifying ordered cust_main records (customers with
4062 no active packages, but recurring packages not yet setup or one time charges
4068 FS::cust_main->none_active_sql.
4069 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4074 Returns an SQL expression identifying active cust_main records (customers with
4075 active recurring packages).
4080 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4083 =item none_active_sql
4085 Returns an SQL expression identifying cust_main records with no active
4086 recurring packages. This includes customers of status prospect, ordered,
4087 inactive, and suspended.
4091 sub none_active_sql {
4092 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4097 Returns an SQL expression identifying inactive cust_main records (customers with
4098 no active recurring packages, but otherwise unsuspended/uncancelled).
4103 FS::cust_main->none_active_sql.
4104 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4110 Returns an SQL expression identifying suspended cust_main records.
4115 sub suspended_sql { susp_sql(@_); }
4117 FS::cust_main->none_active_sql.
4118 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4124 Returns an SQL expression identifying cancelled cust_main records.
4128 sub cancel_sql { shift->cancelled_sql(@_); }
4131 =item uncancelled_sql
4133 Returns an SQL expression identifying un-cancelled cust_main records.
4137 sub uncancelled_sql { uncancel_sql(@_); }
4138 sub uncancel_sql { "
4139 ( 0 < ( $select_count_pkgs
4140 AND ( cust_pkg.cancel IS NULL
4141 OR cust_pkg.cancel = 0
4144 OR 0 = ( $select_count_pkgs )
4150 Returns an SQL fragment to retreive the balance.
4155 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4156 WHERE cust_bill.custnum = cust_main.custnum )
4157 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4158 WHERE cust_pay.custnum = cust_main.custnum )
4159 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4160 WHERE cust_credit.custnum = cust_main.custnum )
4161 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4162 WHERE cust_refund.custnum = cust_main.custnum )
4165 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4167 Returns an SQL fragment to retreive the balance for this customer, optionally
4168 considering invoices with date earlier than START_TIME, and not
4169 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4170 total_unapplied_payments).
4172 Times are specified as SQL fragments or numeric
4173 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4174 L<Date::Parse> for conversion functions. The empty string can be passed
4175 to disable that time constraint completely.
4177 Available options are:
4181 =item unapplied_date
4183 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)
4188 set to true to remove all customer comparison clauses, for totals
4193 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4198 JOIN clause (typically used with the total option)
4202 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4203 time will be ignored. Note that START_TIME and END_TIME only limit the date
4204 range for invoices and I<unapplied> payments, credits, and refunds.
4210 sub balance_date_sql {
4211 my( $class, $start, $end, %opt ) = @_;
4213 my $cutoff = $opt{'cutoff'};
4215 my $owed = FS::cust_bill->owed_sql($cutoff);
4216 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4217 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4218 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4220 my $j = $opt{'join'} || '';
4222 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4223 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4224 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4225 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4227 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4228 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4229 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4230 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4235 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4237 Returns an SQL fragment to retreive the total unapplied payments for this
4238 customer, only considering payments with date earlier than START_TIME, and
4239 optionally not later than END_TIME.
4241 Times are specified as SQL fragments or numeric
4242 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4243 L<Date::Parse> for conversion functions. The empty string can be passed
4244 to disable that time constraint completely.
4246 Available options are:
4250 sub unapplied_payments_date_sql {
4251 my( $class, $start, $end, %opt ) = @_;
4253 my $cutoff = $opt{'cutoff'};
4255 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4257 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4258 'unapplied_date'=>1 );
4260 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4263 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4265 Helper method for balance_date_sql; name (and usage) subject to change
4266 (suggestions welcome).
4268 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4269 cust_refund, cust_credit or cust_pay).
4271 If TABLE is "cust_bill" or the unapplied_date option is true, only
4272 considers records with date earlier than START_TIME, and optionally not
4273 later than END_TIME .
4277 sub _money_table_where {
4278 my( $class, $table, $start, $end, %opt ) = @_;
4281 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4282 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4283 push @where, "$table._date <= $start" if defined($start) && length($start);
4284 push @where, "$table._date > $end" if defined($end) && length($end);
4286 push @where, @{$opt{'where'}} if $opt{'where'};
4287 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4293 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4294 use FS::cust_main::Search;
4297 FS::cust_main::Search->search(@_);
4306 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4308 Deprecated. Use event notification and message templates
4309 (L<FS::msg_template>) instead.
4311 Sends a templated email notification to the customer (see L<Text::Template>).
4313 OPTIONS is a hash and may include
4315 I<from> - the email sender (default is invoice_from)
4317 I<to> - comma-separated scalar or arrayref of recipients
4318 (default is invoicing_list)
4320 I<subject> - The subject line of the sent email notification
4321 (default is "Notice from company_name")
4323 I<extra_fields> - a hashref of name/value pairs which will be substituted
4326 The following variables are vavailable in the template.
4328 I<$first> - the customer first name
4329 I<$last> - the customer last name
4330 I<$company> - the customer company
4331 I<$payby> - a description of the method of payment for the customer
4332 # would be nice to use FS::payby::shortname
4333 I<$payinfo> - the account information used to collect for this customer
4334 I<$expdate> - the expiration of the customer payment in seconds from epoch
4339 my ($self, $template, %options) = @_;
4341 return unless $conf->exists($template);
4343 my $from = $conf->invoice_from_full($self->agentnum)
4344 if $conf->exists('invoice_from', $self->agentnum);
4345 $from = $options{from} if exists($options{from});
4347 my $to = join(',', $self->invoicing_list_emailonly);
4348 $to = $options{to} if exists($options{to});
4350 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4351 if $conf->exists('company_name', $self->agentnum);
4352 $subject = $options{subject} if exists($options{subject});
4354 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4355 SOURCE => [ map "$_\n",
4356 $conf->config($template)]
4358 or die "can't create new Text::Template object: Text::Template::ERROR";
4359 $notify_template->compile()
4360 or die "can't compile template: Text::Template::ERROR";
4362 $FS::notify_template::_template::company_name =
4363 $conf->config('company_name', $self->agentnum);
4364 $FS::notify_template::_template::company_address =
4365 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4367 my $paydate = $self->paydate || '2037-12-31';
4368 $FS::notify_template::_template::first = $self->first;
4369 $FS::notify_template::_template::last = $self->last;
4370 $FS::notify_template::_template::company = $self->company;
4371 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4372 my $payby = $self->payby;
4373 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4374 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4376 #credit cards expire at the end of the month/year of their exp date
4377 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4378 $FS::notify_template::_template::payby = 'credit card';
4379 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4380 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4382 }elsif ($payby eq 'COMP') {
4383 $FS::notify_template::_template::payby = 'complimentary account';
4385 $FS::notify_template::_template::payby = 'current method';
4387 $FS::notify_template::_template::expdate = $expire_time;
4389 for (keys %{$options{extra_fields}}){
4391 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4394 send_email(from => $from,
4396 subject => $subject,
4397 body => $notify_template->fill_in( PACKAGE =>
4398 'FS::notify_template::_template' ),
4403 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4405 Generates a templated notification to the customer (see L<Text::Template>).
4407 OPTIONS is a hash and may include
4409 I<extra_fields> - a hashref of name/value pairs which will be substituted
4410 into the template. These values may override values mentioned below
4411 and those from the customer record.
4413 The following variables are available in the template instead of or in addition
4414 to the fields of the customer record.
4416 I<$payby> - a description of the method of payment for the customer
4417 # would be nice to use FS::payby::shortname
4418 I<$payinfo> - the masked account information used to collect for this customer
4419 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4420 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4424 # a lot like cust_bill::print_latex
4425 sub generate_letter {
4426 my ($self, $template, %options) = @_;
4428 return unless $conf->exists($template);
4430 my $letter_template = new Text::Template
4432 SOURCE => [ map "$_\n", $conf->config($template)],
4433 DELIMITERS => [ '[@--', '--@]' ],
4435 or die "can't create new Text::Template object: Text::Template::ERROR";
4437 $letter_template->compile()
4438 or die "can't compile template: Text::Template::ERROR";
4440 my %letter_data = map { $_ => $self->$_ } $self->fields;
4441 $letter_data{payinfo} = $self->mask_payinfo;
4443 #my $paydate = $self->paydate || '2037-12-31';
4444 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4446 my $payby = $self->payby;
4447 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4448 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4450 #credit cards expire at the end of the month/year of their exp date
4451 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4452 $letter_data{payby} = 'credit card';
4453 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4454 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4456 }elsif ($payby eq 'COMP') {
4457 $letter_data{payby} = 'complimentary account';
4459 $letter_data{payby} = 'current method';
4461 $letter_data{expdate} = $expire_time;
4463 for (keys %{$options{extra_fields}}){
4464 $letter_data{$_} = $options{extra_fields}->{$_};
4467 unless(exists($letter_data{returnaddress})){
4468 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4469 $self->agent_template)
4471 if ( length($retadd) ) {
4472 $letter_data{returnaddress} = $retadd;
4473 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4474 $letter_data{returnaddress} =
4475 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4479 ( $conf->config('company_name', $self->agentnum),
4480 $conf->config('company_address', $self->agentnum),
4484 $letter_data{returnaddress} = '~';
4488 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4490 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4492 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4494 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4498 ) or die "can't open temp file: $!\n";
4499 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4500 or die "can't write temp file: $!\n";
4502 $letter_data{'logo_file'} = $lh->filename;
4504 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4508 ) or die "can't open temp file: $!\n";
4510 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4512 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4513 return ($1, $letter_data{'logo_file'});
4517 =item print_ps TEMPLATE
4519 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4525 my($file, $lfile) = $self->generate_letter(@_);
4526 my $ps = FS::Misc::generate_ps($file);
4527 unlink($file.'.tex');
4533 =item print TEMPLATE
4535 Prints the filled in template.
4537 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4541 sub queueable_print {
4544 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4545 or die "invalid customer number: " . $opt{custnum};
4547 my $error = $self->print( { 'template' => $opt{template} } );
4548 die $error if $error;
4552 my ($self, $template) = (shift, shift);
4554 [ $self->print_ps($template) ],
4555 'agentnum' => $self->agentnum,
4559 #these three subs should just go away once agent stuff is all config overrides
4561 sub agent_template {
4563 $self->_agent_plandata('agent_templatename');
4566 sub agent_invoice_from {
4568 $self->_agent_plandata('agent_invoice_from');
4571 sub _agent_plandata {
4572 my( $self, $option ) = @_;
4574 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4575 #agent-specific Conf
4577 use FS::part_event::Condition;
4579 my $agentnum = $self->agentnum;
4581 my $regexp = regexp_sql();
4583 my $part_event_option =
4585 'select' => 'part_event_option.*',
4586 'table' => 'part_event_option',
4588 LEFT JOIN part_event USING ( eventpart )
4589 LEFT JOIN part_event_option AS peo_agentnum
4590 ON ( part_event.eventpart = peo_agentnum.eventpart
4591 AND peo_agentnum.optionname = 'agentnum'
4592 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4594 LEFT JOIN part_event_condition
4595 ON ( part_event.eventpart = part_event_condition.eventpart
4596 AND part_event_condition.conditionname = 'cust_bill_age'
4598 LEFT JOIN part_event_condition_option
4599 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4600 AND part_event_condition_option.optionname = 'age'
4603 #'hashref' => { 'optionname' => $option },
4604 #'hashref' => { 'part_event_option.optionname' => $option },
4606 " WHERE part_event_option.optionname = ". dbh->quote($option).
4607 " AND action = 'cust_bill_send_agent' ".
4608 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4609 " AND peo_agentnum.optionname = 'agentnum' ".
4610 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4612 CASE WHEN part_event_condition_option.optionname IS NULL
4614 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4616 , part_event.weight".
4620 unless ( $part_event_option ) {
4621 return $self->agent->invoice_template || ''
4622 if $option eq 'agent_templatename';
4626 $part_event_option->optionvalue;
4630 sub process_o2m_qsearch {
4633 return qsearch($table, @_) unless $table eq 'contact';
4635 my $hashref = shift;
4636 my %hash = %$hashref;
4637 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4638 or die 'guru meditation #4343';
4640 qsearch({ 'table' => 'contact',
4641 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4642 'hashref' => \%hash,
4643 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4644 " cust_contact.custnum = $custnum "
4648 sub process_o2m_qsearchs {
4651 return qsearchs($table, @_) unless $table eq 'contact';
4653 my $hashref = shift;
4654 my %hash = %$hashref;
4655 ( my $custnum = delete $hash{'custnum'} ) =~ /^(\d+)$/
4656 or die 'guru meditation #2121';
4658 qsearchs({ 'table' => 'contact',
4659 'addl_from' => 'LEFT JOIN cust_contact USING ( contactnum )',
4660 'hashref' => \%hash,
4661 'extra_sql' => ( keys %hash ? ' AND ' : ' WHERE ' ).
4662 " cust_contact.custnum = $custnum "
4666 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4668 Subroutine (not a method), designed to be called from the queue.
4670 Takes a list of options and values.
4672 Pulls up the customer record via the custnum option and calls bill_and_collect.
4677 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4679 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4680 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4682 #without this errors don't get rolled back
4683 $args{'fatal'} = 1; # runs from job queue, will be caught
4685 $cust_main->bill_and_collect( %args );
4688 =item queued_collect 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4690 Like queued_bill, but instead of C<bill_and_collect>, just runs the
4691 C<collect> part. This is used in batch tax calculation, where invoice
4692 generation and collection events have to be completely separated.
4696 sub queued_collect {
4698 my $cust_main = FS::cust_main->by_key($args{'custnum'});
4700 $cust_main->collect(%args);
4703 sub process_bill_and_collect {
4706 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4707 or die "custnum '$param->{custnum}' not found!\n";
4708 $param->{'job'} = $job;
4709 $param->{'fatal'} = 1; # runs from job queue, will be caught
4710 $param->{'retry'} = 1;
4712 $cust_main->bill_and_collect( %$param );
4715 #starting to take quite a while for big dbs
4716 # (JRNL: journaled so it only happens once per database)
4717 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
4718 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
4719 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
4720 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
4721 # JRNL leading/trailing spaces in first, last, company
4722 # JRNL migrate to cust_payby
4723 # - otaker upgrade? journal and call it good? (double check to make sure
4724 # we're not still setting otaker here)
4726 #only going to get worse with new location stuff...
4728 sub _upgrade_data { #class method
4729 my ($class, %opts) = @_;
4732 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
4735 #this seems to be the only expensive one.. why does it take so long?
4736 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
4738 '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';
4739 FS::upgrade_journal->set_done('cust_main__signupdate');
4742 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
4744 # fix yyyy-m-dd formatted paydates
4745 if ( driver_name =~ /^mysql/i ) {
4747 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4748 } else { # the SQL standard
4750 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4752 FS::upgrade_journal->set_done('cust_main__paydate');
4755 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
4757 push @statements, #fix the weird BILL with a cc# in payinfo problem
4759 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
4761 FS::upgrade_journal->set_done('cust_main__payinfo');
4766 foreach my $sql ( @statements ) {
4767 my $sth = dbh->prepare($sql) or die dbh->errstr;
4768 $sth->execute or die $sth->errstr;
4769 #warn ( (time - $t). " seconds\n" );
4773 local($ignore_expired_card) = 1;
4774 local($ignore_banned_card) = 1;
4775 local($skip_fuzzyfiles) = 1;
4776 local($import) = 1; #prevent automatic geocoding (need its own variable?)
4778 FS::cust_main::Location->_upgrade_data(%opts);
4780 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
4782 foreach my $cust_main ( qsearch({
4783 'table' => 'cust_main',
4785 'extra_sql' => 'WHERE '.
4787 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
4788 qw( first last company )
4791 my $error = $cust_main->replace;
4792 die $error if $error;
4795 FS::upgrade_journal->set_done('cust_main__trimspaces');
4799 unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
4801 #we don't want to decrypt them, just stuff them as-is into cust_payby
4802 local(@encrypted_fields) = ();
4804 local($FS::cust_payby::ignore_expired_card) = 1;
4805 local($FS::cust_payby::ignore_banned_card) = 1;
4807 my @payfields = qw( payby payinfo paycvv paymask
4808 paydate paystart_month paystart_year payissue
4809 payname paystate paytype payip
4812 my $search = new FS::Cursor {
4813 'table' => 'cust_main',
4814 'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
4817 while (my $cust_main = $search->fetch) {
4819 my $cust_payby = new FS::cust_payby {
4820 'custnum' => $cust_main->custnum,
4822 map { $_ => $cust_main->$_(); } @payfields
4825 my $error = $cust_payby->insert;
4826 die $error if $error;
4828 $cust_main->setfield($_, '') foreach @payfields;
4829 $error = $cust_main->replace;
4830 die $error if $error;
4834 FS::upgrade_journal->set_done('cust_main__cust_payby');
4837 $class->_upgrade_otaker(%opts);
4847 The delete method should possibly take an FS::cust_main object reference
4848 instead of a scalar customer number.
4850 Bill and collect options should probably be passed as references instead of a
4853 There should probably be a configuration file with a list of allowed credit
4856 No multiple currency support (probably a larger project than just this module).
4858 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4860 Birthdates rely on negative epoch values.
4862 The payby for card/check batches is broken. With mixed batching, bad
4865 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4869 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4870 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4871 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.