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::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
11 use vars qw( $DEBUG $me $conf
14 $ignore_expired_card $ignore_illegal_zip $ignore_banned_card
15 $skip_fuzzyfiles @fuzzyfields
19 use Scalar::Util qw( blessed );
20 use Time::Local qw(timelocal);
21 use Storable qw(thaw);
25 use Digest::MD5 qw(md5_base64);
28 use File::Temp qw( tempfile );
29 use Business::CreditCard 0.28;
31 use FS::UID qw( getotaker dbh driver_name );
32 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
33 use FS::Misc qw( generate_email send_email generate_ps do_print );
34 use FS::Msgcat qw(gettext);
41 use FS::cust_pay_pending;
42 use FS::cust_pay_void;
43 use FS::cust_pay_batch;
46 use FS::part_referral;
47 use FS::cust_main_county;
48 use FS::cust_location;
50 use FS::cust_main_exemption;
51 use FS::cust_tax_adjustment;
52 use FS::cust_tax_location;
54 use FS::cust_main_invoice;
56 use FS::prepay_credit;
62 use FS::payment_gateway;
63 use FS::agent_payment_gateway;
67 # 1 is mostly method/subroutine entry and options
68 # 2 traces progress of some operations
69 # 3 is even more information including possibly sensitive data
71 $me = '[FS::cust_main]';
74 $ignore_expired_card = 0;
75 $ignore_illegal_zip = 0;
76 $ignore_banned_card = 0;
79 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
81 @encrypted_fields = ('payinfo', 'paycvv');
82 sub nohistory_fields { ('payinfo', 'paycvv'); }
84 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
86 #ask FS::UID to run this stuff for us later
87 #$FS::UID::callback{'FS::cust_main'} = sub {
88 install_callback FS::UID sub {
90 #yes, need it for stuff below (prolly should be cached)
95 my ( $hashref, $cache ) = @_;
96 if ( exists $hashref->{'pkgnum'} ) {
97 #@{ $self->{'_pkgnum'} } = ();
98 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
99 $self->{'_pkgnum'} = $subcache;
100 #push @{ $self->{'_pkgnum'} },
101 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
107 FS::cust_main - Object methods for cust_main records
113 $record = new FS::cust_main \%hash;
114 $record = new FS::cust_main { 'column' => 'value' };
116 $error = $record->insert;
118 $error = $new_record->replace($old_record);
120 $error = $record->delete;
122 $error = $record->check;
124 @cust_pkg = $record->all_pkgs;
126 @cust_pkg = $record->ncancelled_pkgs;
128 @cust_pkg = $record->suspended_pkgs;
130 $error = $record->bill;
131 $error = $record->bill %options;
132 $error = $record->bill 'time' => $time;
134 $error = $record->collect;
135 $error = $record->collect %options;
136 $error = $record->collect 'invoice_time' => $time,
141 An FS::cust_main object represents a customer. FS::cust_main inherits from
142 FS::Record. The following fields are currently supported:
148 Primary key (assigned automatically for new customers)
152 Agent (see L<FS::agent>)
156 Advertising source (see L<FS::part_referral>)
168 Cocial security number (optional)
184 (optional, see L<FS::cust_main_county>)
188 (see L<FS::cust_main_county>)
194 (see L<FS::cust_main_county>)
230 (optional, see L<FS::cust_main_county>)
234 (see L<FS::cust_main_county>)
240 (see L<FS::cust_main_county>)
256 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
260 Payment Information (See L<FS::payinfo_Mixin> for data format)
264 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
268 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
272 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
276 Start date month (maestro/solo cards only)
280 Start date year (maestro/solo cards only)
284 Issue number (maestro/solo cards only)
288 Name on card or billing name
292 IP address from which payment information was received
296 Tax exempt, empty or `Y'
300 Order taker (see L<FS::access_user>)
306 =item referral_custnum
308 Referring customer number
312 Enable individual CDR spooling, empty or `Y'
316 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
320 Discourage individual CDR printing, empty or `Y'
330 Creates a new customer. To add the customer to the database, see L<"insert">.
332 Note that this stores the hash reference, not a distinct copy of the hash it
333 points to. You can ask the object for a copy with the I<hash> method.
337 sub table { 'cust_main'; }
339 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
341 Adds this customer to the database. If there is an error, returns the error,
342 otherwise returns false.
344 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
345 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
346 are inserted atomicly, or the transaction is rolled back. Passing an empty
347 hash reference is equivalent to not supplying this parameter. There should be
348 a better explanation of this, but until then, here's an example:
351 tie %hash, 'Tie::RefHash'; #this part is important
353 $cust_pkg => [ $svc_acct ],
356 $cust_main->insert( \%hash );
358 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
359 be set as the invoicing list (see L<"invoicing_list">). Errors return as
360 expected and rollback the entire transaction; it is not necessary to call
361 check_invoicing_list first. The invoicing_list is set after the records in the
362 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
363 invoicing_list destination to the newly-created svc_acct. Here's an example:
365 $cust_main->insert( {}, [ $email, 'POST' ] );
367 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
369 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
370 on the supplied jobnum (they will not run until the specific job completes).
371 This can be used to defer provisioning until some action completes (such
372 as running the customer's credit card successfully).
374 The I<noexport> option is deprecated. If I<noexport> is set true, no
375 provisioning jobs (exports) are scheduled. (You can schedule them later with
376 the B<reexport> method.)
378 The I<tax_exemption> option can be set to an arrayref of tax names.
379 FS::cust_main_exemption records will be created and inserted.
385 my $cust_pkgs = @_ ? shift : {};
386 my $invoicing_list = @_ ? shift : '';
388 warn "$me insert called with options ".
389 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
392 local $SIG{HUP} = 'IGNORE';
393 local $SIG{INT} = 'IGNORE';
394 local $SIG{QUIT} = 'IGNORE';
395 local $SIG{TERM} = 'IGNORE';
396 local $SIG{TSTP} = 'IGNORE';
397 local $SIG{PIPE} = 'IGNORE';
399 my $oldAutoCommit = $FS::UID::AutoCommit;
400 local $FS::UID::AutoCommit = 0;
403 my $prepay_identifier = '';
404 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
406 if ( $self->payby eq 'PREPAY' ) {
408 $self->payby('BILL');
409 $prepay_identifier = $self->payinfo;
412 warn " looking up prepaid card $prepay_identifier\n"
415 my $error = $self->get_prepay( $prepay_identifier,
416 'amount_ref' => \$amount,
417 'seconds_ref' => \$seconds,
418 'upbytes_ref' => \$upbytes,
419 'downbytes_ref' => \$downbytes,
420 'totalbytes_ref' => \$totalbytes,
423 $dbh->rollback if $oldAutoCommit;
424 #return "error applying prepaid card (transaction rolled back): $error";
428 $payby = 'PREP' if $amount;
430 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
433 $self->payby('BILL');
434 $amount = $self->paid;
438 warn " inserting $self\n"
441 $self->signupdate(time) unless $self->signupdate;
443 $self->auto_agent_custid()
444 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
446 my $error = $self->SUPER::insert;
448 $dbh->rollback if $oldAutoCommit;
449 #return "inserting cust_main record (transaction rolled back): $error";
453 warn " setting invoicing list\n"
456 if ( $invoicing_list ) {
457 $error = $self->check_invoicing_list( $invoicing_list );
459 $dbh->rollback if $oldAutoCommit;
460 #return "checking invoicing_list (transaction rolled back): $error";
463 $self->invoicing_list( $invoicing_list );
466 warn " setting customer tags\n"
469 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
470 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
471 'custnum' => $self->custnum };
472 my $error = $cust_tag->insert;
474 $dbh->rollback if $oldAutoCommit;
479 if ( $invoicing_list ) {
480 $error = $self->check_invoicing_list( $invoicing_list );
482 $dbh->rollback if $oldAutoCommit;
483 #return "checking invoicing_list (transaction rolled back): $error";
486 $self->invoicing_list( $invoicing_list );
490 warn " setting cust_main_exemption\n"
493 my $tax_exemption = delete $options{'tax_exemption'};
494 if ( $tax_exemption ) {
495 foreach my $taxname ( @$tax_exemption ) {
496 my $cust_main_exemption = new FS::cust_main_exemption {
497 'custnum' => $self->custnum,
498 'taxname' => $taxname,
500 my $error = $cust_main_exemption->insert;
502 $dbh->rollback if $oldAutoCommit;
503 return "inserting cust_main_exemption (transaction rolled back): $error";
508 if ( $self->can('start_copy_skel') ) {
509 my $error = $self->start_copy_skel;
511 $dbh->rollback if $oldAutoCommit;
516 warn " ordering packages\n"
519 $error = $self->order_pkgs( $cust_pkgs,
521 'seconds_ref' => \$seconds,
522 'upbytes_ref' => \$upbytes,
523 'downbytes_ref' => \$downbytes,
524 'totalbytes_ref' => \$totalbytes,
527 $dbh->rollback if $oldAutoCommit;
532 $dbh->rollback if $oldAutoCommit;
533 return "No svc_acct record to apply pre-paid time";
535 if ( $upbytes || $downbytes || $totalbytes ) {
536 $dbh->rollback if $oldAutoCommit;
537 return "No svc_acct record to apply pre-paid data";
541 warn " inserting initial $payby payment of $amount\n"
543 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
545 $dbh->rollback if $oldAutoCommit;
546 return "inserting payment (transaction rolled back): $error";
550 unless ( $import || $skip_fuzzyfiles ) {
551 warn " queueing fuzzyfiles update\n"
553 $error = $self->queue_fuzzyfiles_update;
555 $dbh->rollback if $oldAutoCommit;
556 return "updating fuzzy search cache: $error";
561 warn " exporting\n" if $DEBUG > 1;
563 my $export_args = $options{'export_args'} || [];
566 map qsearch( 'part_export', {exportnum=>$_} ),
567 $conf->config('cust_main-exports'); #, $agentnum
569 foreach my $part_export ( @part_export ) {
570 my $error = $part_export->export_insert($self, @$export_args);
572 $dbh->rollback if $oldAutoCommit;
573 return "exporting to ". $part_export->exporttype.
574 " (transaction rolled back): $error";
578 #foreach my $depend_jobnum ( @$depend_jobnums ) {
579 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
581 # foreach my $jobnum ( @jobnums ) {
582 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
583 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
585 # my $error = $queue->depend_insert($depend_jobnum);
587 # $dbh->rollback if $oldAutoCommit;
588 # return "error queuing job dependancy: $error";
595 #if ( exists $options{'jobnums'} ) {
596 # push @{ $options{'jobnums'} }, @jobnums;
599 warn " insert complete; committing transaction\n"
602 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
607 use File::CounterFile;
608 sub auto_agent_custid {
611 my $format = $conf->config('cust_main-auto_agent_custid');
613 if ( $format eq '1YMMXXXXXXXX' ) {
615 my $counter = new File::CounterFile 'cust_main.agent_custid';
618 my $ym = 100000000000 + time2str('%y%m00000000', time);
619 if ( $ym > $counter->value ) {
620 $counter->{'value'} = $agent_custid = $ym;
621 $counter->{'updated'} = 1;
623 $agent_custid = $counter->inc;
629 die "Unknown cust_main-auto_agent_custid format: $format";
632 $self->agent_custid($agent_custid);
636 =item PACKAGE METHODS
638 Documentation on customer package methods has been moved to
639 L<FS::cust_main::Packages>.
641 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
643 Recharges this (existing) customer with the specified prepaid card (see
644 L<FS::prepay_credit>), specified either by I<identifier> or as an
645 FS::prepay_credit object. If there is an error, returns the error, otherwise
648 Optionally, five scalar references can be passed as well. They will have their
649 values filled in with the amount, number of seconds, and number of upload,
650 download, and total bytes applied by this prepaid card.
654 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
655 #the only place that uses these args
656 sub recharge_prepay {
657 my( $self, $prepay_credit, $amountref, $secondsref,
658 $upbytesref, $downbytesref, $totalbytesref ) = @_;
660 local $SIG{HUP} = 'IGNORE';
661 local $SIG{INT} = 'IGNORE';
662 local $SIG{QUIT} = 'IGNORE';
663 local $SIG{TERM} = 'IGNORE';
664 local $SIG{TSTP} = 'IGNORE';
665 local $SIG{PIPE} = 'IGNORE';
667 my $oldAutoCommit = $FS::UID::AutoCommit;
668 local $FS::UID::AutoCommit = 0;
671 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
673 my $error = $self->get_prepay( $prepay_credit,
674 'amount_ref' => \$amount,
675 'seconds_ref' => \$seconds,
676 'upbytes_ref' => \$upbytes,
677 'downbytes_ref' => \$downbytes,
678 'totalbytes_ref' => \$totalbytes,
680 || $self->increment_seconds($seconds)
681 || $self->increment_upbytes($upbytes)
682 || $self->increment_downbytes($downbytes)
683 || $self->increment_totalbytes($totalbytes)
684 || $self->insert_cust_pay_prepay( $amount,
686 ? $prepay_credit->identifier
691 $dbh->rollback if $oldAutoCommit;
695 if ( defined($amountref) ) { $$amountref = $amount; }
696 if ( defined($secondsref) ) { $$secondsref = $seconds; }
697 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
698 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
699 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
701 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
706 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
708 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
709 specified either by I<identifier> or as an FS::prepay_credit object.
711 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
712 incremented by the values of the prepaid card.
714 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
715 check or set this customer's I<agentnum>.
717 If there is an error, returns the error, otherwise returns false.
723 my( $self, $prepay_credit, %opt ) = @_;
725 local $SIG{HUP} = 'IGNORE';
726 local $SIG{INT} = 'IGNORE';
727 local $SIG{QUIT} = 'IGNORE';
728 local $SIG{TERM} = 'IGNORE';
729 local $SIG{TSTP} = 'IGNORE';
730 local $SIG{PIPE} = 'IGNORE';
732 my $oldAutoCommit = $FS::UID::AutoCommit;
733 local $FS::UID::AutoCommit = 0;
736 unless ( ref($prepay_credit) ) {
738 my $identifier = $prepay_credit;
740 $prepay_credit = qsearchs(
742 { 'identifier' => $prepay_credit },
747 unless ( $prepay_credit ) {
748 $dbh->rollback if $oldAutoCommit;
749 return "Invalid prepaid card: ". $identifier;
754 if ( $prepay_credit->agentnum ) {
755 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
756 $dbh->rollback if $oldAutoCommit;
757 return "prepaid card not valid for agent ". $self->agentnum;
759 $self->agentnum($prepay_credit->agentnum);
762 my $error = $prepay_credit->delete;
764 $dbh->rollback if $oldAutoCommit;
765 return "removing prepay_credit (transaction rolled back): $error";
768 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
769 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
771 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
776 =item increment_upbytes SECONDS
778 Updates this customer's single or primary account (see L<FS::svc_acct>) by
779 the specified number of upbytes. If there is an error, returns the error,
780 otherwise returns false.
784 sub increment_upbytes {
785 _increment_column( shift, 'upbytes', @_);
788 =item increment_downbytes SECONDS
790 Updates this customer's single or primary account (see L<FS::svc_acct>) by
791 the specified number of downbytes. If there is an error, returns the error,
792 otherwise returns false.
796 sub increment_downbytes {
797 _increment_column( shift, 'downbytes', @_);
800 =item increment_totalbytes SECONDS
802 Updates this customer's single or primary account (see L<FS::svc_acct>) by
803 the specified number of totalbytes. If there is an error, returns the error,
804 otherwise returns false.
808 sub increment_totalbytes {
809 _increment_column( shift, 'totalbytes', @_);
812 =item increment_seconds SECONDS
814 Updates this customer's single or primary account (see L<FS::svc_acct>) by
815 the specified number of seconds. If there is an error, returns the error,
816 otherwise returns false.
820 sub increment_seconds {
821 _increment_column( shift, 'seconds', @_);
824 =item _increment_column AMOUNT
826 Updates this customer's single or primary account (see L<FS::svc_acct>) by
827 the specified number of seconds or bytes. If there is an error, returns
828 the error, otherwise returns false.
832 sub _increment_column {
833 my( $self, $column, $amount ) = @_;
834 warn "$me increment_column called: $column, $amount\n"
837 return '' unless $amount;
839 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
840 $self->ncancelled_pkgs;
843 return 'No packages with primary or single services found'.
844 ' to apply pre-paid time';
845 } elsif ( scalar(@cust_pkg) > 1 ) {
846 #maybe have a way to specify the package/account?
847 return 'Multiple packages found to apply pre-paid time';
850 my $cust_pkg = $cust_pkg[0];
851 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
855 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
858 return 'No account found to apply pre-paid time';
859 } elsif ( scalar(@cust_svc) > 1 ) {
860 return 'Multiple accounts found to apply pre-paid time';
863 my $svc_acct = $cust_svc[0]->svc_x;
864 warn " found service svcnum ". $svc_acct->pkgnum.
865 ' ('. $svc_acct->email. ")\n"
868 $column = "increment_$column";
869 $svc_acct->$column($amount);
873 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
875 Inserts a prepayment in the specified amount for this customer. An optional
876 second argument can specify the prepayment identifier for tracking purposes.
877 If there is an error, returns the error, otherwise returns false.
881 sub insert_cust_pay_prepay {
882 shift->insert_cust_pay('PREP', @_);
885 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
887 Inserts a cash payment in the specified amount for this customer. An optional
888 second argument can specify the payment identifier for tracking purposes.
889 If there is an error, returns the error, otherwise returns false.
893 sub insert_cust_pay_cash {
894 shift->insert_cust_pay('CASH', @_);
897 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
899 Inserts a Western Union payment in the specified amount for this customer. An
900 optional second argument can specify the prepayment identifier for tracking
901 purposes. If there is an error, returns the error, otherwise returns false.
905 sub insert_cust_pay_west {
906 shift->insert_cust_pay('WEST', @_);
909 sub insert_cust_pay {
910 my( $self, $payby, $amount ) = splice(@_, 0, 3);
911 my $payinfo = scalar(@_) ? shift : '';
913 my $cust_pay = new FS::cust_pay {
914 'custnum' => $self->custnum,
915 'paid' => sprintf('%.2f', $amount),
916 #'_date' => #date the prepaid card was purchased???
918 'payinfo' => $payinfo,
926 This method is deprecated. See the I<depend_jobnum> option to the insert and
927 order_pkgs methods for a better way to defer provisioning.
929 Re-schedules all exports by calling the B<reexport> method of all associated
930 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
931 otherwise returns false.
938 carp "WARNING: FS::cust_main::reexport is deprectated; ".
939 "use the depend_jobnum option to insert or order_pkgs to delay export";
941 local $SIG{HUP} = 'IGNORE';
942 local $SIG{INT} = 'IGNORE';
943 local $SIG{QUIT} = 'IGNORE';
944 local $SIG{TERM} = 'IGNORE';
945 local $SIG{TSTP} = 'IGNORE';
946 local $SIG{PIPE} = 'IGNORE';
948 my $oldAutoCommit = $FS::UID::AutoCommit;
949 local $FS::UID::AutoCommit = 0;
952 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
953 my $error = $cust_pkg->reexport;
955 $dbh->rollback if $oldAutoCommit;
960 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
965 =item delete [ OPTION => VALUE ... ]
967 This deletes the customer. If there is an error, returns the error, otherwise
970 This will completely remove all traces of the customer record. This is not
971 what you want when a customer cancels service; for that, cancel all of the
972 customer's packages (see L</cancel>).
974 If the customer has any uncancelled packages, you need to pass a new (valid)
975 customer number for those packages to be transferred to, as the "new_customer"
976 option. Cancelled packages will be deleted. Did I mention that this is NOT
977 what you want when a customer cancels service and that you really should be
978 looking at L<FS::cust_pkg/cancel>?
980 You can't delete a customer with invoices (see L<FS::cust_bill>),
981 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
982 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
983 set the "delete_financials" option to a true value.
988 my( $self, %opt ) = @_;
990 local $SIG{HUP} = 'IGNORE';
991 local $SIG{INT} = 'IGNORE';
992 local $SIG{QUIT} = 'IGNORE';
993 local $SIG{TERM} = 'IGNORE';
994 local $SIG{TSTP} = 'IGNORE';
995 local $SIG{PIPE} = 'IGNORE';
997 my $oldAutoCommit = $FS::UID::AutoCommit;
998 local $FS::UID::AutoCommit = 0;
1001 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1002 $dbh->rollback if $oldAutoCommit;
1003 return "Can't delete a master agent customer";
1006 #use FS::access_user
1007 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1008 $dbh->rollback if $oldAutoCommit;
1009 return "Can't delete a master employee customer";
1012 tie my %financial_tables, 'Tie::IxHash',
1013 'cust_bill' => 'invoices',
1014 'cust_statement' => 'statements',
1015 'cust_credit' => 'credits',
1016 'cust_pay' => 'payments',
1017 'cust_refund' => 'refunds',
1020 foreach my $table ( keys %financial_tables ) {
1022 my @records = $self->$table();
1024 if ( @records && ! $opt{'delete_financials'} ) {
1025 $dbh->rollback if $oldAutoCommit;
1026 return "Can't delete a customer with ". $financial_tables{$table};
1029 foreach my $record ( @records ) {
1030 my $error = $record->delete;
1032 $dbh->rollback if $oldAutoCommit;
1033 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1039 my @cust_pkg = $self->ncancelled_pkgs;
1041 my $new_custnum = $opt{'new_custnum'};
1042 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1043 $dbh->rollback if $oldAutoCommit;
1044 return "Invalid new customer number: $new_custnum";
1046 foreach my $cust_pkg ( @cust_pkg ) {
1047 my %hash = $cust_pkg->hash;
1048 $hash{'custnum'} = $new_custnum;
1049 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1050 my $error = $new_cust_pkg->replace($cust_pkg,
1051 options => { $cust_pkg->options },
1054 $dbh->rollback if $oldAutoCommit;
1059 my @cancelled_cust_pkg = $self->all_pkgs;
1060 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1061 my $error = $cust_pkg->delete;
1063 $dbh->rollback if $oldAutoCommit;
1068 #cust_tax_adjustment in financials?
1069 #cust_pay_pending? ouch
1071 foreach my $table (qw(
1072 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1073 cust_location cust_main_note cust_tax_adjustment
1074 cust_pay_void cust_pay_batch queue cust_tax_exempt
1076 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1077 my $error = $record->delete;
1079 $dbh->rollback if $oldAutoCommit;
1085 my $sth = $dbh->prepare(
1086 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1088 my $errstr = $dbh->errstr;
1089 $dbh->rollback if $oldAutoCommit;
1092 $sth->execute($self->custnum) or do {
1093 my $errstr = $sth->errstr;
1094 $dbh->rollback if $oldAutoCommit;
1100 my $ticket_dbh = '';
1101 if ($conf->config('ticket_system') eq 'RT_Internal') {
1103 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1104 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1105 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1106 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1109 if ( $ticket_dbh ) {
1111 my $ticket_sth = $ticket_dbh->prepare(
1112 'DELETE FROM Links WHERE Target = ?'
1114 my $errstr = $ticket_dbh->errstr;
1115 $dbh->rollback if $oldAutoCommit;
1118 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1120 my $errstr = $ticket_sth->errstr;
1121 $dbh->rollback if $oldAutoCommit;
1125 #check and see if the customer is the only link on the ticket, and
1126 #if so, set the ticket to deleted status in RT?
1127 #maybe someday, for now this will at least fix tickets not displaying
1131 #delete the customer record
1133 my $error = $self->SUPER::delete;
1135 $dbh->rollback if $oldAutoCommit;
1139 # cust_main exports!
1141 #my $export_args = $options{'export_args'} || [];
1144 map qsearch( 'part_export', {exportnum=>$_} ),
1145 $conf->config('cust_main-exports'); #, $agentnum
1147 foreach my $part_export ( @part_export ) {
1148 my $error = $part_export->export_delete( $self ); #, @$export_args);
1150 $dbh->rollback if $oldAutoCommit;
1151 return "exporting to ". $part_export->exporttype.
1152 " (transaction rolled back): $error";
1156 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1161 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1164 Replaces the OLD_RECORD with this one in the database. If there is an error,
1165 returns the error, otherwise returns false.
1167 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1168 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1169 expected and rollback the entire transaction; it is not necessary to call
1170 check_invoicing_list first. Here's an example:
1172 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1174 Currently available options are: I<tax_exemption>.
1176 The I<tax_exemption> option can be set to an arrayref of tax names.
1177 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1184 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1186 : $self->replace_old;
1190 warn "$me replace called\n"
1193 my $curuser = $FS::CurrentUser::CurrentUser;
1194 if ( $self->payby eq 'COMP'
1195 && $self->payby ne $old->payby
1196 && ! $curuser->access_right('Complimentary customer')
1199 return "You are not permitted to create complimentary accounts.";
1202 local($ignore_expired_card) = 1
1203 if $old->payby =~ /^(CARD|DCRD)$/
1204 && $self->payby =~ /^(CARD|DCRD)$/
1205 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1207 local $SIG{HUP} = 'IGNORE';
1208 local $SIG{INT} = 'IGNORE';
1209 local $SIG{QUIT} = 'IGNORE';
1210 local $SIG{TERM} = 'IGNORE';
1211 local $SIG{TSTP} = 'IGNORE';
1212 local $SIG{PIPE} = 'IGNORE';
1214 my $oldAutoCommit = $FS::UID::AutoCommit;
1215 local $FS::UID::AutoCommit = 0;
1218 my $error = $self->SUPER::replace($old);
1221 $dbh->rollback if $oldAutoCommit;
1225 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1226 my $invoicing_list = shift @param;
1227 $error = $self->check_invoicing_list( $invoicing_list );
1229 $dbh->rollback if $oldAutoCommit;
1232 $self->invoicing_list( $invoicing_list );
1235 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1237 #this could be more efficient than deleting and re-inserting, if it matters
1238 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1239 my $error = $cust_tag->delete;
1241 $dbh->rollback if $oldAutoCommit;
1245 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1246 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1247 'custnum' => $self->custnum };
1248 my $error = $cust_tag->insert;
1250 $dbh->rollback if $oldAutoCommit;
1257 my %options = @param;
1259 my $tax_exemption = delete $options{'tax_exemption'};
1260 if ( $tax_exemption ) {
1262 my %cust_main_exemption =
1263 map { $_->taxname => $_ }
1264 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1266 foreach my $taxname ( @$tax_exemption ) {
1268 next if delete $cust_main_exemption{$taxname};
1270 my $cust_main_exemption = new FS::cust_main_exemption {
1271 'custnum' => $self->custnum,
1272 'taxname' => $taxname,
1274 my $error = $cust_main_exemption->insert;
1276 $dbh->rollback if $oldAutoCommit;
1277 return "inserting cust_main_exemption (transaction rolled back): $error";
1281 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1282 my $error = $cust_main_exemption->delete;
1284 $dbh->rollback if $oldAutoCommit;
1285 return "deleting cust_main_exemption (transaction rolled back): $error";
1291 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1292 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1293 && $self->get('payinfo') !~ /^99\d{14}$/
1295 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1300 # card/check/lec info has changed, want to retry realtime_ invoice events
1301 my $error = $self->retry_realtime;
1303 $dbh->rollback if $oldAutoCommit;
1308 unless ( $import || $skip_fuzzyfiles ) {
1309 $error = $self->queue_fuzzyfiles_update;
1311 $dbh->rollback if $oldAutoCommit;
1312 return "updating fuzzy search cache: $error";
1316 # cust_main exports!
1318 my $export_args = $options{'export_args'} || [];
1321 map qsearch( 'part_export', {exportnum=>$_} ),
1322 $conf->config('cust_main-exports'); #, $agentnum
1324 foreach my $part_export ( @part_export ) {
1325 my $error = $part_export->export_replace( $self, $old, @$export_args);
1327 $dbh->rollback if $oldAutoCommit;
1328 return "exporting to ". $part_export->exporttype.
1329 " (transaction rolled back): $error";
1333 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1338 =item queue_fuzzyfiles_update
1340 Used by insert & replace to update the fuzzy search cache
1344 sub queue_fuzzyfiles_update {
1347 local $SIG{HUP} = 'IGNORE';
1348 local $SIG{INT} = 'IGNORE';
1349 local $SIG{QUIT} = 'IGNORE';
1350 local $SIG{TERM} = 'IGNORE';
1351 local $SIG{TSTP} = 'IGNORE';
1352 local $SIG{PIPE} = 'IGNORE';
1354 my $oldAutoCommit = $FS::UID::AutoCommit;
1355 local $FS::UID::AutoCommit = 0;
1358 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1359 my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1361 $dbh->rollback if $oldAutoCommit;
1362 return "queueing job (transaction rolled back): $error";
1365 if ( $self->ship_last ) {
1366 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1367 $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1369 $dbh->rollback if $oldAutoCommit;
1370 return "queueing job (transaction rolled back): $error";
1374 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1381 Checks all fields to make sure this is a valid customer record. If there is
1382 an error, returns the error, otherwise returns false. Called by the insert
1383 and replace methods.
1390 warn "$me check BEFORE: \n". $self->_dump
1394 $self->ut_numbern('custnum')
1395 || $self->ut_number('agentnum')
1396 || $self->ut_textn('agent_custid')
1397 || $self->ut_number('refnum')
1398 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1399 || $self->ut_textn('custbatch')
1400 || $self->ut_name('last')
1401 || $self->ut_name('first')
1402 || $self->ut_snumbern('birthdate')
1403 || $self->ut_snumbern('signupdate')
1404 || $self->ut_textn('company')
1405 || $self->ut_text('address1')
1406 || $self->ut_textn('address2')
1407 || $self->ut_text('city')
1408 || $self->ut_textn('county')
1409 || $self->ut_textn('state')
1410 || $self->ut_country('country')
1411 || $self->ut_anything('comments')
1412 || $self->ut_numbern('referral_custnum')
1413 || $self->ut_textn('stateid')
1414 || $self->ut_textn('stateid_state')
1415 || $self->ut_textn('invoice_terms')
1416 || $self->ut_alphan('geocode')
1417 || $self->ut_floatn('cdr_termination_percentage')
1420 #barf. need message catalogs. i18n. etc.
1421 $error .= "Please select an advertising source."
1422 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1423 return $error if $error;
1425 return "Unknown agent"
1426 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1428 return "Unknown refnum"
1429 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1431 return "Unknown referring custnum: ". $self->referral_custnum
1432 unless ! $self->referral_custnum
1433 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1435 if ( $self->censustract ne '' ) {
1436 $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1437 or return "Illegal census tract: ". $self->censustract;
1439 $self->censustract("$1.$2");
1442 if ( $self->ss eq '' ) {
1447 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1448 or return "Illegal social security number: ". $self->ss;
1449 $self->ss("$1-$2-$3");
1453 # bad idea to disable, causes billing to fail because of no tax rates later
1454 # except we don't fail any more
1455 unless ( $import ) {
1456 unless ( qsearch('cust_main_county', {
1457 'country' => $self->country,
1460 return "Unknown state/county/country: ".
1461 $self->state. "/". $self->county. "/". $self->country
1462 unless qsearch('cust_main_county',{
1463 'state' => $self->state,
1464 'county' => $self->county,
1465 'country' => $self->country,
1471 $self->ut_phonen('daytime', $self->country)
1472 || $self->ut_phonen('night', $self->country)
1473 || $self->ut_phonen('fax', $self->country)
1475 return $error if $error;
1477 unless ( $ignore_illegal_zip ) {
1478 $error = $self->ut_zip('zip', $self->country);
1479 return $error if $error;
1482 if ( $conf->exists('cust_main-require_phone')
1483 && ! length($self->daytime) && ! length($self->night)
1486 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1488 : FS::Msgcat::_gettext('daytime');
1489 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1491 : FS::Msgcat::_gettext('night');
1493 return "$daytime_label or $night_label is required"
1497 if ( $self->has_ship_address
1498 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1499 $self->addr_fields )
1503 $self->ut_name('ship_last')
1504 || $self->ut_name('ship_first')
1505 || $self->ut_textn('ship_company')
1506 || $self->ut_text('ship_address1')
1507 || $self->ut_textn('ship_address2')
1508 || $self->ut_text('ship_city')
1509 || $self->ut_textn('ship_county')
1510 || $self->ut_textn('ship_state')
1511 || $self->ut_country('ship_country')
1513 return $error if $error;
1515 #false laziness with above
1516 unless ( qsearchs('cust_main_county', {
1517 'country' => $self->ship_country,
1520 return "Unknown ship_state/ship_county/ship_country: ".
1521 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1522 unless qsearch('cust_main_county',{
1523 'state' => $self->ship_state,
1524 'county' => $self->ship_county,
1525 'country' => $self->ship_country,
1531 $self->ut_phonen('ship_daytime', $self->ship_country)
1532 || $self->ut_phonen('ship_night', $self->ship_country)
1533 || $self->ut_phonen('ship_fax', $self->ship_country)
1535 return $error if $error;
1537 unless ( $ignore_illegal_zip ) {
1538 $error = $self->ut_zip('ship_zip', $self->ship_country);
1539 return $error if $error;
1541 return "Unit # is required."
1542 if $self->ship_address2 =~ /^\s*$/
1543 && $conf->exists('cust_main-require_address2');
1545 } else { # ship_ info eq billing info, so don't store dup info in database
1547 $self->setfield("ship_$_", '')
1548 foreach $self->addr_fields;
1550 return "Unit # is required."
1551 if $self->address2 =~ /^\s*$/
1552 && $conf->exists('cust_main-require_address2');
1556 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1557 # or return "Illegal payby: ". $self->payby;
1559 FS::payby->can_payby($self->table, $self->payby)
1560 or return "Illegal payby: ". $self->payby;
1562 $error = $self->ut_numbern('paystart_month')
1563 || $self->ut_numbern('paystart_year')
1564 || $self->ut_numbern('payissue')
1565 || $self->ut_textn('paytype')
1567 return $error if $error;
1569 if ( $self->payip eq '' ) {
1572 $error = $self->ut_ip('payip');
1573 return $error if $error;
1576 # If it is encrypted and the private key is not availaible then we can't
1577 # check the credit card.
1578 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1580 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1582 my $payinfo = $self->payinfo;
1583 $payinfo =~ s/\D//g;
1584 $payinfo =~ /^(\d{13,16})$/
1585 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1587 $self->payinfo($payinfo);
1589 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1591 return gettext('unknown_card_type')
1592 if $self->payinfo !~ /^99\d{14}$/ #token
1593 && cardtype($self->payinfo) eq "Unknown";
1595 unless ( $ignore_banned_card ) {
1596 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1598 return 'Banned credit card: banned on '.
1599 time2str('%a %h %o at %r', $ban->_date).
1600 ' by '. $ban->otaker.
1601 ' (ban# '. $ban->bannum. ')';
1605 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1606 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1607 $self->paycvv =~ /^(\d{4})$/
1608 or return "CVV2 (CID) for American Express cards is four digits.";
1611 $self->paycvv =~ /^(\d{3})$/
1612 or return "CVV2 (CVC2/CID) is three digits.";
1619 my $cardtype = cardtype($payinfo);
1620 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1622 return "Start date or issue number is required for $cardtype cards"
1623 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1625 return "Start month must be between 1 and 12"
1626 if $self->paystart_month
1627 and $self->paystart_month < 1 || $self->paystart_month > 12;
1629 return "Start year must be 1990 or later"
1630 if $self->paystart_year
1631 and $self->paystart_year < 1990;
1633 return "Issue number must be beween 1 and 99"
1635 and $self->payissue < 1 || $self->payissue > 99;
1638 $self->paystart_month('');
1639 $self->paystart_year('');
1640 $self->payissue('');
1643 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1645 my $payinfo = $self->payinfo;
1646 $payinfo =~ s/[^\d\@]//g;
1647 if ( $conf->exists('echeck-nonus') ) {
1648 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1649 $payinfo = "$1\@$2";
1651 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1652 $payinfo = "$1\@$2";
1654 $self->payinfo($payinfo);
1657 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1659 return 'Banned ACH account: banned on '.
1660 time2str('%a %h %o at %r', $ban->_date).
1661 ' by '. $ban->otaker.
1662 ' (ban# '. $ban->bannum. ')';
1665 } elsif ( $self->payby eq 'LECB' ) {
1667 my $payinfo = $self->payinfo;
1668 $payinfo =~ s/\D//g;
1669 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1671 $self->payinfo($payinfo);
1674 } elsif ( $self->payby eq 'BILL' ) {
1676 $error = $self->ut_textn('payinfo');
1677 return "Illegal P.O. number: ". $self->payinfo if $error;
1680 } elsif ( $self->payby eq 'COMP' ) {
1682 my $curuser = $FS::CurrentUser::CurrentUser;
1683 if ( ! $self->custnum
1684 && ! $curuser->access_right('Complimentary customer')
1687 return "You are not permitted to create complimentary accounts."
1690 $error = $self->ut_textn('payinfo');
1691 return "Illegal comp account issuer: ". $self->payinfo if $error;
1694 } elsif ( $self->payby eq 'PREPAY' ) {
1696 my $payinfo = $self->payinfo;
1697 $payinfo =~ s/\W//g; #anything else would just confuse things
1698 $self->payinfo($payinfo);
1699 $error = $self->ut_alpha('payinfo');
1700 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1701 return "Unknown prepayment identifier"
1702 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1707 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1708 return "Expiration date required"
1709 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1713 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1714 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1715 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1716 ( $m, $y ) = ( $2, "19$1" );
1717 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1718 ( $m, $y ) = ( $3, "20$2" );
1720 return "Illegal expiration date: ". $self->paydate;
1722 $self->paydate("$y-$m-01");
1723 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1724 return gettext('expired_card')
1726 && !$ignore_expired_card
1727 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1730 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1731 ( ! $conf->exists('require_cardname')
1732 || $self->payby !~ /^(CARD|DCRD)$/ )
1734 $self->payname( $self->first. " ". $self->getfield('last') );
1736 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1737 or return gettext('illegal_name'). " payname: ". $self->payname;
1741 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1742 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1746 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1748 warn "$me check AFTER: \n". $self->_dump
1751 $self->SUPER::check;
1756 Returns a list of fields which have ship_ duplicates.
1761 qw( last first company
1762 address1 address2 city county state zip country
1767 =item has_ship_address
1769 Returns true if this customer record has a separate shipping address.
1773 sub has_ship_address {
1775 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1780 Returns a list of key/value pairs, with the following keys: address1, adddress2,
1781 city, county, state, zip, country. The shipping address is used if present.
1785 #geocode? dependent on tax-ship_address config, not available in cust_location
1786 #mostly. not yet then.
1790 my $prefix = $self->has_ship_address ? 'ship_' : '';
1792 map { $_ => $self->get($prefix.$_) }
1793 qw( address1 address2 city county state zip country geocode );
1794 #fields that cust_location has
1799 Returns all locations (see L<FS::cust_location>) for this customer.
1805 qsearch('cust_location', { 'custnum' => $self->custnum } );
1808 =item location_label [ OPTION => VALUE ... ]
1810 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
1818 used to separate the address elements (defaults to ', ')
1820 =item escape_function
1822 a callback used for escaping the text of the address elements
1828 # false laziness with FS::cust_location::line
1830 sub location_label {
1834 my $separator = $opt{join_string} || ', ';
1835 my $escape = $opt{escape_function} || sub{ shift };
1837 my $cydefault = FS::conf->new->config('countrydefault') || 'US';
1838 my $prefix = length($self->ship_last) ? 'ship_' : '';
1841 foreach (qw ( address1 address2 ) ) {
1842 my $method = "$prefix$_";
1843 $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
1848 foreach (qw ( city county state zip ) ) {
1849 my $method = "$prefix$_";
1850 if ( $self->$method ) {
1851 $line .= ' (' if $method eq 'county';
1852 $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
1853 $line .= ' )' if $method eq 'county';
1857 $line .= $separator. &$escape(code2country($self->country))
1858 if $self->country ne $cydefault;
1865 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1866 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1867 on success or a list of errors.
1873 grep { $_->unsuspend } $self->suspended_pkgs;
1878 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1880 Returns a list: an empty list on success or a list of errors.
1886 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1889 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1891 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1892 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
1893 of a list of pkgparts; the hashref has the following keys:
1897 =item pkgparts - listref of pkgparts
1899 =item (other options are passed to the suspend method)
1904 Returns a list: an empty list on success or a list of errors.
1908 sub suspend_if_pkgpart {
1910 my (@pkgparts, %opt);
1911 if (ref($_[0]) eq 'HASH'){
1912 @pkgparts = @{$_[0]{pkgparts}};
1917 grep { $_->suspend(%opt) }
1918 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1919 $self->unsuspended_pkgs;
1922 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1924 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1925 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
1926 instead of a list of pkgparts; the hashref has the following keys:
1930 =item pkgparts - listref of pkgparts
1932 =item (other options are passed to the suspend method)
1936 Returns a list: an empty list on success or a list of errors.
1940 sub suspend_unless_pkgpart {
1942 my (@pkgparts, %opt);
1943 if (ref($_[0]) eq 'HASH'){
1944 @pkgparts = @{$_[0]{pkgparts}};
1949 grep { $_->suspend(%opt) }
1950 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1951 $self->unsuspended_pkgs;
1954 =item cancel [ OPTION => VALUE ... ]
1956 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1958 Available options are:
1962 =item quiet - can be set true to supress email cancellation notices.
1964 =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.
1966 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
1968 =item nobill - can be set true to skip billing if it might otherwise be done.
1972 Always returns a list: an empty list on success or a list of errors.
1976 # nb that dates are not specified as valid options to this method
1979 my( $self, %opt ) = @_;
1981 warn "$me cancel called on customer ". $self->custnum. " with options ".
1982 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
1985 return ( 'access denied' )
1986 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
1988 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1990 #should try decryption (we might have the private key)
1991 # and if not maybe queue a job for the server that does?
1992 return ( "Can't (yet) ban encrypted credit cards" )
1993 if $self->is_encrypted($self->payinfo);
1995 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1996 my $error = $ban->insert;
1997 return ( $error ) if $error;
2001 my @pkgs = $self->ncancelled_pkgs;
2003 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2005 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2006 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2010 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2011 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2014 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2017 sub _banned_pay_hashref {
2028 'payby' => $payby2ban{$self->payby},
2029 'payinfo' => md5_base64($self->payinfo),
2030 #don't ever *search* on reason! #'reason' =>
2036 Returns all notes (see L<FS::cust_main_note>) for this customer.
2043 qsearch( 'cust_main_note',
2044 { 'custnum' => $self->custnum },
2046 'ORDER BY _DATE DESC'
2052 Returns the agent (see L<FS::agent>) for this customer.
2058 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2063 Returns the agent name (see L<FS::agent>) for this customer.
2069 $self->agent->agent;
2074 Returns any tags associated with this customer, as FS::cust_tag objects,
2075 or an empty list if there are no tags.
2081 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2086 Returns any tags associated with this customer, as FS::part_tag objects,
2087 or an empty list if there are no tags.
2093 map $_->part_tag, $self->cust_tag;
2099 Returns the customer class, as an FS::cust_class object, or the empty string
2100 if there is no customer class.
2106 if ( $self->classnum ) {
2107 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2115 Returns the customer category name, or the empty string if there is no customer
2122 my $cust_class = $self->cust_class;
2124 ? $cust_class->categoryname
2130 Returns the customer class name, or the empty string if there is no customer
2137 my $cust_class = $self->cust_class;
2139 ? $cust_class->classname
2143 =item BILLING METHODS
2145 Documentation on billing methods has been moved to
2146 L<FS::cust_main::Billing>.
2148 =item REALTIME BILLING METHODS
2150 Documentation on realtime billing methods has been moved to
2151 L<FS::cust_main::Billing_Realtime>.
2155 Removes the I<paycvv> field from the database directly.
2157 If there is an error, returns the error, otherwise returns false.
2163 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2164 or return dbh->errstr;
2165 $sth->execute($self->custnum)
2166 or return $sth->errstr;
2171 =item batch_card OPTION => VALUE...
2173 Adds a payment for this invoice to the pending credit card batch (see
2174 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2175 runs the payment using a realtime gateway.
2180 my ($self, %options) = @_;
2183 if (exists($options{amount})) {
2184 $amount = $options{amount};
2186 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2188 return '' unless $amount > 0;
2190 my $invnum = delete $options{invnum};
2191 my $payby = $options{payby} || $self->payby; #still dubious
2193 if ($options{'realtime'}) {
2194 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2200 my $oldAutoCommit = $FS::UID::AutoCommit;
2201 local $FS::UID::AutoCommit = 0;
2204 #this needs to handle mysql as well as Pg, like svc_acct.pm
2205 #(make it into a common function if folks need to do batching with mysql)
2206 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2207 or return "Cannot lock pay_batch: " . $dbh->errstr;
2211 'payby' => FS::payby->payby2payment($payby),
2214 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2216 unless ( $pay_batch ) {
2217 $pay_batch = new FS::pay_batch \%pay_batch;
2218 my $error = $pay_batch->insert;
2220 $dbh->rollback if $oldAutoCommit;
2221 die "error creating new batch: $error\n";
2225 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2226 'batchnum' => $pay_batch->batchnum,
2227 'custnum' => $self->custnum,
2230 foreach (qw( address1 address2 city state zip country payby payinfo paydate
2232 $options{$_} = '' unless exists($options{$_});
2235 my $cust_pay_batch = new FS::cust_pay_batch ( {
2236 'batchnum' => $pay_batch->batchnum,
2237 'invnum' => $invnum || 0, # is there a better value?
2238 # this field should be
2240 # cust_bill_pay_batch now
2241 'custnum' => $self->custnum,
2242 'last' => $self->getfield('last'),
2243 'first' => $self->getfield('first'),
2244 'address1' => $options{address1} || $self->address1,
2245 'address2' => $options{address2} || $self->address2,
2246 'city' => $options{city} || $self->city,
2247 'state' => $options{state} || $self->state,
2248 'zip' => $options{zip} || $self->zip,
2249 'country' => $options{country} || $self->country,
2250 'payby' => $options{payby} || $self->payby,
2251 'payinfo' => $options{payinfo} || $self->payinfo,
2252 'exp' => $options{paydate} || $self->paydate,
2253 'payname' => $options{payname} || $self->payname,
2254 'amount' => $amount, # consolidating
2257 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2258 if $old_cust_pay_batch;
2261 if ($old_cust_pay_batch) {
2262 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2264 $error = $cust_pay_batch->insert;
2268 $dbh->rollback if $oldAutoCommit;
2272 my $unapplied = $self->total_unapplied_credits
2273 + $self->total_unapplied_payments
2274 + $self->in_transit_payments;
2275 foreach my $cust_bill ($self->open_cust_bill) {
2276 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2277 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2278 'invnum' => $cust_bill->invnum,
2279 'paybatchnum' => $cust_pay_batch->paybatchnum,
2280 'amount' => $cust_bill->owed,
2283 if ($unapplied >= $cust_bill_pay_batch->amount){
2284 $unapplied -= $cust_bill_pay_batch->amount;
2287 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2288 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2290 $error = $cust_bill_pay_batch->insert;
2292 $dbh->rollback if $oldAutoCommit;
2297 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2303 Returns the total owed for this customer on all invoices
2304 (see L<FS::cust_bill/owed>).
2310 $self->total_owed_date(2145859200); #12/31/2037
2313 =item total_owed_date TIME
2315 Returns the total owed for this customer on all invoices with date earlier than
2316 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2317 see L<Time::Local> and L<Date::Parse> for conversion functions.
2321 sub total_owed_date {
2325 my $custnum = $self->custnum;
2327 my $owed_sql = FS::cust_bill->owed_sql;
2330 SELECT SUM($owed_sql) FROM cust_bill
2331 WHERE custnum = $custnum
2335 sprintf( "%.2f", $self->scalar_sql($sql) );
2339 =item total_owed_pkgnum PKGNUM
2341 Returns the total owed on all invoices for this customer's specific package
2342 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2346 sub total_owed_pkgnum {
2347 my( $self, $pkgnum ) = @_;
2348 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2351 =item total_owed_date_pkgnum TIME PKGNUM
2353 Returns the total owed for this customer's specific package when using
2354 experimental package balances on all invoices with date earlier than
2355 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2356 see L<Time::Local> and L<Date::Parse> for conversion functions.
2360 sub total_owed_date_pkgnum {
2361 my( $self, $time, $pkgnum ) = @_;
2364 foreach my $cust_bill (
2365 grep { $_->_date <= $time }
2366 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2368 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2370 sprintf( "%.2f", $total_bill );
2376 Returns the total amount of all payments.
2383 $total += $_->paid foreach $self->cust_pay;
2384 sprintf( "%.2f", $total );
2387 =item total_unapplied_credits
2389 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2390 customer. See L<FS::cust_credit/credited>.
2392 =item total_credited
2394 Old name for total_unapplied_credits. Don't use.
2398 sub total_credited {
2399 #carp "total_credited deprecated, use total_unapplied_credits";
2400 shift->total_unapplied_credits(@_);
2403 sub total_unapplied_credits {
2406 my $custnum = $self->custnum;
2408 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2411 SELECT SUM($unapplied_sql) FROM cust_credit
2412 WHERE custnum = $custnum
2415 sprintf( "%.2f", $self->scalar_sql($sql) );
2419 =item total_unapplied_credits_pkgnum PKGNUM
2421 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2422 customer. See L<FS::cust_credit/credited>.
2426 sub total_unapplied_credits_pkgnum {
2427 my( $self, $pkgnum ) = @_;
2428 my $total_credit = 0;
2429 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2430 sprintf( "%.2f", $total_credit );
2434 =item total_unapplied_payments
2436 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2437 See L<FS::cust_pay/unapplied>.
2441 sub total_unapplied_payments {
2444 my $custnum = $self->custnum;
2446 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2449 SELECT SUM($unapplied_sql) FROM cust_pay
2450 WHERE custnum = $custnum
2453 sprintf( "%.2f", $self->scalar_sql($sql) );
2457 =item total_unapplied_payments_pkgnum PKGNUM
2459 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2460 specific package when using experimental package balances. See
2461 L<FS::cust_pay/unapplied>.
2465 sub total_unapplied_payments_pkgnum {
2466 my( $self, $pkgnum ) = @_;
2467 my $total_unapplied = 0;
2468 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2469 sprintf( "%.2f", $total_unapplied );
2473 =item total_unapplied_refunds
2475 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2476 customer. See L<FS::cust_refund/unapplied>.
2480 sub total_unapplied_refunds {
2482 my $custnum = $self->custnum;
2484 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2487 SELECT SUM($unapplied_sql) FROM cust_refund
2488 WHERE custnum = $custnum
2491 sprintf( "%.2f", $self->scalar_sql($sql) );
2497 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2498 total_unapplied_credits minus total_unapplied_payments).
2504 $self->balance_date_range;
2507 =item balance_date TIME
2509 Returns the balance for this customer, only considering invoices with date
2510 earlier than TIME (total_owed_date minus total_credited minus
2511 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2512 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2519 $self->balance_date_range(shift);
2522 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2524 Returns the balance for this customer, optionally considering invoices with
2525 date earlier than START_TIME, and not later than END_TIME
2526 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2528 Times are specified as SQL fragments or numeric
2529 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2530 L<Date::Parse> for conversion functions. The empty string can be passed
2531 to disable that time constraint completely.
2533 Available options are:
2537 =item unapplied_date
2539 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)
2545 sub balance_date_range {
2547 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2548 ') FROM cust_main WHERE custnum='. $self->custnum;
2549 sprintf( '%.2f', $self->scalar_sql($sql) );
2552 =item balance_pkgnum PKGNUM
2554 Returns the balance for this customer's specific package when using
2555 experimental package balances (total_owed plus total_unrefunded, minus
2556 total_unapplied_credits minus total_unapplied_payments)
2560 sub balance_pkgnum {
2561 my( $self, $pkgnum ) = @_;
2564 $self->total_owed_pkgnum($pkgnum)
2565 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2566 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2567 - $self->total_unapplied_credits_pkgnum($pkgnum)
2568 - $self->total_unapplied_payments_pkgnum($pkgnum)
2572 =item in_transit_payments
2574 Returns the total of requests for payments for this customer pending in
2575 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
2579 sub in_transit_payments {
2581 my $in_transit_payments = 0;
2582 foreach my $pay_batch ( qsearch('pay_batch', {
2585 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2586 'batchnum' => $pay_batch->batchnum,
2587 'custnum' => $self->custnum,
2589 $in_transit_payments += $cust_pay_batch->amount;
2592 sprintf( "%.2f", $in_transit_payments );
2597 Returns a hash of useful information for making a payment.
2607 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2608 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2609 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2613 For credit card transactions:
2625 For electronic check transactions:
2640 $return{balance} = $self->balance;
2642 $return{payname} = $self->payname
2643 || ( $self->first. ' '. $self->get('last') );
2645 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
2647 $return{payby} = $self->payby;
2648 $return{stateid_state} = $self->stateid_state;
2650 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2651 $return{card_type} = cardtype($self->payinfo);
2652 $return{payinfo} = $self->paymask;
2654 @return{'month', 'year'} = $self->paydate_monthyear;
2658 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2659 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2660 $return{payinfo1} = $payinfo1;
2661 $return{payinfo2} = $payinfo2;
2662 $return{paytype} = $self->paytype;
2663 $return{paystate} = $self->paystate;
2667 #doubleclick protection
2669 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2675 =item paydate_monthyear
2677 Returns a two-element list consisting of the month and year of this customer's
2678 paydate (credit card expiration date for CARD customers)
2682 sub paydate_monthyear {
2684 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2686 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2693 =item tax_exemption TAXNAME
2698 my( $self, $taxname ) = @_;
2700 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2701 'taxname' => $taxname,
2706 =item cust_main_exemption
2710 sub cust_main_exemption {
2712 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
2715 =item invoicing_list [ ARRAYREF ]
2717 If an arguement is given, sets these email addresses as invoice recipients
2718 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2719 (except as warnings), so use check_invoicing_list first.
2721 Returns a list of email addresses (with svcnum entries expanded).
2723 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2724 check it without disturbing anything by passing nothing.
2726 This interface may change in the future.
2730 sub invoicing_list {
2731 my( $self, $arrayref ) = @_;
2734 my @cust_main_invoice;
2735 if ( $self->custnum ) {
2736 @cust_main_invoice =
2737 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2739 @cust_main_invoice = ();
2741 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2742 #warn $cust_main_invoice->destnum;
2743 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2744 #warn $cust_main_invoice->destnum;
2745 my $error = $cust_main_invoice->delete;
2746 warn $error if $error;
2749 if ( $self->custnum ) {
2750 @cust_main_invoice =
2751 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2753 @cust_main_invoice = ();
2755 my %seen = map { $_->address => 1 } @cust_main_invoice;
2756 foreach my $address ( @{$arrayref} ) {
2757 next if exists $seen{$address} && $seen{$address};
2758 $seen{$address} = 1;
2759 my $cust_main_invoice = new FS::cust_main_invoice ( {
2760 'custnum' => $self->custnum,
2763 my $error = $cust_main_invoice->insert;
2764 warn $error if $error;
2768 if ( $self->custnum ) {
2770 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2777 =item check_invoicing_list ARRAYREF
2779 Checks these arguements as valid input for the invoicing_list method. If there
2780 is an error, returns the error, otherwise returns false.
2784 sub check_invoicing_list {
2785 my( $self, $arrayref ) = @_;
2787 foreach my $address ( @$arrayref ) {
2789 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2790 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2793 my $cust_main_invoice = new FS::cust_main_invoice ( {
2794 'custnum' => $self->custnum,
2797 my $error = $self->custnum
2798 ? $cust_main_invoice->check
2799 : $cust_main_invoice->checkdest
2801 return $error if $error;
2805 return "Email address required"
2806 if $conf->exists('cust_main-require_invoicing_list_email')
2807 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2812 =item set_default_invoicing_list
2814 Sets the invoicing list to all accounts associated with this customer,
2815 overwriting any previous invoicing list.
2819 sub set_default_invoicing_list {
2821 $self->invoicing_list($self->all_emails);
2826 Returns the email addresses of all accounts provisioned for this customer.
2833 foreach my $cust_pkg ( $self->all_pkgs ) {
2834 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2836 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2837 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2839 $list{$_}=1 foreach map { $_->email } @svc_acct;
2844 =item invoicing_list_addpost
2846 Adds postal invoicing to this customer. If this customer is already configured
2847 to receive postal invoices, does nothing.
2851 sub invoicing_list_addpost {
2853 return if grep { $_ eq 'POST' } $self->invoicing_list;
2854 my @invoicing_list = $self->invoicing_list;
2855 push @invoicing_list, 'POST';
2856 $self->invoicing_list(\@invoicing_list);
2859 =item invoicing_list_emailonly
2861 Returns the list of email invoice recipients (invoicing_list without non-email
2862 destinations such as POST and FAX).
2866 sub invoicing_list_emailonly {
2868 warn "$me invoicing_list_emailonly called"
2870 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
2873 =item invoicing_list_emailonly_scalar
2875 Returns the list of email invoice recipients (invoicing_list without non-email
2876 destinations such as POST and FAX) as a comma-separated scalar.
2880 sub invoicing_list_emailonly_scalar {
2882 warn "$me invoicing_list_emailonly_scalar called"
2884 join(', ', $self->invoicing_list_emailonly);
2887 =item referral_custnum_cust_main
2889 Returns the customer who referred this customer (or the empty string, if
2890 this customer was not referred).
2892 Note the difference with referral_cust_main method: This method,
2893 referral_custnum_cust_main returns the single customer (if any) who referred
2894 this customer, while referral_cust_main returns an array of customers referred
2899 sub referral_custnum_cust_main {
2901 return '' unless $self->referral_custnum;
2902 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2905 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2907 Returns an array of customers referred by this customer (referral_custnum set
2908 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2909 customers referred by customers referred by this customer and so on, inclusive.
2910 The default behavior is DEPTH 1 (no recursion).
2912 Note the difference with referral_custnum_cust_main method: This method,
2913 referral_cust_main, returns an array of customers referred BY this customer,
2914 while referral_custnum_cust_main returns the single customer (if any) who
2915 referred this customer.
2919 sub referral_cust_main {
2921 my $depth = @_ ? shift : 1;
2922 my $exclude = @_ ? shift : {};
2925 map { $exclude->{$_->custnum}++; $_; }
2926 grep { ! $exclude->{ $_->custnum } }
2927 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2931 map { $_->referral_cust_main($depth-1, $exclude) }
2938 =item referral_cust_main_ncancelled
2940 Same as referral_cust_main, except only returns customers with uncancelled
2945 sub referral_cust_main_ncancelled {
2947 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2950 =item referral_cust_pkg [ DEPTH ]
2952 Like referral_cust_main, except returns a flat list of all unsuspended (and
2953 uncancelled) packages for each customer. The number of items in this list may
2954 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2958 sub referral_cust_pkg {
2960 my $depth = @_ ? shift : 1;
2962 map { $_->unsuspended_pkgs }
2963 grep { $_->unsuspended_pkgs }
2964 $self->referral_cust_main($depth);
2967 =item referring_cust_main
2969 Returns the single cust_main record for the customer who referred this customer
2970 (referral_custnum), or false.
2974 sub referring_cust_main {
2976 return '' unless $self->referral_custnum;
2977 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2980 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
2982 Applies a credit to this customer. If there is an error, returns the error,
2983 otherwise returns false.
2985 REASON can be a text string, an FS::reason object, or a scalar reference to
2986 a reasonnum. If a text string, it will be automatically inserted as a new
2987 reason, and a 'reason_type' option must be passed to indicate the
2988 FS::reason_type for the new reason.
2990 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
2992 Any other options are passed to FS::cust_credit::insert.
2997 my( $self, $amount, $reason, %options ) = @_;
2999 my $cust_credit = new FS::cust_credit {
3000 'custnum' => $self->custnum,
3001 'amount' => $amount,
3004 if ( ref($reason) ) {
3006 if ( ref($reason) eq 'SCALAR' ) {
3007 $cust_credit->reasonnum( $$reason );
3009 $cust_credit->reasonnum( $reason->reasonnum );
3013 $cust_credit->set('reason', $reason)
3016 for (qw( addlinfo eventnum )) {
3017 $cust_credit->$_( delete $options{$_} )
3018 if exists($options{$_});
3021 $cust_credit->insert(%options);
3025 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3027 Creates a one-time charge for this customer. If there is an error, returns
3028 the error, otherwise returns false.
3030 New-style, with a hashref of options:
3032 my $error = $cust_main->charge(
3036 'start_date' => str2time('7/4/2009'),
3037 'pkg' => 'Description',
3038 'comment' => 'Comment',
3039 'additional' => [], #extra invoice detail
3040 'classnum' => 1, #pkg_class
3042 'setuptax' => '', # or 'Y' for tax exempt
3045 'taxclass' => 'Tax class',
3048 'taxproduct' => 2, #part_pkg_taxproduct
3049 'override' => {}, #XXX describe
3051 #will be filled in with the new object
3052 'cust_pkg_ref' => \$cust_pkg,
3054 #generate an invoice immediately
3056 'invoice_terms' => '', #with these terms
3062 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3068 my ( $amount, $quantity, $start_date, $classnum );
3069 my ( $pkg, $comment, $additional );
3070 my ( $setuptax, $taxclass ); #internal taxes
3071 my ( $taxproduct, $override ); #vendor (CCH) taxes
3073 my $cust_pkg_ref = '';
3074 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3075 if ( ref( $_[0] ) ) {
3076 $amount = $_[0]->{amount};
3077 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3078 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3079 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3080 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3081 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3082 : '$'. sprintf("%.2f",$amount);
3083 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3084 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3085 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3086 $additional = $_[0]->{additional} || [];
3087 $taxproduct = $_[0]->{taxproductnum};
3088 $override = { '' => $_[0]->{tax_override} };
3089 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3090 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3091 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3096 $pkg = @_ ? shift : 'One-time charge';
3097 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3099 $taxclass = @_ ? shift : '';
3103 local $SIG{HUP} = 'IGNORE';
3104 local $SIG{INT} = 'IGNORE';
3105 local $SIG{QUIT} = 'IGNORE';
3106 local $SIG{TERM} = 'IGNORE';
3107 local $SIG{TSTP} = 'IGNORE';
3108 local $SIG{PIPE} = 'IGNORE';
3110 my $oldAutoCommit = $FS::UID::AutoCommit;
3111 local $FS::UID::AutoCommit = 0;
3114 my $part_pkg = new FS::part_pkg ( {
3116 'comment' => $comment,
3120 'classnum' => ( $classnum ? $classnum : '' ),
3121 'setuptax' => $setuptax,
3122 'taxclass' => $taxclass,
3123 'taxproductnum' => $taxproduct,
3126 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3127 ( 0 .. @$additional - 1 )
3129 'additional_count' => scalar(@$additional),
3130 'setup_fee' => $amount,
3133 my $error = $part_pkg->insert( options => \%options,
3134 tax_overrides => $override,
3137 $dbh->rollback if $oldAutoCommit;
3141 my $pkgpart = $part_pkg->pkgpart;
3142 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3143 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3144 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3145 $error = $type_pkgs->insert;
3147 $dbh->rollback if $oldAutoCommit;
3152 my $cust_pkg = new FS::cust_pkg ( {
3153 'custnum' => $self->custnum,
3154 'pkgpart' => $pkgpart,
3155 'quantity' => $quantity,
3156 'start_date' => $start_date,
3157 'no_auto' => $no_auto,
3160 $error = $cust_pkg->insert;
3162 $dbh->rollback if $oldAutoCommit;
3164 } elsif ( $cust_pkg_ref ) {
3165 ${$cust_pkg_ref} = $cust_pkg;
3169 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3170 'pkg_list' => [ $cust_pkg ],
3173 $dbh->rollback if $oldAutoCommit;
3178 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3183 #=item charge_postal_fee
3185 #Applies a one time charge this customer. If there is an error,
3186 #returns the error, returns the cust_pkg charge object or false
3187 #if there was no charge.
3191 # This should be a customer event. For that to work requires that bill
3192 # also be a customer event.
3194 sub charge_postal_fee {
3197 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
3198 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3200 my $cust_pkg = new FS::cust_pkg ( {
3201 'custnum' => $self->custnum,
3202 'pkgpart' => $pkgpart,
3206 my $error = $cust_pkg->insert;
3207 $error ? $error : $cust_pkg;
3210 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3212 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3214 Optionally, a list or hashref of additional arguments to the qsearch call can
3221 my $opt = ref($_[0]) ? shift : { @_ };
3223 #return $self->num_cust_bill unless wantarray || keys %$opt;
3225 $opt->{'table'} = 'cust_bill';
3226 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3227 $opt->{'hashref'}{'custnum'} = $self->custnum;
3228 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3230 map { $_ } #behavior of sort undefined in scalar context
3231 sort { $a->_date <=> $b->_date }
3235 =item open_cust_bill
3237 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3242 sub open_cust_bill {
3246 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3252 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3254 Returns all the statements (see L<FS::cust_statement>) for this customer.
3256 Optionally, a list or hashref of additional arguments to the qsearch call can
3261 sub cust_statement {
3263 my $opt = ref($_[0]) ? shift : { @_ };
3265 #return $self->num_cust_statement unless wantarray || keys %$opt;
3267 $opt->{'table'} = 'cust_statement';
3268 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3269 $opt->{'hashref'}{'custnum'} = $self->custnum;
3270 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3272 map { $_ } #behavior of sort undefined in scalar context
3273 sort { $a->_date <=> $b->_date }
3279 Returns all the credits (see L<FS::cust_credit>) for this customer.
3285 map { $_ } #return $self->num_cust_credit unless wantarray;
3286 sort { $a->_date <=> $b->_date }
3287 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3290 =item cust_credit_pkgnum
3292 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3293 package when using experimental package balances.
3297 sub cust_credit_pkgnum {
3298 my( $self, $pkgnum ) = @_;
3299 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3300 sort { $a->_date <=> $b->_date }
3301 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3302 'pkgnum' => $pkgnum,
3309 Returns all the payments (see L<FS::cust_pay>) for this customer.
3315 return $self->num_cust_pay unless wantarray;
3316 sort { $a->_date <=> $b->_date }
3317 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3322 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3323 called automatically when the cust_pay method is used in a scalar context.
3329 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3330 my $sth = dbh->prepare($sql) or die dbh->errstr;
3331 $sth->execute($self->custnum) or die $sth->errstr;
3332 $sth->fetchrow_arrayref->[0];
3335 =item cust_pay_pkgnum
3337 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3338 package when using experimental package balances.
3342 sub cust_pay_pkgnum {
3343 my( $self, $pkgnum ) = @_;
3344 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3345 sort { $a->_date <=> $b->_date }
3346 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3347 'pkgnum' => $pkgnum,
3354 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3360 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3361 sort { $a->_date <=> $b->_date }
3362 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3365 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3367 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3369 Optionally, a list or hashref of additional arguments to the qsearch call can
3374 sub cust_pay_batch {
3376 my $opt = ref($_[0]) ? shift : { @_ };
3378 #return $self->num_cust_statement unless wantarray || keys %$opt;
3380 $opt->{'table'} = 'cust_pay_batch';
3381 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3382 $opt->{'hashref'}{'custnum'} = $self->custnum;
3383 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3385 map { $_ } #behavior of sort undefined in scalar context
3386 sort { $a->paybatchnum <=> $b->paybatchnum }
3390 =item cust_pay_pending
3392 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3393 (without status "done").
3397 sub cust_pay_pending {
3399 return $self->num_cust_pay_pending unless wantarray;
3400 sort { $a->_date <=> $b->_date }
3401 qsearch( 'cust_pay_pending', {
3402 'custnum' => $self->custnum,
3403 'status' => { op=>'!=', value=>'done' },
3408 =item cust_pay_pending_attempt
3410 Returns all payment attempts / declined payments for this customer, as pending
3411 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3412 a corresponding payment (see L<FS::cust_pay>).
3416 sub cust_pay_pending_attempt {
3418 return $self->num_cust_pay_pending_attempt unless wantarray;
3419 sort { $a->_date <=> $b->_date }
3420 qsearch( 'cust_pay_pending', {
3421 'custnum' => $self->custnum,
3428 =item num_cust_pay_pending
3430 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3431 customer (without status "done"). Also called automatically when the
3432 cust_pay_pending method is used in a scalar context.
3436 sub num_cust_pay_pending {
3439 " SELECT COUNT(*) FROM cust_pay_pending ".
3440 " WHERE custnum = ? AND status != 'done' ",
3445 =item num_cust_pay_pending_attempt
3447 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3448 customer, with status "done" but without a corresp. Also called automatically when the
3449 cust_pay_pending method is used in a scalar context.
3453 sub num_cust_pay_pending_attempt {
3456 " SELECT COUNT(*) FROM cust_pay_pending ".
3457 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3464 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3470 map { $_ } #return $self->num_cust_refund unless wantarray;
3471 sort { $a->_date <=> $b->_date }
3472 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3475 =item display_custnum
3477 Returns the displayed customer number for this customer: agent_custid if
3478 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3482 sub display_custnum {
3484 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3485 return $self->agent_custid;
3487 return $self->custnum;
3493 Returns a name string for this customer, either "Company (Last, First)" or
3500 my $name = $self->contact;
3501 $name = $self->company. " ($name)" if $self->company;
3507 Returns a name string for this (service/shipping) contact, either
3508 "Company (Last, First)" or "Last, First".
3514 if ( $self->get('ship_last') ) {
3515 my $name = $self->ship_contact;
3516 $name = $self->ship_company. " ($name)" if $self->ship_company;
3525 Returns a name string for this customer, either "Company" or "First Last".
3531 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3534 =item ship_name_short
3536 Returns a name string for this (service/shipping) contact, either "Company"
3541 sub ship_name_short {
3543 if ( $self->get('ship_last') ) {
3544 $self->ship_company !~ /^\s*$/
3545 ? $self->ship_company
3546 : $self->ship_contact_firstlast;
3548 $self->name_company_or_firstlast;
3554 Returns this customer's full (billing) contact name only, "Last, First"
3560 $self->get('last'). ', '. $self->first;
3565 Returns this customer's full (shipping) contact name only, "Last, First"
3571 $self->get('ship_last')
3572 ? $self->get('ship_last'). ', '. $self->ship_first
3576 =item contact_firstlast
3578 Returns this customers full (billing) contact name only, "First Last".
3582 sub contact_firstlast {
3584 $self->first. ' '. $self->get('last');
3587 =item ship_contact_firstlast
3589 Returns this customer's full (shipping) contact name only, "First Last".
3593 sub ship_contact_firstlast {
3595 $self->get('ship_last')
3596 ? $self->first. ' '. $self->get('ship_last')
3597 : $self->contact_firstlast;
3602 Returns this customer's full country name
3608 code2country($self->country);
3611 =item geocode DATA_VENDOR
3613 Returns a value for the customer location as encoded by DATA_VENDOR.
3614 Currently this only makes sense for "CCH" as DATA_VENDOR.
3619 my ($self, $data_vendor) = (shift, shift); #always cch for now
3621 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
3622 return $geocode if $geocode;
3624 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3628 my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
3629 if $self->country eq 'US';
3633 #CCH specific location stuff
3634 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
3636 my @cust_tax_location =
3638 'table' => 'cust_tax_location',
3639 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
3640 'extra_sql' => $extra_sql,
3641 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
3644 $geocode = $cust_tax_location[0]->geocode
3645 if scalar(@cust_tax_location);
3654 Returns a status string for this customer, currently:
3658 =item prospect - No packages have ever been ordered
3660 =item ordered - Recurring packages all are new (not yet billed).
3662 =item active - One or more recurring packages is active
3664 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3666 =item suspended - All non-cancelled recurring packages are suspended
3668 =item cancelled - All recurring packages are cancelled
3674 sub status { shift->cust_status(@_); }
3678 # prospect ordered active inactive suspended cancelled
3679 for my $status ( FS::cust_main->statuses() ) {
3680 my $method = $status.'_sql';
3681 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3682 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3683 $sth->execute( ($self->custnum) x $numnum )
3684 or die "Error executing 'SELECT $sql': ". $sth->errstr;
3685 return $status if $sth->fetchrow_arrayref->[0];
3689 =item ucfirst_cust_status
3691 =item ucfirst_status
3693 Returns the status with the first character capitalized.
3697 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
3699 sub ucfirst_cust_status {
3701 ucfirst($self->cust_status);
3706 Returns a hex triplet color string for this customer's status.
3710 use vars qw(%statuscolor);
3711 tie %statuscolor, 'Tie::IxHash',
3712 'prospect' => '7e0079', #'000000', #black? naw, purple
3713 'active' => '00CC00', #green
3714 'ordered' => '009999', #teal? cyan?
3715 'inactive' => '0000CC', #blue
3716 'suspended' => 'FF9900', #yellow
3717 'cancelled' => 'FF0000', #red
3720 sub statuscolor { shift->cust_statuscolor(@_); }
3722 sub cust_statuscolor {
3724 $statuscolor{$self->cust_status};
3729 Returns an array of hashes representing the customer's RT tickets.
3736 my $num = $conf->config('cust_main-max_tickets') || 10;
3739 if ( $conf->config('ticket_system') ) {
3740 unless ( $conf->config('ticket_system-custom_priority_field') ) {
3742 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
3746 foreach my $priority (
3747 $conf->config('ticket_system-custom_priority_field-values'), ''
3749 last if scalar(@tickets) >= $num;
3751 @{ FS::TicketSystem->customer_tickets( $self->custnum,
3752 $num - scalar(@tickets),
3762 # Return services representing svc_accts in customer support packages
3763 sub support_services {
3765 my %packages = map { $_ => 1 } $conf->config('support_packages');
3767 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
3768 grep { $_->part_svc->svcdb eq 'svc_acct' }
3769 map { $_->cust_svc }
3770 grep { exists $packages{ $_->pkgpart } }
3771 $self->ncancelled_pkgs;
3775 # Return a list of latitude/longitude for one of the services (if any)
3776 sub service_coordinates {
3780 grep { $_->latitude && $_->longitude }
3782 map { $_->cust_svc }
3783 $self->ncancelled_pkgs;
3785 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
3790 Returns a masked version of the named field
3795 my ($self,$field) = @_;
3799 'x'x(length($self->getfield($field))-4).
3800 substr($self->getfield($field), (length($self->getfield($field))-4));
3806 =head1 CLASS METHODS
3812 Class method that returns the list of possible status strings for customers
3813 (see L<the status method|/status>). For example:
3815 @statuses = FS::cust_main->statuses();
3820 #my $self = shift; #could be class...
3826 Returns an SQL expression identifying prospective cust_main records (customers
3827 with no packages ever ordered)
3831 use vars qw($select_count_pkgs);
3832 $select_count_pkgs =
3833 "SELECT COUNT(*) FROM cust_pkg
3834 WHERE cust_pkg.custnum = cust_main.custnum";
3836 sub select_count_pkgs_sql {
3841 " 0 = ( $select_count_pkgs ) ";
3846 Returns an SQL expression identifying ordered cust_main records (customers with
3847 recurring packages not yet setup).
3852 FS::cust_main->none_active_sql.
3853 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
3858 Returns an SQL expression identifying active cust_main records (customers with
3859 active recurring packages).
3864 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
3867 =item none_active_sql
3869 Returns an SQL expression identifying cust_main records with no active
3870 recurring packages. This includes customers of status prospect, ordered,
3871 inactive, and suspended.
3875 sub none_active_sql {
3876 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
3881 Returns an SQL expression identifying inactive cust_main records (customers with
3882 no active recurring packages, but otherwise unsuspended/uncancelled).
3887 FS::cust_main->none_active_sql.
3888 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
3894 Returns an SQL expression identifying suspended cust_main records.
3899 sub suspended_sql { susp_sql(@_); }
3901 FS::cust_main->none_active_sql.
3902 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
3908 Returns an SQL expression identifying cancelled cust_main records.
3912 sub cancelled_sql { cancel_sql(@_); }
3915 my $recurring_sql = FS::cust_pkg->recurring_sql;
3916 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
3919 0 < ( $select_count_pkgs )
3920 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
3921 AND 0 = ( $select_count_pkgs AND $recurring_sql
3922 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3924 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3930 =item uncancelled_sql
3932 Returns an SQL expression identifying un-cancelled cust_main records.
3936 sub uncancelled_sql { uncancel_sql(@_); }
3937 sub uncancel_sql { "
3938 ( 0 < ( $select_count_pkgs
3939 AND ( cust_pkg.cancel IS NULL
3940 OR cust_pkg.cancel = 0
3943 OR 0 = ( $select_count_pkgs )
3949 Returns an SQL fragment to retreive the balance.
3954 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
3955 WHERE cust_bill.custnum = cust_main.custnum )
3956 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
3957 WHERE cust_pay.custnum = cust_main.custnum )
3958 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
3959 WHERE cust_credit.custnum = cust_main.custnum )
3960 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
3961 WHERE cust_refund.custnum = cust_main.custnum )
3964 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3966 Returns an SQL fragment to retreive the balance for this customer, optionally
3967 considering invoices with date earlier than START_TIME, and not
3968 later than END_TIME (total_owed_date minus total_unapplied_credits minus
3969 total_unapplied_payments).
3971 Times are specified as SQL fragments or numeric
3972 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
3973 L<Date::Parse> for conversion functions. The empty string can be passed
3974 to disable that time constraint completely.
3976 Available options are:
3980 =item unapplied_date
3982 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)
3987 set to true to remove all customer comparison clauses, for totals
3992 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
3997 JOIN clause (typically used with the total option)
4001 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4002 time will be ignored. Note that START_TIME and END_TIME only limit the date
4003 range for invoices and I<unapplied> payments, credits, and refunds.
4009 sub balance_date_sql {
4010 my( $class, $start, $end, %opt ) = @_;
4012 my $cutoff = $opt{'cutoff'};
4014 my $owed = FS::cust_bill->owed_sql($cutoff);
4015 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4016 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4017 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4019 my $j = $opt{'join'} || '';
4021 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4022 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4023 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4024 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4026 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4027 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4028 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4029 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4034 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4036 Returns an SQL fragment to retreive the total unapplied payments for this
4037 customer, only considering invoices with date earlier than START_TIME, and
4038 optionally not later than END_TIME.
4040 Times are specified as SQL fragments or numeric
4041 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4042 L<Date::Parse> for conversion functions. The empty string can be passed
4043 to disable that time constraint completely.
4045 Available options are:
4049 sub unapplied_payments_date_sql {
4050 my( $class, $start, $end, %opt ) = @_;
4052 my $cutoff = $opt{'cutoff'};
4054 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4056 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4057 'unapplied_date'=>1 );
4059 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4062 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4064 Helper method for balance_date_sql; name (and usage) subject to change
4065 (suggestions welcome).
4067 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4068 cust_refund, cust_credit or cust_pay).
4070 If TABLE is "cust_bill" or the unapplied_date option is true, only
4071 considers records with date earlier than START_TIME, and optionally not
4072 later than END_TIME .
4076 sub _money_table_where {
4077 my( $class, $table, $start, $end, %opt ) = @_;
4080 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4081 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4082 push @where, "$table._date <= $start" if defined($start) && length($start);
4083 push @where, "$table._date > $end" if defined($end) && length($end);
4085 push @where, @{$opt{'where'}} if $opt{'where'};
4086 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4092 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4093 use FS::cust_main::Search;
4096 FS::cust_main::Search->search(@_);
4105 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
4109 use FS::cust_main::Search;
4110 sub append_fuzzyfiles {
4111 #my( $first, $last, $company ) = @_;
4113 FS::cust_main::Search::check_and_rebuild_fuzzyfiles();
4115 use Fcntl qw(:flock);
4117 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
4119 foreach my $field (@fuzzyfields) {
4124 open(CACHE,">>$dir/cust_main.$field")
4125 or die "can't open $dir/cust_main.$field: $!";
4126 flock(CACHE,LOCK_EX)
4127 or die "can't lock $dir/cust_main.$field: $!";
4129 print CACHE "$value\n";
4131 flock(CACHE,LOCK_UN)
4132 or die "can't unlock $dir/cust_main.$field: $!";
4147 #warn join('-',keys %$param);
4148 my $fh = $param->{filehandle};
4149 my $agentnum = $param->{agentnum};
4150 my $format = $param->{format};
4152 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4155 if ( $format eq 'simple' ) {
4156 @fields = qw( custnum agent_custid amount pkg );
4158 die "unknown format $format";
4161 eval "use Text::CSV_XS;";
4164 my $csv = new Text::CSV_XS;
4171 local $SIG{HUP} = 'IGNORE';
4172 local $SIG{INT} = 'IGNORE';
4173 local $SIG{QUIT} = 'IGNORE';
4174 local $SIG{TERM} = 'IGNORE';
4175 local $SIG{TSTP} = 'IGNORE';
4176 local $SIG{PIPE} = 'IGNORE';
4178 my $oldAutoCommit = $FS::UID::AutoCommit;
4179 local $FS::UID::AutoCommit = 0;
4182 #while ( $columns = $csv->getline($fh) ) {
4184 while ( defined($line=<$fh>) ) {
4186 $csv->parse($line) or do {
4187 $dbh->rollback if $oldAutoCommit;
4188 return "can't parse: ". $csv->error_input();
4191 my @columns = $csv->fields();
4192 #warn join('-',@columns);
4195 foreach my $field ( @fields ) {
4196 $row{$field} = shift @columns;
4199 if ( $row{custnum} && $row{agent_custid} ) {
4200 dbh->rollback if $oldAutoCommit;
4201 return "can't specify custnum with agent_custid $row{agent_custid}";
4205 if ( $row{agent_custid} && $agentnum ) {
4206 %hash = ( 'agent_custid' => $row{agent_custid},
4207 'agentnum' => $agentnum,
4211 if ( $row{custnum} ) {
4212 %hash = ( 'custnum' => $row{custnum} );
4215 unless ( scalar(keys %hash) ) {
4216 $dbh->rollback if $oldAutoCommit;
4217 return "can't find customer without custnum or agent_custid and agentnum";
4220 my $cust_main = qsearchs('cust_main', { %hash } );
4221 unless ( $cust_main ) {
4222 $dbh->rollback if $oldAutoCommit;
4223 my $custnum = $row{custnum} || $row{agent_custid};
4224 return "unknown custnum $custnum";
4227 if ( $row{'amount'} > 0 ) {
4228 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4230 $dbh->rollback if $oldAutoCommit;
4234 } elsif ( $row{'amount'} < 0 ) {
4235 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4238 $dbh->rollback if $oldAutoCommit;
4248 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4250 return "Empty file!" unless $imported;
4256 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4258 Deprecated. Use event notification and message templates
4259 (L<FS::msg_template>) instead.
4261 Sends a templated email notification to the customer (see L<Text::Template>).
4263 OPTIONS is a hash and may include
4265 I<from> - the email sender (default is invoice_from)
4267 I<to> - comma-separated scalar or arrayref of recipients
4268 (default is invoicing_list)
4270 I<subject> - The subject line of the sent email notification
4271 (default is "Notice from company_name")
4273 I<extra_fields> - a hashref of name/value pairs which will be substituted
4276 The following variables are vavailable in the template.
4278 I<$first> - the customer first name
4279 I<$last> - the customer last name
4280 I<$company> - the customer company
4281 I<$payby> - a description of the method of payment for the customer
4282 # would be nice to use FS::payby::shortname
4283 I<$payinfo> - the account information used to collect for this customer
4284 I<$expdate> - the expiration of the customer payment in seconds from epoch
4289 my ($self, $template, %options) = @_;
4291 return unless $conf->exists($template);
4293 my $from = $conf->config('invoice_from', $self->agentnum)
4294 if $conf->exists('invoice_from', $self->agentnum);
4295 $from = $options{from} if exists($options{from});
4297 my $to = join(',', $self->invoicing_list_emailonly);
4298 $to = $options{to} if exists($options{to});
4300 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4301 if $conf->exists('company_name', $self->agentnum);
4302 $subject = $options{subject} if exists($options{subject});
4304 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4305 SOURCE => [ map "$_\n",
4306 $conf->config($template)]
4308 or die "can't create new Text::Template object: Text::Template::ERROR";
4309 $notify_template->compile()
4310 or die "can't compile template: Text::Template::ERROR";
4312 $FS::notify_template::_template::company_name =
4313 $conf->config('company_name', $self->agentnum);
4314 $FS::notify_template::_template::company_address =
4315 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4317 my $paydate = $self->paydate || '2037-12-31';
4318 $FS::notify_template::_template::first = $self->first;
4319 $FS::notify_template::_template::last = $self->last;
4320 $FS::notify_template::_template::company = $self->company;
4321 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4322 my $payby = $self->payby;
4323 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4324 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4326 #credit cards expire at the end of the month/year of their exp date
4327 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4328 $FS::notify_template::_template::payby = 'credit card';
4329 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4330 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4332 }elsif ($payby eq 'COMP') {
4333 $FS::notify_template::_template::payby = 'complimentary account';
4335 $FS::notify_template::_template::payby = 'current method';
4337 $FS::notify_template::_template::expdate = $expire_time;
4339 for (keys %{$options{extra_fields}}){
4341 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4344 send_email(from => $from,
4346 subject => $subject,
4347 body => $notify_template->fill_in( PACKAGE =>
4348 'FS::notify_template::_template' ),
4353 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4355 Generates a templated notification to the customer (see L<Text::Template>).
4357 OPTIONS is a hash and may include
4359 I<extra_fields> - a hashref of name/value pairs which will be substituted
4360 into the template. These values may override values mentioned below
4361 and those from the customer record.
4363 The following variables are available in the template instead of or in addition
4364 to the fields of the customer record.
4366 I<$payby> - a description of the method of payment for the customer
4367 # would be nice to use FS::payby::shortname
4368 I<$payinfo> - the masked account information used to collect for this customer
4369 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4370 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4374 # a lot like cust_bill::print_latex
4375 sub generate_letter {
4376 my ($self, $template, %options) = @_;
4378 return unless $conf->exists($template);
4380 my $letter_template = new Text::Template
4382 SOURCE => [ map "$_\n", $conf->config($template)],
4383 DELIMITERS => [ '[@--', '--@]' ],
4385 or die "can't create new Text::Template object: Text::Template::ERROR";
4387 $letter_template->compile()
4388 or die "can't compile template: Text::Template::ERROR";
4390 my %letter_data = map { $_ => $self->$_ } $self->fields;
4391 $letter_data{payinfo} = $self->mask_payinfo;
4393 #my $paydate = $self->paydate || '2037-12-31';
4394 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4396 my $payby = $self->payby;
4397 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4398 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4400 #credit cards expire at the end of the month/year of their exp date
4401 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4402 $letter_data{payby} = 'credit card';
4403 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4404 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4406 }elsif ($payby eq 'COMP') {
4407 $letter_data{payby} = 'complimentary account';
4409 $letter_data{payby} = 'current method';
4411 $letter_data{expdate} = $expire_time;
4413 for (keys %{$options{extra_fields}}){
4414 $letter_data{$_} = $options{extra_fields}->{$_};
4417 unless(exists($letter_data{returnaddress})){
4418 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4419 $self->agent_template)
4421 if ( length($retadd) ) {
4422 $letter_data{returnaddress} = $retadd;
4423 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4424 $letter_data{returnaddress} =
4425 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4429 ( $conf->config('company_name', $self->agentnum),
4430 $conf->config('company_address', $self->agentnum),
4434 $letter_data{returnaddress} = '~';
4438 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4440 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4442 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4444 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4448 ) or die "can't open temp file: $!\n";
4449 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4450 or die "can't write temp file: $!\n";
4452 $letter_data{'logo_file'} = $lh->filename;
4454 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4458 ) or die "can't open temp file: $!\n";
4460 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4462 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4463 return ($1, $letter_data{'logo_file'});
4467 =item print_ps TEMPLATE
4469 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4475 my($file, $lfile) = $self->generate_letter(@_);
4476 my $ps = FS::Misc::generate_ps($file);
4477 unlink($file.'.tex');
4483 =item print TEMPLATE
4485 Prints the filled in template.
4487 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4491 sub queueable_print {
4494 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4495 or die "invalid customer number: " . $opt{custvnum};
4497 my $error = $self->print( $opt{template} );
4498 die $error if $error;
4502 my ($self, $template) = (shift, shift);
4503 do_print [ $self->print_ps($template) ];
4506 #these three subs should just go away once agent stuff is all config overrides
4508 sub agent_template {
4510 $self->_agent_plandata('agent_templatename');
4513 sub agent_invoice_from {
4515 $self->_agent_plandata('agent_invoice_from');
4518 sub _agent_plandata {
4519 my( $self, $option ) = @_;
4521 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4522 #agent-specific Conf
4524 use FS::part_event::Condition;
4526 my $agentnum = $self->agentnum;
4528 my $regexp = regexp_sql();
4530 my $part_event_option =
4532 'select' => 'part_event_option.*',
4533 'table' => 'part_event_option',
4535 LEFT JOIN part_event USING ( eventpart )
4536 LEFT JOIN part_event_option AS peo_agentnum
4537 ON ( part_event.eventpart = peo_agentnum.eventpart
4538 AND peo_agentnum.optionname = 'agentnum'
4539 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4541 LEFT JOIN part_event_condition
4542 ON ( part_event.eventpart = part_event_condition.eventpart
4543 AND part_event_condition.conditionname = 'cust_bill_age'
4545 LEFT JOIN part_event_condition_option
4546 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4547 AND part_event_condition_option.optionname = 'age'
4550 #'hashref' => { 'optionname' => $option },
4551 #'hashref' => { 'part_event_option.optionname' => $option },
4553 " WHERE part_event_option.optionname = ". dbh->quote($option).
4554 " AND action = 'cust_bill_send_agent' ".
4555 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4556 " AND peo_agentnum.optionname = 'agentnum' ".
4557 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4559 CASE WHEN part_event_condition_option.optionname IS NULL
4561 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4563 , part_event.weight".
4567 unless ( $part_event_option ) {
4568 return $self->agent->invoice_template || ''
4569 if $option eq 'agent_templatename';
4573 $part_event_option->optionvalue;
4577 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4579 Subroutine (not a method), designed to be called from the queue.
4581 Takes a list of options and values.
4583 Pulls up the customer record via the custnum option and calls bill_and_collect.
4588 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4590 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4591 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4593 $cust_main->bill_and_collect( %args );
4596 sub process_bill_and_collect {
4598 my $param = thaw(decode_base64(shift));
4599 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4600 or die "custnum '$param->{custnum}' not found!\n";
4601 $param->{'job'} = $job;
4602 $param->{'fatal'} = 1; # runs from job queue, will be caught
4603 $param->{'retry'} = 1;
4605 $cust_main->bill_and_collect( %$param );
4608 sub _upgrade_data { #class method
4609 my ($class, %opts) = @_;
4611 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
4612 my $sth = dbh->prepare($sql) or die dbh->errstr;
4613 $sth->execute or die $sth->errstr;
4615 local($ignore_expired_card) = 1;
4616 local($ignore_illegal_zip) = 1;
4617 local($ignore_banned_card) = 1;
4618 local($skip_fuzzyfiles) = 1;
4619 $class->_upgrade_otaker(%opts);
4629 The delete method should possibly take an FS::cust_main object reference
4630 instead of a scalar customer number.
4632 Bill and collect options should probably be passed as references instead of a
4635 There should probably be a configuration file with a list of allowed credit
4638 No multiple currency support (probably a larger project than just this module).
4640 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4642 Birthdates rely on negative epoch values.
4644 The payby for card/check batches is broken. With mixed batching, bad
4647 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4651 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4652 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4653 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.