5 #FS::cust_main:_Marketgear when they're ready to move to 2.1
6 use base qw( FS::cust_main::Packages
7 FS::cust_main::Billing FS::cust_main::Billing_Realtime
8 FS::cust_main::Billing_Discount
9 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
13 use vars qw( $DEBUG $me $conf
16 $ignore_expired_card $ignore_illegal_zip $ignore_banned_card
17 $skip_fuzzyfiles @fuzzyfields
21 use Scalar::Util qw( blessed );
22 use Time::Local qw(timelocal);
23 use Storable qw(thaw);
27 use Digest::MD5 qw(md5_base64);
30 use File::Temp; #qw( tempfile );
31 use Business::CreditCard 0.28;
33 use FS::UID qw( getotaker dbh driver_name );
34 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
35 use FS::Misc qw( generate_email send_email generate_ps do_print );
36 use FS::Msgcat qw(gettext);
44 use FS::cust_pay_pending;
45 use FS::cust_pay_void;
46 use FS::cust_pay_batch;
49 use FS::part_referral;
50 use FS::cust_main_county;
51 use FS::cust_location;
53 use FS::cust_main_exemption;
54 use FS::cust_tax_adjustment;
55 use FS::cust_tax_location;
57 use FS::cust_main_invoice;
59 use FS::prepay_credit;
65 use FS::payment_gateway;
66 use FS::agent_payment_gateway;
68 use FS::cust_main_note;
70 # 1 is mostly method/subroutine entry and options
71 # 2 traces progress of some operations
72 # 3 is even more information including possibly sensitive data
74 $me = '[FS::cust_main]';
77 $ignore_expired_card = 0;
78 $ignore_illegal_zip = 0;
79 $ignore_banned_card = 0;
82 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
84 @encrypted_fields = ('payinfo', 'paycvv');
85 sub nohistory_fields { ('payinfo', 'paycvv'); }
87 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
89 #ask FS::UID to run this stuff for us later
90 #$FS::UID::callback{'FS::cust_main'} = sub {
91 install_callback FS::UID sub {
93 #yes, need it for stuff below (prolly should be cached)
98 my ( $hashref, $cache ) = @_;
99 if ( exists $hashref->{'pkgnum'} ) {
100 #@{ $self->{'_pkgnum'} } = ();
101 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
102 $self->{'_pkgnum'} = $subcache;
103 #push @{ $self->{'_pkgnum'} },
104 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
110 FS::cust_main - Object methods for cust_main records
116 $record = new FS::cust_main \%hash;
117 $record = new FS::cust_main { 'column' => 'value' };
119 $error = $record->insert;
121 $error = $new_record->replace($old_record);
123 $error = $record->delete;
125 $error = $record->check;
127 @cust_pkg = $record->all_pkgs;
129 @cust_pkg = $record->ncancelled_pkgs;
131 @cust_pkg = $record->suspended_pkgs;
133 $error = $record->bill;
134 $error = $record->bill %options;
135 $error = $record->bill 'time' => $time;
137 $error = $record->collect;
138 $error = $record->collect %options;
139 $error = $record->collect 'invoice_time' => $time,
144 An FS::cust_main object represents a customer. FS::cust_main inherits from
145 FS::Record. The following fields are currently supported:
151 Primary key (assigned automatically for new customers)
155 Agent (see L<FS::agent>)
159 Advertising source (see L<FS::part_referral>)
171 Cocial security number (optional)
187 (optional, see L<FS::cust_main_county>)
191 (see L<FS::cust_main_county>)
197 (see L<FS::cust_main_county>)
233 (optional, see L<FS::cust_main_county>)
237 (see L<FS::cust_main_county>)
243 (see L<FS::cust_main_county>)
259 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
263 Payment Information (See L<FS::payinfo_Mixin> for data format)
267 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
271 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
275 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
279 Start date month (maestro/solo cards only)
283 Start date year (maestro/solo cards only)
287 Issue number (maestro/solo cards only)
291 Name on card or billing name
295 IP address from which payment information was received
299 Tax exempt, empty or `Y'
303 Order taker (see L<FS::access_user>)
309 =item referral_custnum
311 Referring customer number
315 Enable individual CDR spooling, empty or `Y'
319 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
323 Discourage individual CDR printing, empty or `Y'
333 Creates a new customer. To add the customer to the database, see L<"insert">.
335 Note that this stores the hash reference, not a distinct copy of the hash it
336 points to. You can ask the object for a copy with the I<hash> method.
340 sub table { 'cust_main'; }
342 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
344 Adds this customer to the database. If there is an error, returns the error,
345 otherwise returns false.
347 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
348 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
349 are inserted atomicly, or the transaction is rolled back. Passing an empty
350 hash reference is equivalent to not supplying this parameter. There should be
351 a better explanation of this, but until then, here's an example:
354 tie %hash, 'Tie::RefHash'; #this part is important
356 $cust_pkg => [ $svc_acct ],
359 $cust_main->insert( \%hash );
361 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
362 be set as the invoicing list (see L<"invoicing_list">). Errors return as
363 expected and rollback the entire transaction; it is not necessary to call
364 check_invoicing_list first. The invoicing_list is set after the records in the
365 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
366 invoicing_list destination to the newly-created svc_acct. Here's an example:
368 $cust_main->insert( {}, [ $email, 'POST' ] );
370 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
372 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
373 on the supplied jobnum (they will not run until the specific job completes).
374 This can be used to defer provisioning until some action completes (such
375 as running the customer's credit card successfully).
377 The I<noexport> option is deprecated. If I<noexport> is set true, no
378 provisioning jobs (exports) are scheduled. (You can schedule them later with
379 the B<reexport> method.)
381 The I<tax_exemption> option can be set to an arrayref of tax names.
382 FS::cust_main_exemption records will be created and inserted.
388 my $cust_pkgs = @_ ? shift : {};
389 my $invoicing_list = @_ ? shift : '';
391 warn "$me insert called with options ".
392 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
395 local $SIG{HUP} = 'IGNORE';
396 local $SIG{INT} = 'IGNORE';
397 local $SIG{QUIT} = 'IGNORE';
398 local $SIG{TERM} = 'IGNORE';
399 local $SIG{TSTP} = 'IGNORE';
400 local $SIG{PIPE} = 'IGNORE';
402 my $oldAutoCommit = $FS::UID::AutoCommit;
403 local $FS::UID::AutoCommit = 0;
406 my $prepay_identifier = '';
407 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
409 if ( $self->payby eq 'PREPAY' ) {
411 $self->payby('BILL');
412 $prepay_identifier = $self->payinfo;
415 warn " looking up prepaid card $prepay_identifier\n"
418 my $error = $self->get_prepay( $prepay_identifier,
419 'amount_ref' => \$amount,
420 'seconds_ref' => \$seconds,
421 'upbytes_ref' => \$upbytes,
422 'downbytes_ref' => \$downbytes,
423 'totalbytes_ref' => \$totalbytes,
426 $dbh->rollback if $oldAutoCommit;
427 #return "error applying prepaid card (transaction rolled back): $error";
431 $payby = 'PREP' if $amount;
433 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
436 $self->payby('BILL');
437 $amount = $self->paid;
441 warn " inserting $self\n"
444 $self->signupdate(time) unless $self->signupdate;
446 $self->auto_agent_custid()
447 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
449 my $error = $self->SUPER::insert;
451 $dbh->rollback if $oldAutoCommit;
452 #return "inserting cust_main record (transaction rolled back): $error";
456 warn " setting invoicing list\n"
459 if ( $invoicing_list ) {
460 $error = $self->check_invoicing_list( $invoicing_list );
462 $dbh->rollback if $oldAutoCommit;
463 #return "checking invoicing_list (transaction rolled back): $error";
466 $self->invoicing_list( $invoicing_list );
469 warn " setting customer tags\n"
472 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
473 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
474 'custnum' => $self->custnum };
475 my $error = $cust_tag->insert;
477 $dbh->rollback if $oldAutoCommit;
482 if ( $invoicing_list ) {
483 $error = $self->check_invoicing_list( $invoicing_list );
485 $dbh->rollback if $oldAutoCommit;
486 #return "checking invoicing_list (transaction rolled back): $error";
489 $self->invoicing_list( $invoicing_list );
493 warn " setting cust_main_exemption\n"
496 my $tax_exemption = delete $options{'tax_exemption'};
497 if ( $tax_exemption ) {
498 foreach my $taxname ( @$tax_exemption ) {
499 my $cust_main_exemption = new FS::cust_main_exemption {
500 'custnum' => $self->custnum,
501 'taxname' => $taxname,
503 my $error = $cust_main_exemption->insert;
505 $dbh->rollback if $oldAutoCommit;
506 return "inserting cust_main_exemption (transaction rolled back): $error";
511 if ( $self->can('start_copy_skel') ) {
512 my $error = $self->start_copy_skel;
514 $dbh->rollback if $oldAutoCommit;
519 warn " ordering packages\n"
522 $error = $self->order_pkgs( $cust_pkgs,
524 'seconds_ref' => \$seconds,
525 'upbytes_ref' => \$upbytes,
526 'downbytes_ref' => \$downbytes,
527 'totalbytes_ref' => \$totalbytes,
530 $dbh->rollback if $oldAutoCommit;
535 $dbh->rollback if $oldAutoCommit;
536 return "No svc_acct record to apply pre-paid time";
538 if ( $upbytes || $downbytes || $totalbytes ) {
539 $dbh->rollback if $oldAutoCommit;
540 return "No svc_acct record to apply pre-paid data";
544 warn " inserting initial $payby payment of $amount\n"
546 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
548 $dbh->rollback if $oldAutoCommit;
549 return "inserting payment (transaction rolled back): $error";
553 unless ( $import || $skip_fuzzyfiles ) {
554 warn " queueing fuzzyfiles update\n"
556 $error = $self->queue_fuzzyfiles_update;
558 $dbh->rollback if $oldAutoCommit;
559 return "updating fuzzy search cache: $error";
564 warn " exporting\n" if $DEBUG > 1;
566 my $export_args = $options{'export_args'} || [];
569 map qsearch( 'part_export', {exportnum=>$_} ),
570 $conf->config('cust_main-exports'); #, $agentnum
572 foreach my $part_export ( @part_export ) {
573 my $error = $part_export->export_insert($self, @$export_args);
575 $dbh->rollback if $oldAutoCommit;
576 return "exporting to ". $part_export->exporttype.
577 " (transaction rolled back): $error";
581 #foreach my $depend_jobnum ( @$depend_jobnums ) {
582 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
584 # foreach my $jobnum ( @jobnums ) {
585 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
586 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
588 # my $error = $queue->depend_insert($depend_jobnum);
590 # $dbh->rollback if $oldAutoCommit;
591 # return "error queuing job dependancy: $error";
598 #if ( exists $options{'jobnums'} ) {
599 # push @{ $options{'jobnums'} }, @jobnums;
602 warn " insert complete; committing transaction\n"
605 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
610 use File::CounterFile;
611 sub auto_agent_custid {
614 my $format = $conf->config('cust_main-auto_agent_custid');
616 if ( $format eq '1YMMXXXXXXXX' ) {
618 my $counter = new File::CounterFile 'cust_main.agent_custid';
621 my $ym = 100000000000 + time2str('%y%m00000000', time);
622 if ( $ym > $counter->value ) {
623 $counter->{'value'} = $agent_custid = $ym;
624 $counter->{'updated'} = 1;
626 $agent_custid = $counter->inc;
632 die "Unknown cust_main-auto_agent_custid format: $format";
635 $self->agent_custid($agent_custid);
639 =item PACKAGE METHODS
641 Documentation on customer package methods has been moved to
642 L<FS::cust_main::Packages>.
644 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
646 Recharges this (existing) customer with the specified prepaid card (see
647 L<FS::prepay_credit>), specified either by I<identifier> or as an
648 FS::prepay_credit object. If there is an error, returns the error, otherwise
651 Optionally, five scalar references can be passed as well. They will have their
652 values filled in with the amount, number of seconds, and number of upload,
653 download, and total bytes applied by this prepaid card.
657 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
658 #the only place that uses these args
659 sub recharge_prepay {
660 my( $self, $prepay_credit, $amountref, $secondsref,
661 $upbytesref, $downbytesref, $totalbytesref ) = @_;
663 local $SIG{HUP} = 'IGNORE';
664 local $SIG{INT} = 'IGNORE';
665 local $SIG{QUIT} = 'IGNORE';
666 local $SIG{TERM} = 'IGNORE';
667 local $SIG{TSTP} = 'IGNORE';
668 local $SIG{PIPE} = 'IGNORE';
670 my $oldAutoCommit = $FS::UID::AutoCommit;
671 local $FS::UID::AutoCommit = 0;
674 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
676 my $error = $self->get_prepay( $prepay_credit,
677 'amount_ref' => \$amount,
678 'seconds_ref' => \$seconds,
679 'upbytes_ref' => \$upbytes,
680 'downbytes_ref' => \$downbytes,
681 'totalbytes_ref' => \$totalbytes,
683 || $self->increment_seconds($seconds)
684 || $self->increment_upbytes($upbytes)
685 || $self->increment_downbytes($downbytes)
686 || $self->increment_totalbytes($totalbytes)
687 || $self->insert_cust_pay_prepay( $amount,
689 ? $prepay_credit->identifier
694 $dbh->rollback if $oldAutoCommit;
698 if ( defined($amountref) ) { $$amountref = $amount; }
699 if ( defined($secondsref) ) { $$secondsref = $seconds; }
700 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
701 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
702 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
704 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
709 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
711 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
712 specified either by I<identifier> or as an FS::prepay_credit object.
714 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
715 incremented by the values of the prepaid card.
717 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
718 check or set this customer's I<agentnum>.
720 If there is an error, returns the error, otherwise returns false.
726 my( $self, $prepay_credit, %opt ) = @_;
728 local $SIG{HUP} = 'IGNORE';
729 local $SIG{INT} = 'IGNORE';
730 local $SIG{QUIT} = 'IGNORE';
731 local $SIG{TERM} = 'IGNORE';
732 local $SIG{TSTP} = 'IGNORE';
733 local $SIG{PIPE} = 'IGNORE';
735 my $oldAutoCommit = $FS::UID::AutoCommit;
736 local $FS::UID::AutoCommit = 0;
739 unless ( ref($prepay_credit) ) {
741 my $identifier = $prepay_credit;
743 $prepay_credit = qsearchs(
745 { 'identifier' => $prepay_credit },
750 unless ( $prepay_credit ) {
751 $dbh->rollback if $oldAutoCommit;
752 return "Invalid prepaid card: ". $identifier;
757 if ( $prepay_credit->agentnum ) {
758 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
759 $dbh->rollback if $oldAutoCommit;
760 return "prepaid card not valid for agent ". $self->agentnum;
762 $self->agentnum($prepay_credit->agentnum);
765 my $error = $prepay_credit->delete;
767 $dbh->rollback if $oldAutoCommit;
768 return "removing prepay_credit (transaction rolled back): $error";
771 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
772 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
774 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
779 =item increment_upbytes SECONDS
781 Updates this customer's single or primary account (see L<FS::svc_acct>) by
782 the specified number of upbytes. If there is an error, returns the error,
783 otherwise returns false.
787 sub increment_upbytes {
788 _increment_column( shift, 'upbytes', @_);
791 =item increment_downbytes SECONDS
793 Updates this customer's single or primary account (see L<FS::svc_acct>) by
794 the specified number of downbytes. If there is an error, returns the error,
795 otherwise returns false.
799 sub increment_downbytes {
800 _increment_column( shift, 'downbytes', @_);
803 =item increment_totalbytes SECONDS
805 Updates this customer's single or primary account (see L<FS::svc_acct>) by
806 the specified number of totalbytes. If there is an error, returns the error,
807 otherwise returns false.
811 sub increment_totalbytes {
812 _increment_column( shift, 'totalbytes', @_);
815 =item increment_seconds SECONDS
817 Updates this customer's single or primary account (see L<FS::svc_acct>) by
818 the specified number of seconds. If there is an error, returns the error,
819 otherwise returns false.
823 sub increment_seconds {
824 _increment_column( shift, 'seconds', @_);
827 =item _increment_column AMOUNT
829 Updates this customer's single or primary account (see L<FS::svc_acct>) by
830 the specified number of seconds or bytes. If there is an error, returns
831 the error, otherwise returns false.
835 sub _increment_column {
836 my( $self, $column, $amount ) = @_;
837 warn "$me increment_column called: $column, $amount\n"
840 return '' unless $amount;
842 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
843 $self->ncancelled_pkgs;
846 return 'No packages with primary or single services found'.
847 ' to apply pre-paid time';
848 } elsif ( scalar(@cust_pkg) > 1 ) {
849 #maybe have a way to specify the package/account?
850 return 'Multiple packages found to apply pre-paid time';
853 my $cust_pkg = $cust_pkg[0];
854 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
858 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
861 return 'No account found to apply pre-paid time';
862 } elsif ( scalar(@cust_svc) > 1 ) {
863 return 'Multiple accounts found to apply pre-paid time';
866 my $svc_acct = $cust_svc[0]->svc_x;
867 warn " found service svcnum ". $svc_acct->pkgnum.
868 ' ('. $svc_acct->email. ")\n"
871 $column = "increment_$column";
872 $svc_acct->$column($amount);
876 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
878 Inserts a prepayment in the specified amount for this customer. An optional
879 second argument can specify the prepayment identifier for tracking purposes.
880 If there is an error, returns the error, otherwise returns false.
884 sub insert_cust_pay_prepay {
885 shift->insert_cust_pay('PREP', @_);
888 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
890 Inserts a cash payment in the specified amount for this customer. An optional
891 second argument can specify the payment identifier for tracking purposes.
892 If there is an error, returns the error, otherwise returns false.
896 sub insert_cust_pay_cash {
897 shift->insert_cust_pay('CASH', @_);
900 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
902 Inserts a Western Union payment in the specified amount for this customer. An
903 optional second argument can specify the prepayment identifier for tracking
904 purposes. If there is an error, returns the error, otherwise returns false.
908 sub insert_cust_pay_west {
909 shift->insert_cust_pay('WEST', @_);
912 sub insert_cust_pay {
913 my( $self, $payby, $amount ) = splice(@_, 0, 3);
914 my $payinfo = scalar(@_) ? shift : '';
916 my $cust_pay = new FS::cust_pay {
917 'custnum' => $self->custnum,
918 'paid' => sprintf('%.2f', $amount),
919 #'_date' => #date the prepaid card was purchased???
921 'payinfo' => $payinfo,
929 This method is deprecated. See the I<depend_jobnum> option to the insert and
930 order_pkgs methods for a better way to defer provisioning.
932 Re-schedules all exports by calling the B<reexport> method of all associated
933 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
934 otherwise returns false.
941 carp "WARNING: FS::cust_main::reexport is deprectated; ".
942 "use the depend_jobnum option to insert or order_pkgs to delay export";
944 local $SIG{HUP} = 'IGNORE';
945 local $SIG{INT} = 'IGNORE';
946 local $SIG{QUIT} = 'IGNORE';
947 local $SIG{TERM} = 'IGNORE';
948 local $SIG{TSTP} = 'IGNORE';
949 local $SIG{PIPE} = 'IGNORE';
951 my $oldAutoCommit = $FS::UID::AutoCommit;
952 local $FS::UID::AutoCommit = 0;
955 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
956 my $error = $cust_pkg->reexport;
958 $dbh->rollback if $oldAutoCommit;
963 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
968 =item delete [ OPTION => VALUE ... ]
970 This deletes the customer. If there is an error, returns the error, otherwise
973 This will completely remove all traces of the customer record. This is not
974 what you want when a customer cancels service; for that, cancel all of the
975 customer's packages (see L</cancel>).
977 If the customer has any uncancelled packages, you need to pass a new (valid)
978 customer number for those packages to be transferred to, as the "new_customer"
979 option. Cancelled packages will be deleted. Did I mention that this is NOT
980 what you want when a customer cancels service and that you really should be
981 looking at L<FS::cust_pkg/cancel>?
983 You can't delete a customer with invoices (see L<FS::cust_bill>),
984 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
985 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
986 set the "delete_financials" option to a true value.
991 my( $self, %opt ) = @_;
993 local $SIG{HUP} = 'IGNORE';
994 local $SIG{INT} = 'IGNORE';
995 local $SIG{QUIT} = 'IGNORE';
996 local $SIG{TERM} = 'IGNORE';
997 local $SIG{TSTP} = 'IGNORE';
998 local $SIG{PIPE} = 'IGNORE';
1000 my $oldAutoCommit = $FS::UID::AutoCommit;
1001 local $FS::UID::AutoCommit = 0;
1004 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1005 $dbh->rollback if $oldAutoCommit;
1006 return "Can't delete a master agent customer";
1009 #use FS::access_user
1010 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1011 $dbh->rollback if $oldAutoCommit;
1012 return "Can't delete a master employee customer";
1015 tie my %financial_tables, 'Tie::IxHash',
1016 'cust_bill' => 'invoices',
1017 'cust_statement' => 'statements',
1018 'cust_credit' => 'credits',
1019 'cust_pay' => 'payments',
1020 'cust_refund' => 'refunds',
1023 foreach my $table ( keys %financial_tables ) {
1025 my @records = $self->$table();
1027 if ( @records && ! $opt{'delete_financials'} ) {
1028 $dbh->rollback if $oldAutoCommit;
1029 return "Can't delete a customer with ". $financial_tables{$table};
1032 foreach my $record ( @records ) {
1033 my $error = $record->delete;
1035 $dbh->rollback if $oldAutoCommit;
1036 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1042 my @cust_pkg = $self->ncancelled_pkgs;
1044 my $new_custnum = $opt{'new_custnum'};
1045 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1046 $dbh->rollback if $oldAutoCommit;
1047 return "Invalid new customer number: $new_custnum";
1049 foreach my $cust_pkg ( @cust_pkg ) {
1050 my %hash = $cust_pkg->hash;
1051 $hash{'custnum'} = $new_custnum;
1052 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1053 my $error = $new_cust_pkg->replace($cust_pkg,
1054 options => { $cust_pkg->options },
1057 $dbh->rollback if $oldAutoCommit;
1062 my @cancelled_cust_pkg = $self->all_pkgs;
1063 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1064 my $error = $cust_pkg->delete;
1066 $dbh->rollback if $oldAutoCommit;
1071 #cust_tax_adjustment in financials?
1072 #cust_pay_pending? ouch
1074 foreach my $table (qw(
1075 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1076 cust_location cust_main_note cust_tax_adjustment
1077 cust_pay_void cust_pay_batch queue cust_tax_exempt
1079 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1080 my $error = $record->delete;
1082 $dbh->rollback if $oldAutoCommit;
1088 my $sth = $dbh->prepare(
1089 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1091 my $errstr = $dbh->errstr;
1092 $dbh->rollback if $oldAutoCommit;
1095 $sth->execute($self->custnum) or do {
1096 my $errstr = $sth->errstr;
1097 $dbh->rollback if $oldAutoCommit;
1103 my $ticket_dbh = '';
1104 if ($conf->config('ticket_system') eq 'RT_Internal') {
1106 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1107 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1108 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1109 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1112 if ( $ticket_dbh ) {
1114 my $ticket_sth = $ticket_dbh->prepare(
1115 'DELETE FROM Links WHERE Target = ?'
1117 my $errstr = $ticket_dbh->errstr;
1118 $dbh->rollback if $oldAutoCommit;
1121 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1123 my $errstr = $ticket_sth->errstr;
1124 $dbh->rollback if $oldAutoCommit;
1128 #check and see if the customer is the only link on the ticket, and
1129 #if so, set the ticket to deleted status in RT?
1130 #maybe someday, for now this will at least fix tickets not displaying
1134 #delete the customer record
1136 my $error = $self->SUPER::delete;
1138 $dbh->rollback if $oldAutoCommit;
1142 # cust_main exports!
1144 #my $export_args = $options{'export_args'} || [];
1147 map qsearch( 'part_export', {exportnum=>$_} ),
1148 $conf->config('cust_main-exports'); #, $agentnum
1150 foreach my $part_export ( @part_export ) {
1151 my $error = $part_export->export_delete( $self ); #, @$export_args);
1153 $dbh->rollback if $oldAutoCommit;
1154 return "exporting to ". $part_export->exporttype.
1155 " (transaction rolled back): $error";
1159 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1164 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1166 This merges this customer into the provided new custnum, and then deletes the
1167 customer. If there is an error, returns the error, otherwise returns false.
1169 The source customer's name, company name, phone numbers, agent,
1170 referring customer, customer class, advertising source, order taker, and
1171 billing information (except balance) are discarded.
1173 All packages are moved to the target customer. Packages with package locations
1174 are preserved. Packages without package locations are moved to a new package
1175 location with the source customer's service/shipping address.
1177 All invoices, statements, payments, credits and refunds are moved to the target
1178 customer. The source customer's balance is added to the target customer.
1180 All notes, attachments, tickets and customer tags are moved to the target
1183 Change history is not currently moved.
1188 my( $self, $new_custnum, %opt ) = @_;
1190 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1192 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1193 return "Invalid new customer number: $new_custnum";
1196 local $SIG{HUP} = 'IGNORE';
1197 local $SIG{INT} = 'IGNORE';
1198 local $SIG{QUIT} = 'IGNORE';
1199 local $SIG{TERM} = 'IGNORE';
1200 local $SIG{TSTP} = 'IGNORE';
1201 local $SIG{PIPE} = 'IGNORE';
1203 my $oldAutoCommit = $FS::UID::AutoCommit;
1204 local $FS::UID::AutoCommit = 0;
1207 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1208 $dbh->rollback if $oldAutoCommit;
1209 return "Can't merge a master agent customer";
1212 #use FS::access_user
1213 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1214 $dbh->rollback if $oldAutoCommit;
1215 return "Can't merge a master employee customer";
1218 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1219 'status' => { op=>'!=', value=>'done' },
1223 $dbh->rollback if $oldAutoCommit;
1224 return "Can't merge a customer with pending payments";
1227 tie my %financial_tables, 'Tie::IxHash',
1228 'cust_bill' => 'invoices',
1229 'cust_statement' => 'statements',
1230 'cust_credit' => 'credits',
1231 'cust_pay' => 'payments',
1232 'cust_pay_void' => 'voided payments',
1233 'cust_refund' => 'refunds',
1236 foreach my $table ( keys %financial_tables ) {
1238 my @records = $self->$table();
1240 foreach my $record ( @records ) {
1241 $record->custnum($new_custnum);
1242 my $error = $record->replace;
1244 $dbh->rollback if $oldAutoCommit;
1245 return "Error merging ". $financial_tables{$table}. ": $error\n";
1251 my $name = $self->ship_name;
1253 my $locationnum = '';
1254 foreach my $cust_pkg ( $self->all_pkgs ) {
1255 $cust_pkg->custnum($new_custnum);
1257 unless ( $cust_pkg->locationnum ) {
1258 unless ( $locationnum ) {
1259 my $cust_location = new FS::cust_location {
1260 $self->location_hash,
1261 'custnum' => $new_custnum,
1263 my $error = $cust_location->insert;
1265 $dbh->rollback if $oldAutoCommit;
1268 $locationnum = $cust_location->locationnum;
1270 $cust_pkg->locationnum($locationnum);
1273 my $error = $cust_pkg->replace;
1275 $dbh->rollback if $oldAutoCommit;
1279 # add customer (ship) name to svc_phone.phone_name if blank
1280 my @cust_svc = $cust_pkg->cust_svc;
1281 foreach my $cust_svc (@cust_svc) {
1282 my($label, $value, $svcdb) = $cust_svc->label;
1283 next unless $svcdb eq 'svc_phone';
1284 my $svc_phone = $cust_svc->svc_x;
1285 next if $svc_phone->phone_name;
1286 $svc_phone->phone_name($name);
1287 my $error = $svc_phone->replace;
1289 $dbh->rollback if $oldAutoCommit;
1297 # cust_tax_exempt (texas tax exemptions)
1298 # cust_recon (some sort of not-well understood thing for OnPac)
1300 #these are moved over
1301 foreach my $table (qw(
1302 cust_tag cust_location contact cust_attachment cust_main_note
1303 cust_tax_adjustment cust_pay_batch queue
1305 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1306 $record->custnum($new_custnum);
1307 my $error = $record->replace;
1309 $dbh->rollback if $oldAutoCommit;
1315 #these aren't preserved
1316 foreach my $table (qw(
1317 cust_main_exemption cust_main_invoice
1319 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1320 my $error = $record->delete;
1322 $dbh->rollback if $oldAutoCommit;
1329 my $sth = $dbh->prepare(
1330 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1332 my $errstr = $dbh->errstr;
1333 $dbh->rollback if $oldAutoCommit;
1336 $sth->execute($new_custnum, $self->custnum) or do {
1337 my $errstr = $sth->errstr;
1338 $dbh->rollback if $oldAutoCommit;
1344 my $ticket_dbh = '';
1345 if ($conf->config('ticket_system') eq 'RT_Internal') {
1347 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1348 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1349 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1350 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1353 if ( $ticket_dbh ) {
1355 my $ticket_sth = $ticket_dbh->prepare(
1356 'UPDATE Links SET Target = ? WHERE Target = ?'
1358 my $errstr = $ticket_dbh->errstr;
1359 $dbh->rollback if $oldAutoCommit;
1362 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1363 'freeside://freeside/cust_main/'.$self->custnum)
1365 my $errstr = $ticket_sth->errstr;
1366 $dbh->rollback if $oldAutoCommit;
1372 #delete the customer record
1374 my $error = $self->delete;
1376 $dbh->rollback if $oldAutoCommit;
1380 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1385 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1388 Replaces the OLD_RECORD with this one in the database. If there is an error,
1389 returns the error, otherwise returns false.
1391 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1392 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1393 expected and rollback the entire transaction; it is not necessary to call
1394 check_invoicing_list first. Here's an example:
1396 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1398 Currently available options are: I<tax_exemption>.
1400 The I<tax_exemption> option can be set to an arrayref of tax names.
1401 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1408 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1410 : $self->replace_old;
1414 warn "$me replace called\n"
1417 my $curuser = $FS::CurrentUser::CurrentUser;
1418 if ( $self->payby eq 'COMP'
1419 && $self->payby ne $old->payby
1420 && ! $curuser->access_right('Complimentary customer')
1423 return "You are not permitted to create complimentary accounts.";
1426 if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode')
1427 && $conf->exists('enable_taxproducts')
1430 my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip)
1432 $self->set('geocode', '')
1433 if $old->get($pre.'zip') ne $self->get($pre.'zip')
1434 && length($self->get($pre.'zip')) >= 10;
1437 local($ignore_expired_card) = 1
1438 if $old->payby =~ /^(CARD|DCRD)$/
1439 && $self->payby =~ /^(CARD|DCRD)$/
1440 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1442 local $SIG{HUP} = 'IGNORE';
1443 local $SIG{INT} = 'IGNORE';
1444 local $SIG{QUIT} = 'IGNORE';
1445 local $SIG{TERM} = 'IGNORE';
1446 local $SIG{TSTP} = 'IGNORE';
1447 local $SIG{PIPE} = 'IGNORE';
1449 my $oldAutoCommit = $FS::UID::AutoCommit;
1450 local $FS::UID::AutoCommit = 0;
1453 my $error = $self->SUPER::replace($old);
1456 $dbh->rollback if $oldAutoCommit;
1460 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1461 my $invoicing_list = shift @param;
1462 $error = $self->check_invoicing_list( $invoicing_list );
1464 $dbh->rollback if $oldAutoCommit;
1467 $self->invoicing_list( $invoicing_list );
1470 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1472 #this could be more efficient than deleting and re-inserting, if it matters
1473 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1474 my $error = $cust_tag->delete;
1476 $dbh->rollback if $oldAutoCommit;
1480 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1481 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1482 'custnum' => $self->custnum };
1483 my $error = $cust_tag->insert;
1485 $dbh->rollback if $oldAutoCommit;
1492 my %options = @param;
1494 my $tax_exemption = delete $options{'tax_exemption'};
1495 if ( $tax_exemption ) {
1497 my %cust_main_exemption =
1498 map { $_->taxname => $_ }
1499 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1501 foreach my $taxname ( @$tax_exemption ) {
1503 next if delete $cust_main_exemption{$taxname};
1505 my $cust_main_exemption = new FS::cust_main_exemption {
1506 'custnum' => $self->custnum,
1507 'taxname' => $taxname,
1509 my $error = $cust_main_exemption->insert;
1511 $dbh->rollback if $oldAutoCommit;
1512 return "inserting cust_main_exemption (transaction rolled back): $error";
1516 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1517 my $error = $cust_main_exemption->delete;
1519 $dbh->rollback if $oldAutoCommit;
1520 return "deleting cust_main_exemption (transaction rolled back): $error";
1526 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1527 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1528 && $self->get('payinfo') !~ /^99\d{14}$/
1530 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1535 # card/check/lec info has changed, want to retry realtime_ invoice events
1536 my $error = $self->retry_realtime;
1538 $dbh->rollback if $oldAutoCommit;
1543 unless ( $import || $skip_fuzzyfiles ) {
1544 $error = $self->queue_fuzzyfiles_update;
1546 $dbh->rollback if $oldAutoCommit;
1547 return "updating fuzzy search cache: $error";
1551 # cust_main exports!
1553 my $export_args = $options{'export_args'} || [];
1556 map qsearch( 'part_export', {exportnum=>$_} ),
1557 $conf->config('cust_main-exports'); #, $agentnum
1559 foreach my $part_export ( @part_export ) {
1560 my $error = $part_export->export_replace( $self, $old, @$export_args);
1562 $dbh->rollback if $oldAutoCommit;
1563 return "exporting to ". $part_export->exporttype.
1564 " (transaction rolled back): $error";
1568 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1573 =item queue_fuzzyfiles_update
1575 Used by insert & replace to update the fuzzy search cache
1579 sub queue_fuzzyfiles_update {
1582 local $SIG{HUP} = 'IGNORE';
1583 local $SIG{INT} = 'IGNORE';
1584 local $SIG{QUIT} = 'IGNORE';
1585 local $SIG{TERM} = 'IGNORE';
1586 local $SIG{TSTP} = 'IGNORE';
1587 local $SIG{PIPE} = 'IGNORE';
1589 my $oldAutoCommit = $FS::UID::AutoCommit;
1590 local $FS::UID::AutoCommit = 0;
1593 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1594 my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1596 $dbh->rollback if $oldAutoCommit;
1597 return "queueing job (transaction rolled back): $error";
1600 if ( $self->ship_last ) {
1601 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1602 $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1604 $dbh->rollback if $oldAutoCommit;
1605 return "queueing job (transaction rolled back): $error";
1609 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1616 Checks all fields to make sure this is a valid customer record. If there is
1617 an error, returns the error, otherwise returns false. Called by the insert
1618 and replace methods.
1625 warn "$me check BEFORE: \n". $self->_dump
1629 $self->ut_numbern('custnum')
1630 || $self->ut_number('agentnum')
1631 || $self->ut_textn('agent_custid')
1632 || $self->ut_number('refnum')
1633 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1634 || $self->ut_textn('custbatch')
1635 || $self->ut_name('last')
1636 || $self->ut_name('first')
1637 || $self->ut_snumbern('birthdate')
1638 || $self->ut_snumbern('signupdate')
1639 || $self->ut_textn('company')
1640 || $self->ut_text('address1')
1641 || $self->ut_textn('address2')
1642 || $self->ut_text('city')
1643 || $self->ut_textn('county')
1644 || $self->ut_textn('state')
1645 || $self->ut_country('country')
1646 || $self->ut_anything('comments')
1647 || $self->ut_numbern('referral_custnum')
1648 || $self->ut_textn('stateid')
1649 || $self->ut_textn('stateid_state')
1650 || $self->ut_textn('invoice_terms')
1651 || $self->ut_alphan('geocode')
1652 || $self->ut_floatn('cdr_termination_percentage')
1653 || $self->ut_floatn('credit_limit')
1656 #barf. need message catalogs. i18n. etc.
1657 $error .= "Please select an advertising source."
1658 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1659 return $error if $error;
1661 return "Unknown agent"
1662 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1664 return "Unknown refnum"
1665 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1667 return "Unknown referring custnum: ". $self->referral_custnum
1668 unless ! $self->referral_custnum
1669 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1671 if ( $self->censustract ne '' ) {
1672 $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1673 or return "Illegal census tract: ". $self->censustract;
1675 $self->censustract("$1.$2");
1678 if ( $self->ss eq '' ) {
1683 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1684 or return "Illegal social security number: ". $self->ss;
1685 $self->ss("$1-$2-$3");
1689 # bad idea to disable, causes billing to fail because of no tax rates later
1690 # except we don't fail any more
1691 unless ( $import ) {
1692 unless ( qsearch('cust_main_county', {
1693 'country' => $self->country,
1696 return "Unknown state/county/country: ".
1697 $self->state. "/". $self->county. "/". $self->country
1698 unless qsearch('cust_main_county',{
1699 'state' => $self->state,
1700 'county' => $self->county,
1701 'country' => $self->country,
1707 $self->ut_phonen('daytime', $self->country)
1708 || $self->ut_phonen('night', $self->country)
1709 || $self->ut_phonen('fax', $self->country)
1711 return $error if $error;
1713 unless ( $ignore_illegal_zip ) {
1714 $error = $self->ut_zip('zip', $self->country);
1715 return $error if $error;
1718 if ( $conf->exists('cust_main-require_phone')
1719 && ! length($self->daytime) && ! length($self->night)
1722 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1724 : FS::Msgcat::_gettext('daytime');
1725 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1727 : FS::Msgcat::_gettext('night');
1729 return "$daytime_label or $night_label is required"
1733 if ( $self->has_ship_address
1734 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1735 $self->addr_fields )
1739 $self->ut_name('ship_last')
1740 || $self->ut_name('ship_first')
1741 || $self->ut_textn('ship_company')
1742 || $self->ut_text('ship_address1')
1743 || $self->ut_textn('ship_address2')
1744 || $self->ut_text('ship_city')
1745 || $self->ut_textn('ship_county')
1746 || $self->ut_textn('ship_state')
1747 || $self->ut_country('ship_country')
1749 return $error if $error;
1751 #false laziness with above
1752 unless ( qsearchs('cust_main_county', {
1753 'country' => $self->ship_country,
1756 return "Unknown ship_state/ship_county/ship_country: ".
1757 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1758 unless qsearch('cust_main_county',{
1759 'state' => $self->ship_state,
1760 'county' => $self->ship_county,
1761 'country' => $self->ship_country,
1767 $self->ut_phonen('ship_daytime', $self->ship_country)
1768 || $self->ut_phonen('ship_night', $self->ship_country)
1769 || $self->ut_phonen('ship_fax', $self->ship_country)
1771 return $error if $error;
1773 unless ( $ignore_illegal_zip ) {
1774 $error = $self->ut_zip('ship_zip', $self->ship_country);
1775 return $error if $error;
1777 return "Unit # is required."
1778 if $self->ship_address2 =~ /^\s*$/
1779 && $conf->exists('cust_main-require_address2');
1781 } else { # ship_ info eq billing info, so don't store dup info in database
1783 $self->setfield("ship_$_", '')
1784 foreach $self->addr_fields;
1786 return "Unit # is required."
1787 if $self->address2 =~ /^\s*$/
1788 && $conf->exists('cust_main-require_address2');
1792 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1793 # or return "Illegal payby: ". $self->payby;
1795 FS::payby->can_payby($self->table, $self->payby)
1796 or return "Illegal payby: ". $self->payby;
1798 $error = $self->ut_numbern('paystart_month')
1799 || $self->ut_numbern('paystart_year')
1800 || $self->ut_numbern('payissue')
1801 || $self->ut_textn('paytype')
1803 return $error if $error;
1805 if ( $self->payip eq '' ) {
1808 $error = $self->ut_ip('payip');
1809 return $error if $error;
1812 # If it is encrypted and the private key is not availaible then we can't
1813 # check the credit card.
1814 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1816 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1818 my $payinfo = $self->payinfo;
1819 $payinfo =~ s/\D//g;
1820 $payinfo =~ /^(\d{13,16})$/
1821 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1823 $self->payinfo($payinfo);
1825 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1827 return gettext('unknown_card_type')
1828 if $self->payinfo !~ /^99\d{14}$/ #token
1829 && cardtype($self->payinfo) eq "Unknown";
1831 unless ( $ignore_banned_card ) {
1832 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1834 return 'Banned credit card: banned on '.
1835 time2str('%a %h %o at %r', $ban->_date).
1836 ' by '. $ban->otaker.
1837 ' (ban# '. $ban->bannum. ')';
1841 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1842 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1843 $self->paycvv =~ /^(\d{4})$/
1844 or return "CVV2 (CID) for American Express cards is four digits.";
1847 $self->paycvv =~ /^(\d{3})$/
1848 or return "CVV2 (CVC2/CID) is three digits.";
1855 my $cardtype = cardtype($payinfo);
1856 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1858 return "Start date or issue number is required for $cardtype cards"
1859 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1861 return "Start month must be between 1 and 12"
1862 if $self->paystart_month
1863 and $self->paystart_month < 1 || $self->paystart_month > 12;
1865 return "Start year must be 1990 or later"
1866 if $self->paystart_year
1867 and $self->paystart_year < 1990;
1869 return "Issue number must be beween 1 and 99"
1871 and $self->payissue < 1 || $self->payissue > 99;
1874 $self->paystart_month('');
1875 $self->paystart_year('');
1876 $self->payissue('');
1879 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1881 my $payinfo = $self->payinfo;
1882 $payinfo =~ s/[^\d\@]//g;
1883 if ( $conf->exists('echeck-nonus') ) {
1884 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1885 $payinfo = "$1\@$2";
1887 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1888 $payinfo = "$1\@$2";
1890 $self->payinfo($payinfo);
1893 unless ( $ignore_banned_card ) {
1894 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1896 return 'Banned ACH account: banned on '.
1897 time2str('%a %h %o at %r', $ban->_date).
1898 ' by '. $ban->otaker.
1899 ' (ban# '. $ban->bannum. ')';
1903 } elsif ( $self->payby eq 'LECB' ) {
1905 my $payinfo = $self->payinfo;
1906 $payinfo =~ s/\D//g;
1907 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1909 $self->payinfo($payinfo);
1912 } elsif ( $self->payby eq 'BILL' ) {
1914 $error = $self->ut_textn('payinfo');
1915 return "Illegal P.O. number: ". $self->payinfo if $error;
1918 } elsif ( $self->payby eq 'COMP' ) {
1920 my $curuser = $FS::CurrentUser::CurrentUser;
1921 if ( ! $self->custnum
1922 && ! $curuser->access_right('Complimentary customer')
1925 return "You are not permitted to create complimentary accounts."
1928 $error = $self->ut_textn('payinfo');
1929 return "Illegal comp account issuer: ". $self->payinfo if $error;
1932 } elsif ( $self->payby eq 'PREPAY' ) {
1934 my $payinfo = $self->payinfo;
1935 $payinfo =~ s/\W//g; #anything else would just confuse things
1936 $self->payinfo($payinfo);
1937 $error = $self->ut_alpha('payinfo');
1938 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1939 return "Unknown prepayment identifier"
1940 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1945 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1946 return "Expiration date required"
1947 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1951 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1952 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1953 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1954 ( $m, $y ) = ( $2, "19$1" );
1955 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1956 ( $m, $y ) = ( $3, "20$2" );
1958 return "Illegal expiration date: ". $self->paydate;
1960 $m = sprintf('%02d',$m);
1961 $self->paydate("$y-$m-01");
1962 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1963 return gettext('expired_card')
1965 && !$ignore_expired_card
1966 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1969 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1970 ( ! $conf->exists('require_cardname')
1971 || $self->payby !~ /^(CARD|DCRD)$/ )
1973 $self->payname( $self->first. " ". $self->getfield('last') );
1975 $self->payname =~ /^([µ_0123456789aAáÁàÀâÂåÅäÄãêæÆbBcCçÇdDðÐeEéÉèÈêÊëËfFgGhHiIíÍìÌîÎïÏjJkKlLmMnNñÑoOóÓòÒôÔöÖõÕøغpPqQrRsSßtTuUúÚùÙûÛüÜvVwWxXyYýÝÿzZþÞ \,\.\-\'\&]+)$/
1976 or return gettext('illegal_name'). " payname: ". $self->payname;
1980 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1981 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1985 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1987 warn "$me check AFTER: \n". $self->_dump
1990 $self->SUPER::check;
1995 Returns a list of fields which have ship_ duplicates.
2000 qw( last first company
2001 address1 address2 city county state zip country
2006 =item has_ship_address
2008 Returns true if this customer record has a separate shipping address.
2012 sub has_ship_address {
2014 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2019 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2020 city, county, state, zip, country, and geocode. The shipping address is used if present.
2026 Returns all locations (see L<FS::cust_location>) for this customer.
2032 qsearch('cust_location', { 'custnum' => $self->custnum } );
2037 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2038 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2039 on success or a list of errors.
2045 grep { $_->unsuspend } $self->suspended_pkgs;
2050 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2052 Returns a list: an empty list on success or a list of errors.
2058 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2061 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2063 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2064 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2065 of a list of pkgparts; the hashref has the following keys:
2069 =item pkgparts - listref of pkgparts
2071 =item (other options are passed to the suspend method)
2076 Returns a list: an empty list on success or a list of errors.
2080 sub suspend_if_pkgpart {
2082 my (@pkgparts, %opt);
2083 if (ref($_[0]) eq 'HASH'){
2084 @pkgparts = @{$_[0]{pkgparts}};
2089 grep { $_->suspend(%opt) }
2090 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2091 $self->unsuspended_pkgs;
2094 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2096 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2097 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2098 instead of a list of pkgparts; the hashref has the following keys:
2102 =item pkgparts - listref of pkgparts
2104 =item (other options are passed to the suspend method)
2108 Returns a list: an empty list on success or a list of errors.
2112 sub suspend_unless_pkgpart {
2114 my (@pkgparts, %opt);
2115 if (ref($_[0]) eq 'HASH'){
2116 @pkgparts = @{$_[0]{pkgparts}};
2121 grep { $_->suspend(%opt) }
2122 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2123 $self->unsuspended_pkgs;
2126 =item cancel [ OPTION => VALUE ... ]
2128 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2130 Available options are:
2134 =item quiet - can be set true to supress email cancellation notices.
2136 =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.
2138 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2140 =item nobill - can be set true to skip billing if it might otherwise be done.
2144 Always returns a list: an empty list on success or a list of errors.
2148 # nb that dates are not specified as valid options to this method
2151 my( $self, %opt ) = @_;
2153 warn "$me cancel called on customer ". $self->custnum. " with options ".
2154 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2157 return ( 'access denied' )
2158 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2160 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2162 #should try decryption (we might have the private key)
2163 # and if not maybe queue a job for the server that does?
2164 return ( "Can't (yet) ban encrypted credit cards" )
2165 if $self->is_encrypted($self->payinfo);
2167 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2168 my $error = $ban->insert;
2169 return ( $error ) if $error;
2173 my @pkgs = $self->ncancelled_pkgs;
2175 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2177 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2178 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2182 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2183 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2186 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2189 sub _banned_pay_hashref {
2200 'payby' => $payby2ban{$self->payby},
2201 'payinfo' => md5_base64($self->payinfo),
2202 #don't ever *search* on reason! #'reason' =>
2208 Returns all notes (see L<FS::cust_main_note>) for this customer.
2215 qsearch( 'cust_main_note',
2216 { 'custnum' => $self->custnum },
2218 'ORDER BY _DATE DESC'
2224 Returns the agent (see L<FS::agent>) for this customer.
2230 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2235 Returns the agent name (see L<FS::agent>) for this customer.
2241 $self->agent->agent;
2246 Returns any tags associated with this customer, as FS::cust_tag objects,
2247 or an empty list if there are no tags.
2253 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2258 Returns any tags associated with this customer, as FS::part_tag objects,
2259 or an empty list if there are no tags.
2265 map $_->part_tag, $self->cust_tag;
2271 Returns the customer class, as an FS::cust_class object, or the empty string
2272 if there is no customer class.
2278 if ( $self->classnum ) {
2279 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2287 Returns the customer category name, or the empty string if there is no customer
2294 my $cust_class = $self->cust_class;
2296 ? $cust_class->categoryname
2302 Returns the customer class name, or the empty string if there is no customer
2309 my $cust_class = $self->cust_class;
2311 ? $cust_class->classname
2315 =item BILLING METHODS
2317 Documentation on billing methods has been moved to
2318 L<FS::cust_main::Billing>.
2320 =item REALTIME BILLING METHODS
2322 Documentation on realtime billing methods has been moved to
2323 L<FS::cust_main::Billing_Realtime>.
2327 Removes the I<paycvv> field from the database directly.
2329 If there is an error, returns the error, otherwise returns false.
2335 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2336 or return dbh->errstr;
2337 $sth->execute($self->custnum)
2338 or return $sth->errstr;
2343 =item batch_card OPTION => VALUE...
2345 Adds a payment for this invoice to the pending credit card batch (see
2346 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2347 runs the payment using a realtime gateway.
2352 my ($self, %options) = @_;
2355 if (exists($options{amount})) {
2356 $amount = $options{amount};
2358 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2360 return '' unless $amount > 0;
2362 my $invnum = delete $options{invnum};
2363 my $payby = $options{payby} || $self->payby; #still dubious
2365 if ($options{'realtime'}) {
2366 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2372 my $oldAutoCommit = $FS::UID::AutoCommit;
2373 local $FS::UID::AutoCommit = 0;
2376 #this needs to handle mysql as well as Pg, like svc_acct.pm
2377 #(make it into a common function if folks need to do batching with mysql)
2378 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2379 or return "Cannot lock pay_batch: " . $dbh->errstr;
2383 'payby' => FS::payby->payby2payment($payby),
2386 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2388 unless ( $pay_batch ) {
2389 $pay_batch = new FS::pay_batch \%pay_batch;
2390 my $error = $pay_batch->insert;
2392 $dbh->rollback if $oldAutoCommit;
2393 die "error creating new batch: $error\n";
2397 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2398 'batchnum' => $pay_batch->batchnum,
2399 'custnum' => $self->custnum,
2402 foreach (qw( address1 address2 city state zip country payby payinfo paydate
2404 $options{$_} = '' unless exists($options{$_});
2407 my $cust_pay_batch = new FS::cust_pay_batch ( {
2408 'batchnum' => $pay_batch->batchnum,
2409 'invnum' => $invnum || 0, # is there a better value?
2410 # this field should be
2412 # cust_bill_pay_batch now
2413 'custnum' => $self->custnum,
2414 'last' => $self->getfield('last'),
2415 'first' => $self->getfield('first'),
2416 'address1' => $options{address1} || $self->address1,
2417 'address2' => $options{address2} || $self->address2,
2418 'city' => $options{city} || $self->city,
2419 'state' => $options{state} || $self->state,
2420 'zip' => $options{zip} || $self->zip,
2421 'country' => $options{country} || $self->country,
2422 'payby' => $options{payby} || $self->payby,
2423 'payinfo' => $options{payinfo} || $self->payinfo,
2424 'exp' => $options{paydate} || $self->paydate,
2425 'payname' => $options{payname} || $self->payname,
2426 'amount' => $amount, # consolidating
2429 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2430 if $old_cust_pay_batch;
2433 if ($old_cust_pay_batch) {
2434 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2436 $error = $cust_pay_batch->insert;
2440 $dbh->rollback if $oldAutoCommit;
2444 my $unapplied = $self->total_unapplied_credits
2445 + $self->total_unapplied_payments
2446 + $self->in_transit_payments;
2447 foreach my $cust_bill ($self->open_cust_bill) {
2448 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2449 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2450 'invnum' => $cust_bill->invnum,
2451 'paybatchnum' => $cust_pay_batch->paybatchnum,
2452 'amount' => $cust_bill->owed,
2455 if ($unapplied >= $cust_bill_pay_batch->amount){
2456 $unapplied -= $cust_bill_pay_batch->amount;
2459 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2460 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2462 $error = $cust_bill_pay_batch->insert;
2464 $dbh->rollback if $oldAutoCommit;
2469 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2475 Returns the total owed for this customer on all invoices
2476 (see L<FS::cust_bill/owed>).
2482 $self->total_owed_date(2145859200); #12/31/2037
2485 =item total_owed_date TIME
2487 Returns the total owed for this customer on all invoices with date earlier than
2488 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2489 see L<Time::Local> and L<Date::Parse> for conversion functions.
2493 sub total_owed_date {
2497 my $custnum = $self->custnum;
2499 my $owed_sql = FS::cust_bill->owed_sql;
2502 SELECT SUM($owed_sql) FROM cust_bill
2503 WHERE custnum = $custnum
2507 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2511 =item total_owed_pkgnum PKGNUM
2513 Returns the total owed on all invoices for this customer's specific package
2514 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2518 sub total_owed_pkgnum {
2519 my( $self, $pkgnum ) = @_;
2520 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2523 =item total_owed_date_pkgnum TIME PKGNUM
2525 Returns the total owed for this customer's specific package when using
2526 experimental package balances on all invoices with date earlier than
2527 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2528 see L<Time::Local> and L<Date::Parse> for conversion functions.
2532 sub total_owed_date_pkgnum {
2533 my( $self, $time, $pkgnum ) = @_;
2536 foreach my $cust_bill (
2537 grep { $_->_date <= $time }
2538 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2540 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2542 sprintf( "%.2f", $total_bill );
2548 Returns the total amount of all payments.
2555 $total += $_->paid foreach $self->cust_pay;
2556 sprintf( "%.2f", $total );
2559 =item total_unapplied_credits
2561 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2562 customer. See L<FS::cust_credit/credited>.
2564 =item total_credited
2566 Old name for total_unapplied_credits. Don't use.
2570 sub total_credited {
2571 #carp "total_credited deprecated, use total_unapplied_credits";
2572 shift->total_unapplied_credits(@_);
2575 sub total_unapplied_credits {
2578 my $custnum = $self->custnum;
2580 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2583 SELECT SUM($unapplied_sql) FROM cust_credit
2584 WHERE custnum = $custnum
2587 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2591 =item total_unapplied_credits_pkgnum PKGNUM
2593 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2594 customer. See L<FS::cust_credit/credited>.
2598 sub total_unapplied_credits_pkgnum {
2599 my( $self, $pkgnum ) = @_;
2600 my $total_credit = 0;
2601 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2602 sprintf( "%.2f", $total_credit );
2606 =item total_unapplied_payments
2608 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2609 See L<FS::cust_pay/unapplied>.
2613 sub total_unapplied_payments {
2616 my $custnum = $self->custnum;
2618 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2621 SELECT SUM($unapplied_sql) FROM cust_pay
2622 WHERE custnum = $custnum
2625 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2629 =item total_unapplied_payments_pkgnum PKGNUM
2631 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2632 specific package when using experimental package balances. See
2633 L<FS::cust_pay/unapplied>.
2637 sub total_unapplied_payments_pkgnum {
2638 my( $self, $pkgnum ) = @_;
2639 my $total_unapplied = 0;
2640 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2641 sprintf( "%.2f", $total_unapplied );
2645 =item total_unapplied_refunds
2647 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2648 customer. See L<FS::cust_refund/unapplied>.
2652 sub total_unapplied_refunds {
2654 my $custnum = $self->custnum;
2656 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2659 SELECT SUM($unapplied_sql) FROM cust_refund
2660 WHERE custnum = $custnum
2663 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2669 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2670 total_unapplied_credits minus total_unapplied_payments).
2676 $self->balance_date_range;
2679 =item balance_date TIME
2681 Returns the balance for this customer, only considering invoices with date
2682 earlier than TIME (total_owed_date minus total_credited minus
2683 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2684 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2691 $self->balance_date_range(shift);
2694 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2696 Returns the balance for this customer, optionally considering invoices with
2697 date earlier than START_TIME, and not later than END_TIME
2698 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2700 Times are specified as SQL fragments or numeric
2701 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2702 L<Date::Parse> for conversion functions. The empty string can be passed
2703 to disable that time constraint completely.
2705 Available options are:
2709 =item unapplied_date
2711 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)
2717 sub balance_date_range {
2719 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2720 ') FROM cust_main WHERE custnum='. $self->custnum;
2721 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2724 =item balance_pkgnum PKGNUM
2726 Returns the balance for this customer's specific package when using
2727 experimental package balances (total_owed plus total_unrefunded, minus
2728 total_unapplied_credits minus total_unapplied_payments)
2732 sub balance_pkgnum {
2733 my( $self, $pkgnum ) = @_;
2736 $self->total_owed_pkgnum($pkgnum)
2737 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2738 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2739 - $self->total_unapplied_credits_pkgnum($pkgnum)
2740 - $self->total_unapplied_payments_pkgnum($pkgnum)
2744 =item in_transit_payments
2746 Returns the total of requests for payments for this customer pending in
2747 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
2751 sub in_transit_payments {
2753 my $in_transit_payments = 0;
2754 foreach my $pay_batch ( qsearch('pay_batch', {
2757 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2758 'batchnum' => $pay_batch->batchnum,
2759 'custnum' => $self->custnum,
2761 $in_transit_payments += $cust_pay_batch->amount;
2764 sprintf( "%.2f", $in_transit_payments );
2769 Returns a hash of useful information for making a payment.
2779 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2780 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2781 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2785 For credit card transactions:
2797 For electronic check transactions:
2812 $return{balance} = $self->balance;
2814 $return{payname} = $self->payname
2815 || ( $self->first. ' '. $self->get('last') );
2817 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
2819 $return{payby} = $self->payby;
2820 $return{stateid_state} = $self->stateid_state;
2822 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2823 $return{card_type} = cardtype($self->payinfo);
2824 $return{payinfo} = $self->paymask;
2826 @return{'month', 'year'} = $self->paydate_monthyear;
2830 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2831 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2832 $return{payinfo1} = $payinfo1;
2833 $return{payinfo2} = $payinfo2;
2834 $return{paytype} = $self->paytype;
2835 $return{paystate} = $self->paystate;
2839 #doubleclick protection
2841 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2847 =item paydate_monthyear
2849 Returns a two-element list consisting of the month and year of this customer's
2850 paydate (credit card expiration date for CARD customers)
2854 sub paydate_monthyear {
2856 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2858 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2865 =item tax_exemption TAXNAME
2870 my( $self, $taxname ) = @_;
2872 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2873 'taxname' => $taxname,
2878 =item cust_main_exemption
2882 sub cust_main_exemption {
2884 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
2887 =item invoicing_list [ ARRAYREF ]
2889 If an arguement is given, sets these email addresses as invoice recipients
2890 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2891 (except as warnings), so use check_invoicing_list first.
2893 Returns a list of email addresses (with svcnum entries expanded).
2895 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2896 check it without disturbing anything by passing nothing.
2898 This interface may change in the future.
2902 sub invoicing_list {
2903 my( $self, $arrayref ) = @_;
2906 my @cust_main_invoice;
2907 if ( $self->custnum ) {
2908 @cust_main_invoice =
2909 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2911 @cust_main_invoice = ();
2913 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2914 #warn $cust_main_invoice->destnum;
2915 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2916 #warn $cust_main_invoice->destnum;
2917 my $error = $cust_main_invoice->delete;
2918 warn $error if $error;
2921 if ( $self->custnum ) {
2922 @cust_main_invoice =
2923 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2925 @cust_main_invoice = ();
2927 my %seen = map { $_->address => 1 } @cust_main_invoice;
2928 foreach my $address ( @{$arrayref} ) {
2929 next if exists $seen{$address} && $seen{$address};
2930 $seen{$address} = 1;
2931 my $cust_main_invoice = new FS::cust_main_invoice ( {
2932 'custnum' => $self->custnum,
2935 my $error = $cust_main_invoice->insert;
2936 warn $error if $error;
2940 if ( $self->custnum ) {
2942 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2949 =item check_invoicing_list ARRAYREF
2951 Checks these arguements as valid input for the invoicing_list method. If there
2952 is an error, returns the error, otherwise returns false.
2956 sub check_invoicing_list {
2957 my( $self, $arrayref ) = @_;
2959 foreach my $address ( @$arrayref ) {
2961 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2962 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2965 my $cust_main_invoice = new FS::cust_main_invoice ( {
2966 'custnum' => $self->custnum,
2969 my $error = $self->custnum
2970 ? $cust_main_invoice->check
2971 : $cust_main_invoice->checkdest
2973 return $error if $error;
2977 return "Email address required"
2978 if $conf->exists('cust_main-require_invoicing_list_email')
2979 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2984 =item set_default_invoicing_list
2986 Sets the invoicing list to all accounts associated with this customer,
2987 overwriting any previous invoicing list.
2991 sub set_default_invoicing_list {
2993 $self->invoicing_list($self->all_emails);
2998 Returns the email addresses of all accounts provisioned for this customer.
3005 foreach my $cust_pkg ( $self->all_pkgs ) {
3006 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3008 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3009 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3011 $list{$_}=1 foreach map { $_->email } @svc_acct;
3016 =item invoicing_list_addpost
3018 Adds postal invoicing to this customer. If this customer is already configured
3019 to receive postal invoices, does nothing.
3023 sub invoicing_list_addpost {
3025 return if grep { $_ eq 'POST' } $self->invoicing_list;
3026 my @invoicing_list = $self->invoicing_list;
3027 push @invoicing_list, 'POST';
3028 $self->invoicing_list(\@invoicing_list);
3031 =item invoicing_list_emailonly
3033 Returns the list of email invoice recipients (invoicing_list without non-email
3034 destinations such as POST and FAX).
3038 sub invoicing_list_emailonly {
3040 warn "$me invoicing_list_emailonly called"
3042 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3045 =item invoicing_list_emailonly_scalar
3047 Returns the list of email invoice recipients (invoicing_list without non-email
3048 destinations such as POST and FAX) as a comma-separated scalar.
3052 sub invoicing_list_emailonly_scalar {
3054 warn "$me invoicing_list_emailonly_scalar called"
3056 join(', ', $self->invoicing_list_emailonly);
3059 =item referral_custnum_cust_main
3061 Returns the customer who referred this customer (or the empty string, if
3062 this customer was not referred).
3064 Note the difference with referral_cust_main method: This method,
3065 referral_custnum_cust_main returns the single customer (if any) who referred
3066 this customer, while referral_cust_main returns an array of customers referred
3071 sub referral_custnum_cust_main {
3073 return '' unless $self->referral_custnum;
3074 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3077 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3079 Returns an array of customers referred by this customer (referral_custnum set
3080 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3081 customers referred by customers referred by this customer and so on, inclusive.
3082 The default behavior is DEPTH 1 (no recursion).
3084 Note the difference with referral_custnum_cust_main method: This method,
3085 referral_cust_main, returns an array of customers referred BY this customer,
3086 while referral_custnum_cust_main returns the single customer (if any) who
3087 referred this customer.
3091 sub referral_cust_main {
3093 my $depth = @_ ? shift : 1;
3094 my $exclude = @_ ? shift : {};
3097 map { $exclude->{$_->custnum}++; $_; }
3098 grep { ! $exclude->{ $_->custnum } }
3099 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3103 map { $_->referral_cust_main($depth-1, $exclude) }
3110 =item referral_cust_main_ncancelled
3112 Same as referral_cust_main, except only returns customers with uncancelled
3117 sub referral_cust_main_ncancelled {
3119 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3122 =item referral_cust_pkg [ DEPTH ]
3124 Like referral_cust_main, except returns a flat list of all unsuspended (and
3125 uncancelled) packages for each customer. The number of items in this list may
3126 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3130 sub referral_cust_pkg {
3132 my $depth = @_ ? shift : 1;
3134 map { $_->unsuspended_pkgs }
3135 grep { $_->unsuspended_pkgs }
3136 $self->referral_cust_main($depth);
3139 =item referring_cust_main
3141 Returns the single cust_main record for the customer who referred this customer
3142 (referral_custnum), or false.
3146 sub referring_cust_main {
3148 return '' unless $self->referral_custnum;
3149 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3152 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3154 Applies a credit to this customer. If there is an error, returns the error,
3155 otherwise returns false.
3157 REASON can be a text string, an FS::reason object, or a scalar reference to
3158 a reasonnum. If a text string, it will be automatically inserted as a new
3159 reason, and a 'reason_type' option must be passed to indicate the
3160 FS::reason_type for the new reason.
3162 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3164 Any other options are passed to FS::cust_credit::insert.
3169 my( $self, $amount, $reason, %options ) = @_;
3171 my $cust_credit = new FS::cust_credit {
3172 'custnum' => $self->custnum,
3173 'amount' => $amount,
3176 if ( ref($reason) ) {
3178 if ( ref($reason) eq 'SCALAR' ) {
3179 $cust_credit->reasonnum( $$reason );
3181 $cust_credit->reasonnum( $reason->reasonnum );
3185 $cust_credit->set('reason', $reason)
3188 for (qw( addlinfo eventnum )) {
3189 $cust_credit->$_( delete $options{$_} )
3190 if exists($options{$_});
3193 $cust_credit->insert(%options);
3197 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3199 Creates a one-time charge for this customer. If there is an error, returns
3200 the error, otherwise returns false.
3202 New-style, with a hashref of options:
3204 my $error = $cust_main->charge(
3208 'start_date' => str2time('7/4/2009'),
3209 'pkg' => 'Description',
3210 'comment' => 'Comment',
3211 'additional' => [], #extra invoice detail
3212 'classnum' => 1, #pkg_class
3214 'setuptax' => '', # or 'Y' for tax exempt
3217 'taxclass' => 'Tax class',
3220 'taxproduct' => 2, #part_pkg_taxproduct
3221 'override' => {}, #XXX describe
3223 #will be filled in with the new object
3224 'cust_pkg_ref' => \$cust_pkg,
3226 #generate an invoice immediately
3228 'invoice_terms' => '', #with these terms
3234 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3240 my ( $amount, $quantity, $start_date, $classnum );
3241 my ( $pkg, $comment, $additional );
3242 my ( $setuptax, $taxclass ); #internal taxes
3243 my ( $taxproduct, $override ); #vendor (CCH) taxes
3245 my $cust_pkg_ref = '';
3246 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3247 if ( ref( $_[0] ) ) {
3248 $amount = $_[0]->{amount};
3249 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3250 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3251 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3252 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3253 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3254 : '$'. sprintf("%.2f",$amount);
3255 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3256 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3257 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3258 $additional = $_[0]->{additional} || [];
3259 $taxproduct = $_[0]->{taxproductnum};
3260 $override = { '' => $_[0]->{tax_override} };
3261 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3262 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3263 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3268 $pkg = @_ ? shift : 'One-time charge';
3269 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3271 $taxclass = @_ ? shift : '';
3275 local $SIG{HUP} = 'IGNORE';
3276 local $SIG{INT} = 'IGNORE';
3277 local $SIG{QUIT} = 'IGNORE';
3278 local $SIG{TERM} = 'IGNORE';
3279 local $SIG{TSTP} = 'IGNORE';
3280 local $SIG{PIPE} = 'IGNORE';
3282 my $oldAutoCommit = $FS::UID::AutoCommit;
3283 local $FS::UID::AutoCommit = 0;
3286 my $part_pkg = new FS::part_pkg ( {
3288 'comment' => $comment,
3292 'classnum' => ( $classnum ? $classnum : '' ),
3293 'setuptax' => $setuptax,
3294 'taxclass' => $taxclass,
3295 'taxproductnum' => $taxproduct,
3298 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3299 ( 0 .. @$additional - 1 )
3301 'additional_count' => scalar(@$additional),
3302 'setup_fee' => $amount,
3305 my $error = $part_pkg->insert( options => \%options,
3306 tax_overrides => $override,
3309 $dbh->rollback if $oldAutoCommit;
3313 my $pkgpart = $part_pkg->pkgpart;
3314 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3315 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3316 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3317 $error = $type_pkgs->insert;
3319 $dbh->rollback if $oldAutoCommit;
3324 my $cust_pkg = new FS::cust_pkg ( {
3325 'custnum' => $self->custnum,
3326 'pkgpart' => $pkgpart,
3327 'quantity' => $quantity,
3328 'start_date' => $start_date,
3329 'no_auto' => $no_auto,
3332 $error = $cust_pkg->insert;
3334 $dbh->rollback if $oldAutoCommit;
3336 } elsif ( $cust_pkg_ref ) {
3337 ${$cust_pkg_ref} = $cust_pkg;
3341 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3342 'pkg_list' => [ $cust_pkg ],
3345 $dbh->rollback if $oldAutoCommit;
3350 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3355 #=item charge_postal_fee
3357 #Applies a one time charge this customer. If there is an error,
3358 #returns the error, returns the cust_pkg charge object or false
3359 #if there was no charge.
3363 # This should be a customer event. For that to work requires that bill
3364 # also be a customer event.
3366 sub charge_postal_fee {
3369 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
3370 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3372 my $cust_pkg = new FS::cust_pkg ( {
3373 'custnum' => $self->custnum,
3374 'pkgpart' => $pkgpart,
3378 my $error = $cust_pkg->insert;
3379 $error ? $error : $cust_pkg;
3382 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3384 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3386 Optionally, a list or hashref of additional arguments to the qsearch call can
3393 my $opt = ref($_[0]) ? shift : { @_ };
3395 #return $self->num_cust_bill unless wantarray || keys %$opt;
3397 $opt->{'table'} = 'cust_bill';
3398 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3399 $opt->{'hashref'}{'custnum'} = $self->custnum;
3400 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3402 map { $_ } #behavior of sort undefined in scalar context
3403 sort { $a->_date <=> $b->_date }
3407 =item open_cust_bill
3409 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3414 sub open_cust_bill {
3418 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3424 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3426 Returns all the statements (see L<FS::cust_statement>) for this customer.
3428 Optionally, a list or hashref of additional arguments to the qsearch call can
3433 sub cust_statement {
3435 my $opt = ref($_[0]) ? shift : { @_ };
3437 #return $self->num_cust_statement unless wantarray || keys %$opt;
3439 $opt->{'table'} = 'cust_statement';
3440 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3441 $opt->{'hashref'}{'custnum'} = $self->custnum;
3442 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3444 map { $_ } #behavior of sort undefined in scalar context
3445 sort { $a->_date <=> $b->_date }
3451 Returns all the credits (see L<FS::cust_credit>) for this customer.
3457 map { $_ } #return $self->num_cust_credit unless wantarray;
3458 sort { $a->_date <=> $b->_date }
3459 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3462 =item cust_credit_pkgnum
3464 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3465 package when using experimental package balances.
3469 sub cust_credit_pkgnum {
3470 my( $self, $pkgnum ) = @_;
3471 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3472 sort { $a->_date <=> $b->_date }
3473 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3474 'pkgnum' => $pkgnum,
3481 Returns all the payments (see L<FS::cust_pay>) for this customer.
3487 return $self->num_cust_pay unless wantarray;
3488 sort { $a->_date <=> $b->_date }
3489 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3494 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3495 called automatically when the cust_pay method is used in a scalar context.
3501 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3502 my $sth = dbh->prepare($sql) or die dbh->errstr;
3503 $sth->execute($self->custnum) or die $sth->errstr;
3504 $sth->fetchrow_arrayref->[0];
3507 =item cust_pay_pkgnum
3509 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3510 package when using experimental package balances.
3514 sub cust_pay_pkgnum {
3515 my( $self, $pkgnum ) = @_;
3516 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3517 sort { $a->_date <=> $b->_date }
3518 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3519 'pkgnum' => $pkgnum,
3526 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3532 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3533 sort { $a->_date <=> $b->_date }
3534 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3537 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3539 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3541 Optionally, a list or hashref of additional arguments to the qsearch call can
3546 sub cust_pay_batch {
3548 my $opt = ref($_[0]) ? shift : { @_ };
3550 #return $self->num_cust_statement unless wantarray || keys %$opt;
3552 $opt->{'table'} = 'cust_pay_batch';
3553 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3554 $opt->{'hashref'}{'custnum'} = $self->custnum;
3555 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3557 map { $_ } #behavior of sort undefined in scalar context
3558 sort { $a->paybatchnum <=> $b->paybatchnum }
3562 =item cust_pay_pending
3564 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3565 (without status "done").
3569 sub cust_pay_pending {
3571 return $self->num_cust_pay_pending unless wantarray;
3572 sort { $a->_date <=> $b->_date }
3573 qsearch( 'cust_pay_pending', {
3574 'custnum' => $self->custnum,
3575 'status' => { op=>'!=', value=>'done' },
3580 =item cust_pay_pending_attempt
3582 Returns all payment attempts / declined payments for this customer, as pending
3583 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3584 a corresponding payment (see L<FS::cust_pay>).
3588 sub cust_pay_pending_attempt {
3590 return $self->num_cust_pay_pending_attempt unless wantarray;
3591 sort { $a->_date <=> $b->_date }
3592 qsearch( 'cust_pay_pending', {
3593 'custnum' => $self->custnum,
3600 =item num_cust_pay_pending
3602 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3603 customer (without status "done"). Also called automatically when the
3604 cust_pay_pending method is used in a scalar context.
3608 sub num_cust_pay_pending {
3611 " SELECT COUNT(*) FROM cust_pay_pending ".
3612 " WHERE custnum = ? AND status != 'done' ",
3617 =item num_cust_pay_pending_attempt
3619 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3620 customer, with status "done" but without a corresp. Also called automatically when the
3621 cust_pay_pending method is used in a scalar context.
3625 sub num_cust_pay_pending_attempt {
3628 " SELECT COUNT(*) FROM cust_pay_pending ".
3629 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3636 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3642 map { $_ } #return $self->num_cust_refund unless wantarray;
3643 sort { $a->_date <=> $b->_date }
3644 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3647 =item display_custnum
3649 Returns the displayed customer number for this customer: agent_custid if
3650 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3654 sub display_custnum {
3656 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3657 return $self->agent_custid;
3659 return $self->custnum;
3665 Returns a name string for this customer, either "Company (Last, First)" or
3672 my $name = $self->contact;
3673 $name = $self->company. " ($name)" if $self->company;
3679 Returns a name string for this (service/shipping) contact, either
3680 "Company (Last, First)" or "Last, First".
3686 if ( $self->get('ship_last') ) {
3687 my $name = $self->ship_contact;
3688 $name = $self->ship_company. " ($name)" if $self->ship_company;
3697 Returns a name string for this customer, either "Company" or "First Last".
3703 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3706 =item ship_name_short
3708 Returns a name string for this (service/shipping) contact, either "Company"
3713 sub ship_name_short {
3715 if ( $self->get('ship_last') ) {
3716 $self->ship_company !~ /^\s*$/
3717 ? $self->ship_company
3718 : $self->ship_contact_firstlast;
3720 $self->name_company_or_firstlast;
3726 Returns this customer's full (billing) contact name only, "Last, First"
3732 $self->get('last'). ', '. $self->first;
3737 Returns this customer's full (shipping) contact name only, "Last, First"
3743 $self->get('ship_last')
3744 ? $self->get('ship_last'). ', '. $self->ship_first
3748 =item contact_firstlast
3750 Returns this customers full (billing) contact name only, "First Last".
3754 sub contact_firstlast {
3756 $self->first. ' '. $self->get('last');
3759 =item ship_contact_firstlast
3761 Returns this customer's full (shipping) contact name only, "First Last".
3765 sub ship_contact_firstlast {
3767 $self->get('ship_last')
3768 ? $self->first. ' '. $self->get('ship_last')
3769 : $self->contact_firstlast;
3774 Returns this customer's full country name
3780 code2country($self->country);
3783 =item geocode DATA_VENDOR
3785 Returns a value for the customer location as encoded by DATA_VENDOR.
3786 Currently this only makes sense for "CCH" as DATA_VENDOR.
3794 Returns a status string for this customer, currently:
3798 =item prospect - No packages have ever been ordered
3800 =item ordered - Recurring packages all are new (not yet billed).
3802 =item active - One or more recurring packages is active
3804 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3806 =item suspended - All non-cancelled recurring packages are suspended
3808 =item cancelled - All recurring packages are cancelled
3814 sub status { shift->cust_status(@_); }
3818 for my $status ( FS::cust_main->statuses() ) {
3819 my $method = $status.'_sql';
3820 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3821 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3822 $sth->execute( ($self->custnum) x $numnum )
3823 or die "Error executing 'SELECT $sql': ". $sth->errstr;
3824 return $status if $sth->fetchrow_arrayref->[0];
3828 =item ucfirst_cust_status
3830 =item ucfirst_status
3832 Returns the status with the first character capitalized.
3836 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
3838 sub ucfirst_cust_status {
3840 ucfirst($self->cust_status);
3845 Returns a hex triplet color string for this customer's status.
3849 use vars qw(%statuscolor);
3850 tie %statuscolor, 'Tie::IxHash',
3851 'prospect' => '7e0079', #'000000', #black? naw, purple
3852 'active' => '00CC00', #green
3853 'ordered' => '009999', #teal? cyan?
3854 'suspended' => 'FF9900', #yellow
3855 'cancelled' => 'FF0000', #red
3856 'inactive' => '0000CC', #blue
3859 sub statuscolor { shift->cust_statuscolor(@_); }
3861 sub cust_statuscolor {
3863 $statuscolor{$self->cust_status};
3868 Returns an array of hashes representing the customer's RT tickets.
3875 my $num = $conf->config('cust_main-max_tickets') || 10;
3878 if ( $conf->config('ticket_system') ) {
3879 unless ( $conf->config('ticket_system-custom_priority_field') ) {
3881 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
3885 foreach my $priority (
3886 $conf->config('ticket_system-custom_priority_field-values'), ''
3888 last if scalar(@tickets) >= $num;
3890 @{ FS::TicketSystem->customer_tickets( $self->custnum,
3891 $num - scalar(@tickets),
3901 # Return services representing svc_accts in customer support packages
3902 sub support_services {
3904 my %packages = map { $_ => 1 } $conf->config('support_packages');
3906 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
3907 grep { $_->part_svc->svcdb eq 'svc_acct' }
3908 map { $_->cust_svc }
3909 grep { exists $packages{ $_->pkgpart } }
3910 $self->ncancelled_pkgs;
3914 # Return a list of latitude/longitude for one of the services (if any)
3915 sub service_coordinates {
3919 grep { $_->latitude && $_->longitude }
3921 map { $_->cust_svc }
3922 $self->ncancelled_pkgs;
3924 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
3929 Returns a masked version of the named field
3934 my ($self,$field) = @_;
3938 'x'x(length($self->getfield($field))-4).
3939 substr($self->getfield($field), (length($self->getfield($field))-4));
3945 =head1 CLASS METHODS
3951 Class method that returns the list of possible status strings for customers
3952 (see L<the status method|/status>). For example:
3954 @statuses = FS::cust_main->statuses();
3959 #my $self = shift; #could be class...
3963 =item cust_status_sql
3965 Returns an SQL fragment to determine the status of a cust_main record, as a
3970 sub cust_status_sql {
3972 for my $status ( FS::cust_main->statuses() ) {
3973 my $method = $status.'_sql';
3974 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
3983 Returns an SQL expression identifying prospective cust_main records (customers
3984 with no packages ever ordered)
3988 use vars qw($select_count_pkgs);
3989 $select_count_pkgs =
3990 "SELECT COUNT(*) FROM cust_pkg
3991 WHERE cust_pkg.custnum = cust_main.custnum";
3993 sub select_count_pkgs_sql {
3998 " 0 = ( $select_count_pkgs ) ";
4003 Returns an SQL expression identifying ordered cust_main records (customers with
4004 recurring packages not yet setup).
4009 FS::cust_main->none_active_sql.
4010 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
4015 Returns an SQL expression identifying active cust_main records (customers with
4016 active recurring packages).
4021 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4024 =item none_active_sql
4026 Returns an SQL expression identifying cust_main records with no active
4027 recurring packages. This includes customers of status prospect, ordered,
4028 inactive, and suspended.
4032 sub none_active_sql {
4033 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4038 Returns an SQL expression identifying inactive cust_main records (customers with
4039 no active recurring packages, but otherwise unsuspended/uncancelled).
4044 FS::cust_main->none_active_sql.
4045 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4051 Returns an SQL expression identifying suspended cust_main records.
4056 sub suspended_sql { susp_sql(@_); }
4058 FS::cust_main->none_active_sql.
4059 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4065 Returns an SQL expression identifying cancelled cust_main records.
4069 sub cancelled_sql { cancel_sql(@_); }
4072 my $recurring_sql = FS::cust_pkg->recurring_sql;
4073 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
4076 0 < ( $select_count_pkgs )
4077 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
4078 AND 0 = ( $select_count_pkgs AND $recurring_sql
4079 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4082 # AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4087 =item uncancelled_sql
4089 Returns an SQL expression identifying un-cancelled cust_main records.
4093 sub uncancelled_sql { uncancel_sql(@_); }
4094 sub uncancel_sql { "
4095 ( 0 < ( $select_count_pkgs
4096 AND ( cust_pkg.cancel IS NULL
4097 OR cust_pkg.cancel = 0
4100 OR 0 = ( $select_count_pkgs )
4106 Returns an SQL fragment to retreive the balance.
4111 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4112 WHERE cust_bill.custnum = cust_main.custnum )
4113 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4114 WHERE cust_pay.custnum = cust_main.custnum )
4115 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4116 WHERE cust_credit.custnum = cust_main.custnum )
4117 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4118 WHERE cust_refund.custnum = cust_main.custnum )
4121 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4123 Returns an SQL fragment to retreive the balance for this customer, optionally
4124 considering invoices with date earlier than START_TIME, and not
4125 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4126 total_unapplied_payments).
4128 Times are specified as SQL fragments or numeric
4129 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4130 L<Date::Parse> for conversion functions. The empty string can be passed
4131 to disable that time constraint completely.
4133 Available options are:
4137 =item unapplied_date
4139 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)
4144 set to true to remove all customer comparison clauses, for totals
4149 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4154 JOIN clause (typically used with the total option)
4158 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4159 time will be ignored. Note that START_TIME and END_TIME only limit the date
4160 range for invoices and I<unapplied> payments, credits, and refunds.
4166 sub balance_date_sql {
4167 my( $class, $start, $end, %opt ) = @_;
4169 my $cutoff = $opt{'cutoff'};
4171 my $owed = FS::cust_bill->owed_sql($cutoff);
4172 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4173 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4174 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4176 my $j = $opt{'join'} || '';
4178 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4179 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4180 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4181 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4183 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4184 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4185 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4186 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4191 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4193 Returns an SQL fragment to retreive the total unapplied payments for this
4194 customer, only considering invoices with date earlier than START_TIME, and
4195 optionally not later than END_TIME.
4197 Times are specified as SQL fragments or numeric
4198 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4199 L<Date::Parse> for conversion functions. The empty string can be passed
4200 to disable that time constraint completely.
4202 Available options are:
4206 sub unapplied_payments_date_sql {
4207 my( $class, $start, $end, %opt ) = @_;
4209 my $cutoff = $opt{'cutoff'};
4211 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4213 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4214 'unapplied_date'=>1 );
4216 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4219 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4221 Helper method for balance_date_sql; name (and usage) subject to change
4222 (suggestions welcome).
4224 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4225 cust_refund, cust_credit or cust_pay).
4227 If TABLE is "cust_bill" or the unapplied_date option is true, only
4228 considers records with date earlier than START_TIME, and optionally not
4229 later than END_TIME .
4233 sub _money_table_where {
4234 my( $class, $table, $start, $end, %opt ) = @_;
4237 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4238 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4239 push @where, "$table._date <= $start" if defined($start) && length($start);
4240 push @where, "$table._date > $end" if defined($end) && length($end);
4242 push @where, @{$opt{'where'}} if $opt{'where'};
4243 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4249 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4250 use FS::cust_main::Search;
4253 FS::cust_main::Search->search(@_);
4262 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
4266 use FS::cust_main::Search;
4267 sub append_fuzzyfiles {
4268 #my( $first, $last, $company ) = @_;
4270 FS::cust_main::Search::check_and_rebuild_fuzzyfiles();
4272 use Fcntl qw(:flock);
4274 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
4276 foreach my $field (@fuzzyfields) {
4281 open(CACHE,">>$dir/cust_main.$field")
4282 or die "can't open $dir/cust_main.$field: $!";
4283 flock(CACHE,LOCK_EX)
4284 or die "can't lock $dir/cust_main.$field: $!";
4286 print CACHE "$value\n";
4288 flock(CACHE,LOCK_UN)
4289 or die "can't unlock $dir/cust_main.$field: $!";
4304 #warn join('-',keys %$param);
4305 my $fh = $param->{filehandle};
4306 my $agentnum = $param->{agentnum};
4307 my $format = $param->{format};
4309 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4312 if ( $format eq 'simple' ) {
4313 @fields = qw( custnum agent_custid amount pkg );
4315 die "unknown format $format";
4318 eval "use Text::CSV_XS;";
4321 my $csv = new Text::CSV_XS;
4328 local $SIG{HUP} = 'IGNORE';
4329 local $SIG{INT} = 'IGNORE';
4330 local $SIG{QUIT} = 'IGNORE';
4331 local $SIG{TERM} = 'IGNORE';
4332 local $SIG{TSTP} = 'IGNORE';
4333 local $SIG{PIPE} = 'IGNORE';
4335 my $oldAutoCommit = $FS::UID::AutoCommit;
4336 local $FS::UID::AutoCommit = 0;
4339 #while ( $columns = $csv->getline($fh) ) {
4341 while ( defined($line=<$fh>) ) {
4343 $csv->parse($line) or do {
4344 $dbh->rollback if $oldAutoCommit;
4345 return "can't parse: ". $csv->error_input();
4348 my @columns = $csv->fields();
4349 #warn join('-',@columns);
4352 foreach my $field ( @fields ) {
4353 $row{$field} = shift @columns;
4356 if ( $row{custnum} && $row{agent_custid} ) {
4357 dbh->rollback if $oldAutoCommit;
4358 return "can't specify custnum with agent_custid $row{agent_custid}";
4362 if ( $row{agent_custid} && $agentnum ) {
4363 %hash = ( 'agent_custid' => $row{agent_custid},
4364 'agentnum' => $agentnum,
4368 if ( $row{custnum} ) {
4369 %hash = ( 'custnum' => $row{custnum} );
4372 unless ( scalar(keys %hash) ) {
4373 $dbh->rollback if $oldAutoCommit;
4374 return "can't find customer without custnum or agent_custid and agentnum";
4377 my $cust_main = qsearchs('cust_main', { %hash } );
4378 unless ( $cust_main ) {
4379 $dbh->rollback if $oldAutoCommit;
4380 my $custnum = $row{custnum} || $row{agent_custid};
4381 return "unknown custnum $custnum";
4384 if ( $row{'amount'} > 0 ) {
4385 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4387 $dbh->rollback if $oldAutoCommit;
4391 } elsif ( $row{'amount'} < 0 ) {
4392 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4395 $dbh->rollback if $oldAutoCommit;
4405 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4407 return "Empty file!" unless $imported;
4413 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4415 Deprecated. Use event notification and message templates
4416 (L<FS::msg_template>) instead.
4418 Sends a templated email notification to the customer (see L<Text::Template>).
4420 OPTIONS is a hash and may include
4422 I<from> - the email sender (default is invoice_from)
4424 I<to> - comma-separated scalar or arrayref of recipients
4425 (default is invoicing_list)
4427 I<subject> - The subject line of the sent email notification
4428 (default is "Notice from company_name")
4430 I<extra_fields> - a hashref of name/value pairs which will be substituted
4433 The following variables are vavailable in the template.
4435 I<$first> - the customer first name
4436 I<$last> - the customer last name
4437 I<$company> - the customer company
4438 I<$payby> - a description of the method of payment for the customer
4439 # would be nice to use FS::payby::shortname
4440 I<$payinfo> - the account information used to collect for this customer
4441 I<$expdate> - the expiration of the customer payment in seconds from epoch
4446 my ($self, $template, %options) = @_;
4448 return unless $conf->exists($template);
4450 my $from = $conf->config('invoice_from', $self->agentnum)
4451 if $conf->exists('invoice_from', $self->agentnum);
4452 $from = $options{from} if exists($options{from});
4454 my $to = join(',', $self->invoicing_list_emailonly);
4455 $to = $options{to} if exists($options{to});
4457 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4458 if $conf->exists('company_name', $self->agentnum);
4459 $subject = $options{subject} if exists($options{subject});
4461 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4462 SOURCE => [ map "$_\n",
4463 $conf->config($template)]
4465 or die "can't create new Text::Template object: Text::Template::ERROR";
4466 $notify_template->compile()
4467 or die "can't compile template: Text::Template::ERROR";
4469 $FS::notify_template::_template::company_name =
4470 $conf->config('company_name', $self->agentnum);
4471 $FS::notify_template::_template::company_address =
4472 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4474 my $paydate = $self->paydate || '2037-12-31';
4475 $FS::notify_template::_template::first = $self->first;
4476 $FS::notify_template::_template::last = $self->last;
4477 $FS::notify_template::_template::company = $self->company;
4478 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4479 my $payby = $self->payby;
4480 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4481 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4483 #credit cards expire at the end of the month/year of their exp date
4484 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4485 $FS::notify_template::_template::payby = 'credit card';
4486 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4487 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4489 }elsif ($payby eq 'COMP') {
4490 $FS::notify_template::_template::payby = 'complimentary account';
4492 $FS::notify_template::_template::payby = 'current method';
4494 $FS::notify_template::_template::expdate = $expire_time;
4496 for (keys %{$options{extra_fields}}){
4498 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4501 send_email(from => $from,
4503 subject => $subject,
4504 body => $notify_template->fill_in( PACKAGE =>
4505 'FS::notify_template::_template' ),
4510 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4512 Generates a templated notification to the customer (see L<Text::Template>).
4514 OPTIONS is a hash and may include
4516 I<extra_fields> - a hashref of name/value pairs which will be substituted
4517 into the template. These values may override values mentioned below
4518 and those from the customer record.
4520 The following variables are available in the template instead of or in addition
4521 to the fields of the customer record.
4523 I<$payby> - a description of the method of payment for the customer
4524 # would be nice to use FS::payby::shortname
4525 I<$payinfo> - the masked account information used to collect for this customer
4526 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4527 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4531 # a lot like cust_bill::print_latex
4532 sub generate_letter {
4533 my ($self, $template, %options) = @_;
4535 return unless $conf->exists($template);
4537 my $letter_template = new Text::Template
4539 SOURCE => [ map "$_\n", $conf->config($template)],
4540 DELIMITERS => [ '[@--', '--@]' ],
4542 or die "can't create new Text::Template object: Text::Template::ERROR";
4544 $letter_template->compile()
4545 or die "can't compile template: Text::Template::ERROR";
4547 my %letter_data = map { $_ => $self->$_ } $self->fields;
4548 $letter_data{payinfo} = $self->mask_payinfo;
4550 #my $paydate = $self->paydate || '2037-12-31';
4551 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4553 my $payby = $self->payby;
4554 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4555 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4557 #credit cards expire at the end of the month/year of their exp date
4558 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4559 $letter_data{payby} = 'credit card';
4560 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4561 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4563 }elsif ($payby eq 'COMP') {
4564 $letter_data{payby} = 'complimentary account';
4566 $letter_data{payby} = 'current method';
4568 $letter_data{expdate} = $expire_time;
4570 for (keys %{$options{extra_fields}}){
4571 $letter_data{$_} = $options{extra_fields}->{$_};
4574 unless(exists($letter_data{returnaddress})){
4575 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4576 $self->agent_template)
4578 if ( length($retadd) ) {
4579 $letter_data{returnaddress} = $retadd;
4580 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4581 $letter_data{returnaddress} =
4582 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4586 ( $conf->config('company_name', $self->agentnum),
4587 $conf->config('company_address', $self->agentnum),
4591 $letter_data{returnaddress} = '~';
4595 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4597 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4599 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4601 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4605 ) or die "can't open temp file: $!\n";
4606 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4607 or die "can't write temp file: $!\n";
4609 $letter_data{'logo_file'} = $lh->filename;
4611 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4615 ) or die "can't open temp file: $!\n";
4617 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4619 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4620 return ($1, $letter_data{'logo_file'});
4624 =item print_ps TEMPLATE
4626 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4632 my($file, $lfile) = $self->generate_letter(@_);
4633 my $ps = FS::Misc::generate_ps($file);
4634 unlink($file.'.tex');
4640 =item print TEMPLATE
4642 Prints the filled in template.
4644 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4648 sub queueable_print {
4651 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4652 or die "invalid customer number: " . $opt{custvnum};
4654 my $error = $self->print( $opt{template} );
4655 die $error if $error;
4659 my ($self, $template) = (shift, shift);
4660 do_print [ $self->print_ps($template) ];
4663 #these three subs should just go away once agent stuff is all config overrides
4665 sub agent_template {
4667 $self->_agent_plandata('agent_templatename');
4670 sub agent_invoice_from {
4672 $self->_agent_plandata('agent_invoice_from');
4675 sub _agent_plandata {
4676 my( $self, $option ) = @_;
4678 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4679 #agent-specific Conf
4681 use FS::part_event::Condition;
4683 my $agentnum = $self->agentnum;
4685 my $regexp = regexp_sql();
4687 my $part_event_option =
4689 'select' => 'part_event_option.*',
4690 'table' => 'part_event_option',
4692 LEFT JOIN part_event USING ( eventpart )
4693 LEFT JOIN part_event_option AS peo_agentnum
4694 ON ( part_event.eventpart = peo_agentnum.eventpart
4695 AND peo_agentnum.optionname = 'agentnum'
4696 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4698 LEFT JOIN part_event_condition
4699 ON ( part_event.eventpart = part_event_condition.eventpart
4700 AND part_event_condition.conditionname = 'cust_bill_age'
4702 LEFT JOIN part_event_condition_option
4703 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4704 AND part_event_condition_option.optionname = 'age'
4707 #'hashref' => { 'optionname' => $option },
4708 #'hashref' => { 'part_event_option.optionname' => $option },
4710 " WHERE part_event_option.optionname = ". dbh->quote($option).
4711 " AND action = 'cust_bill_send_agent' ".
4712 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4713 " AND peo_agentnum.optionname = 'agentnum' ".
4714 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4716 CASE WHEN part_event_condition_option.optionname IS NULL
4718 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4720 , part_event.weight".
4724 unless ( $part_event_option ) {
4725 return $self->agent->invoice_template || ''
4726 if $option eq 'agent_templatename';
4730 $part_event_option->optionvalue;
4734 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4736 Subroutine (not a method), designed to be called from the queue.
4738 Takes a list of options and values.
4740 Pulls up the customer record via the custnum option and calls bill_and_collect.
4745 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4747 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4748 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4750 $cust_main->bill_and_collect( %args );
4753 sub process_bill_and_collect {
4755 my $param = thaw(decode_base64(shift));
4756 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4757 or die "custnum '$param->{custnum}' not found!\n";
4758 $param->{'job'} = $job;
4759 $param->{'fatal'} = 1; # runs from job queue, will be caught
4760 $param->{'retry'} = 1;
4762 $cust_main->bill_and_collect( %$param );
4765 sub _upgrade_data { #class method
4766 my ($class, %opts) = @_;
4769 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
4770 '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',
4772 # fix yyyy-m-dd formatted paydates
4773 if ( driver_name =~ /^mysql$/i ) {
4775 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4777 else { # the SQL standard
4779 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
4782 foreach my $sql ( @statements ) {
4783 my $sth = dbh->prepare($sql) or die dbh->errstr;
4784 $sth->execute or die $sth->errstr;
4787 local($ignore_expired_card) = 1;
4788 local($ignore_illegal_zip) = 1;
4789 local($ignore_banned_card) = 1;
4790 local($skip_fuzzyfiles) = 1;
4791 $class->_upgrade_otaker(%opts);
4801 The delete method should possibly take an FS::cust_main object reference
4802 instead of a scalar customer number.
4804 Bill and collect options should probably be passed as references instead of a
4807 There should probably be a configuration file with a list of allowed credit
4810 No multiple currency support (probably a larger project than just this module).
4812 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4814 Birthdates rely on negative epoch values.
4816 The payby for card/check batches is broken. With mixed batching, bad
4819 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4823 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4824 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4825 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.