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')
1418 || $self->ut_floatn('credit_limit')
1421 #barf. need message catalogs. i18n. etc.
1422 $error .= "Please select an advertising source."
1423 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1424 return $error if $error;
1426 return "Unknown agent"
1427 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1429 return "Unknown refnum"
1430 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1432 return "Unknown referring custnum: ". $self->referral_custnum
1433 unless ! $self->referral_custnum
1434 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1436 if ( $self->censustract ne '' ) {
1437 $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1438 or return "Illegal census tract: ". $self->censustract;
1440 $self->censustract("$1.$2");
1443 if ( $self->ss eq '' ) {
1448 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1449 or return "Illegal social security number: ". $self->ss;
1450 $self->ss("$1-$2-$3");
1454 # bad idea to disable, causes billing to fail because of no tax rates later
1455 # except we don't fail any more
1456 unless ( $import ) {
1457 unless ( qsearch('cust_main_county', {
1458 'country' => $self->country,
1461 return "Unknown state/county/country: ".
1462 $self->state. "/". $self->county. "/". $self->country
1463 unless qsearch('cust_main_county',{
1464 'state' => $self->state,
1465 'county' => $self->county,
1466 'country' => $self->country,
1472 $self->ut_phonen('daytime', $self->country)
1473 || $self->ut_phonen('night', $self->country)
1474 || $self->ut_phonen('fax', $self->country)
1476 return $error if $error;
1478 unless ( $ignore_illegal_zip ) {
1479 $error = $self->ut_zip('zip', $self->country);
1480 return $error if $error;
1483 if ( $conf->exists('cust_main-require_phone')
1484 && ! length($self->daytime) && ! length($self->night)
1487 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1489 : FS::Msgcat::_gettext('daytime');
1490 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1492 : FS::Msgcat::_gettext('night');
1494 return "$daytime_label or $night_label is required"
1498 if ( $self->has_ship_address
1499 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1500 $self->addr_fields )
1504 $self->ut_name('ship_last')
1505 || $self->ut_name('ship_first')
1506 || $self->ut_textn('ship_company')
1507 || $self->ut_text('ship_address1')
1508 || $self->ut_textn('ship_address2')
1509 || $self->ut_text('ship_city')
1510 || $self->ut_textn('ship_county')
1511 || $self->ut_textn('ship_state')
1512 || $self->ut_country('ship_country')
1514 return $error if $error;
1516 #false laziness with above
1517 unless ( qsearchs('cust_main_county', {
1518 'country' => $self->ship_country,
1521 return "Unknown ship_state/ship_county/ship_country: ".
1522 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1523 unless qsearch('cust_main_county',{
1524 'state' => $self->ship_state,
1525 'county' => $self->ship_county,
1526 'country' => $self->ship_country,
1532 $self->ut_phonen('ship_daytime', $self->ship_country)
1533 || $self->ut_phonen('ship_night', $self->ship_country)
1534 || $self->ut_phonen('ship_fax', $self->ship_country)
1536 return $error if $error;
1538 unless ( $ignore_illegal_zip ) {
1539 $error = $self->ut_zip('ship_zip', $self->ship_country);
1540 return $error if $error;
1542 return "Unit # is required."
1543 if $self->ship_address2 =~ /^\s*$/
1544 && $conf->exists('cust_main-require_address2');
1546 } else { # ship_ info eq billing info, so don't store dup info in database
1548 $self->setfield("ship_$_", '')
1549 foreach $self->addr_fields;
1551 return "Unit # is required."
1552 if $self->address2 =~ /^\s*$/
1553 && $conf->exists('cust_main-require_address2');
1557 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1558 # or return "Illegal payby: ". $self->payby;
1560 FS::payby->can_payby($self->table, $self->payby)
1561 or return "Illegal payby: ". $self->payby;
1563 $error = $self->ut_numbern('paystart_month')
1564 || $self->ut_numbern('paystart_year')
1565 || $self->ut_numbern('payissue')
1566 || $self->ut_textn('paytype')
1568 return $error if $error;
1570 if ( $self->payip eq '' ) {
1573 $error = $self->ut_ip('payip');
1574 return $error if $error;
1577 # If it is encrypted and the private key is not availaible then we can't
1578 # check the credit card.
1579 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1581 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1583 my $payinfo = $self->payinfo;
1584 $payinfo =~ s/\D//g;
1585 $payinfo =~ /^(\d{13,16})$/
1586 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1588 $self->payinfo($payinfo);
1590 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1592 return gettext('unknown_card_type')
1593 if $self->payinfo !~ /^99\d{14}$/ #token
1594 && cardtype($self->payinfo) eq "Unknown";
1596 unless ( $ignore_banned_card ) {
1597 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1599 return 'Banned credit card: banned on '.
1600 time2str('%a %h %o at %r', $ban->_date).
1601 ' by '. $ban->otaker.
1602 ' (ban# '. $ban->bannum. ')';
1606 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1607 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1608 $self->paycvv =~ /^(\d{4})$/
1609 or return "CVV2 (CID) for American Express cards is four digits.";
1612 $self->paycvv =~ /^(\d{3})$/
1613 or return "CVV2 (CVC2/CID) is three digits.";
1620 my $cardtype = cardtype($payinfo);
1621 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1623 return "Start date or issue number is required for $cardtype cards"
1624 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1626 return "Start month must be between 1 and 12"
1627 if $self->paystart_month
1628 and $self->paystart_month < 1 || $self->paystart_month > 12;
1630 return "Start year must be 1990 or later"
1631 if $self->paystart_year
1632 and $self->paystart_year < 1990;
1634 return "Issue number must be beween 1 and 99"
1636 and $self->payissue < 1 || $self->payissue > 99;
1639 $self->paystart_month('');
1640 $self->paystart_year('');
1641 $self->payissue('');
1644 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1646 my $payinfo = $self->payinfo;
1647 $payinfo =~ s/[^\d\@]//g;
1648 if ( $conf->exists('echeck-nonus') ) {
1649 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1650 $payinfo = "$1\@$2";
1652 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1653 $payinfo = "$1\@$2";
1655 $self->payinfo($payinfo);
1658 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1660 return 'Banned ACH account: banned on '.
1661 time2str('%a %h %o at %r', $ban->_date).
1662 ' by '. $ban->otaker.
1663 ' (ban# '. $ban->bannum. ')';
1666 } elsif ( $self->payby eq 'LECB' ) {
1668 my $payinfo = $self->payinfo;
1669 $payinfo =~ s/\D//g;
1670 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1672 $self->payinfo($payinfo);
1675 } elsif ( $self->payby eq 'BILL' ) {
1677 $error = $self->ut_textn('payinfo');
1678 return "Illegal P.O. number: ". $self->payinfo if $error;
1681 } elsif ( $self->payby eq 'COMP' ) {
1683 my $curuser = $FS::CurrentUser::CurrentUser;
1684 if ( ! $self->custnum
1685 && ! $curuser->access_right('Complimentary customer')
1688 return "You are not permitted to create complimentary accounts."
1691 $error = $self->ut_textn('payinfo');
1692 return "Illegal comp account issuer: ". $self->payinfo if $error;
1695 } elsif ( $self->payby eq 'PREPAY' ) {
1697 my $payinfo = $self->payinfo;
1698 $payinfo =~ s/\W//g; #anything else would just confuse things
1699 $self->payinfo($payinfo);
1700 $error = $self->ut_alpha('payinfo');
1701 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1702 return "Unknown prepayment identifier"
1703 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1708 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1709 return "Expiration date required"
1710 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1714 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1715 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1716 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1717 ( $m, $y ) = ( $2, "19$1" );
1718 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1719 ( $m, $y ) = ( $3, "20$2" );
1721 return "Illegal expiration date: ". $self->paydate;
1723 $self->paydate("$y-$m-01");
1724 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1725 return gettext('expired_card')
1727 && !$ignore_expired_card
1728 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1731 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1732 ( ! $conf->exists('require_cardname')
1733 || $self->payby !~ /^(CARD|DCRD)$/ )
1735 $self->payname( $self->first. " ". $self->getfield('last') );
1737 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1738 or return gettext('illegal_name'). " payname: ". $self->payname;
1742 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1743 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1747 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1749 warn "$me check AFTER: \n". $self->_dump
1752 $self->SUPER::check;
1757 Returns a list of fields which have ship_ duplicates.
1762 qw( last first company
1763 address1 address2 city county state zip country
1768 =item has_ship_address
1770 Returns true if this customer record has a separate shipping address.
1774 sub has_ship_address {
1776 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1781 Returns a list of key/value pairs, with the following keys: address1, adddress2,
1782 city, county, state, zip, country. The shipping address is used if present.
1786 #geocode? dependent on tax-ship_address config, not available in cust_location
1787 #mostly. not yet then.
1791 my $prefix = $self->has_ship_address ? 'ship_' : '';
1793 map { $_ => $self->get($prefix.$_) }
1794 qw( address1 address2 city county state zip country geocode );
1795 #fields that cust_location has
1800 Returns all locations (see L<FS::cust_location>) for this customer.
1806 qsearch('cust_location', { 'custnum' => $self->custnum } );
1809 =item location_label [ OPTION => VALUE ... ]
1811 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
1819 used to separate the address elements (defaults to ', ')
1821 =item escape_function
1823 a callback used for escaping the text of the address elements
1829 # false laziness with FS::cust_location::line
1831 sub location_label {
1835 my $separator = $opt{join_string} || ', ';
1836 my $escape = $opt{escape_function} || sub{ shift };
1838 my $cydefault = FS::conf->new->config('countrydefault') || 'US';
1839 my $prefix = length($self->ship_last) ? 'ship_' : '';
1842 foreach (qw ( address1 address2 ) ) {
1843 my $method = "$prefix$_";
1844 $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
1849 foreach (qw ( city county state zip ) ) {
1850 my $method = "$prefix$_";
1851 if ( $self->$method ) {
1852 $line .= ' (' if $method eq 'county';
1853 $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
1854 $line .= ' )' if $method eq 'county';
1858 $line .= $separator. &$escape(code2country($self->country))
1859 if $self->country ne $cydefault;
1866 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1867 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1868 on success or a list of errors.
1874 grep { $_->unsuspend } $self->suspended_pkgs;
1879 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1881 Returns a list: an empty list on success or a list of errors.
1887 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1890 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1892 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1893 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
1894 of a list of pkgparts; the hashref has the following keys:
1898 =item pkgparts - listref of pkgparts
1900 =item (other options are passed to the suspend method)
1905 Returns a list: an empty list on success or a list of errors.
1909 sub suspend_if_pkgpart {
1911 my (@pkgparts, %opt);
1912 if (ref($_[0]) eq 'HASH'){
1913 @pkgparts = @{$_[0]{pkgparts}};
1918 grep { $_->suspend(%opt) }
1919 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1920 $self->unsuspended_pkgs;
1923 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1925 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1926 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
1927 instead of a list of pkgparts; the hashref has the following keys:
1931 =item pkgparts - listref of pkgparts
1933 =item (other options are passed to the suspend method)
1937 Returns a list: an empty list on success or a list of errors.
1941 sub suspend_unless_pkgpart {
1943 my (@pkgparts, %opt);
1944 if (ref($_[0]) eq 'HASH'){
1945 @pkgparts = @{$_[0]{pkgparts}};
1950 grep { $_->suspend(%opt) }
1951 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1952 $self->unsuspended_pkgs;
1955 =item cancel [ OPTION => VALUE ... ]
1957 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1959 Available options are:
1963 =item quiet - can be set true to supress email cancellation notices.
1965 =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.
1967 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
1969 =item nobill - can be set true to skip billing if it might otherwise be done.
1973 Always returns a list: an empty list on success or a list of errors.
1977 # nb that dates are not specified as valid options to this method
1980 my( $self, %opt ) = @_;
1982 warn "$me cancel called on customer ". $self->custnum. " with options ".
1983 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
1986 return ( 'access denied' )
1987 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
1989 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1991 #should try decryption (we might have the private key)
1992 # and if not maybe queue a job for the server that does?
1993 return ( "Can't (yet) ban encrypted credit cards" )
1994 if $self->is_encrypted($self->payinfo);
1996 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1997 my $error = $ban->insert;
1998 return ( $error ) if $error;
2002 my @pkgs = $self->ncancelled_pkgs;
2004 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2006 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2007 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2011 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2012 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2015 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2018 sub _banned_pay_hashref {
2029 'payby' => $payby2ban{$self->payby},
2030 'payinfo' => md5_base64($self->payinfo),
2031 #don't ever *search* on reason! #'reason' =>
2037 Returns all notes (see L<FS::cust_main_note>) for this customer.
2044 qsearch( 'cust_main_note',
2045 { 'custnum' => $self->custnum },
2047 'ORDER BY _DATE DESC'
2053 Returns the agent (see L<FS::agent>) for this customer.
2059 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2064 Returns the agent name (see L<FS::agent>) for this customer.
2070 $self->agent->agent;
2075 Returns any tags associated with this customer, as FS::cust_tag objects,
2076 or an empty list if there are no tags.
2082 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2087 Returns any tags associated with this customer, as FS::part_tag objects,
2088 or an empty list if there are no tags.
2094 map $_->part_tag, $self->cust_tag;
2100 Returns the customer class, as an FS::cust_class object, or the empty string
2101 if there is no customer class.
2107 if ( $self->classnum ) {
2108 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2116 Returns the customer category name, or the empty string if there is no customer
2123 my $cust_class = $self->cust_class;
2125 ? $cust_class->categoryname
2131 Returns the customer class name, or the empty string if there is no customer
2138 my $cust_class = $self->cust_class;
2140 ? $cust_class->classname
2144 =item BILLING METHODS
2146 Documentation on billing methods has been moved to
2147 L<FS::cust_main::Billing>.
2149 =item REALTIME BILLING METHODS
2151 Documentation on realtime billing methods has been moved to
2152 L<FS::cust_main::Billing_Realtime>.
2156 Removes the I<paycvv> field from the database directly.
2158 If there is an error, returns the error, otherwise returns false.
2164 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2165 or return dbh->errstr;
2166 $sth->execute($self->custnum)
2167 or return $sth->errstr;
2172 =item batch_card OPTION => VALUE...
2174 Adds a payment for this invoice to the pending credit card batch (see
2175 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2176 runs the payment using a realtime gateway.
2181 my ($self, %options) = @_;
2184 if (exists($options{amount})) {
2185 $amount = $options{amount};
2187 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2189 return '' unless $amount > 0;
2191 my $invnum = delete $options{invnum};
2192 my $payby = $options{payby} || $self->payby; #still dubious
2194 if ($options{'realtime'}) {
2195 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2201 my $oldAutoCommit = $FS::UID::AutoCommit;
2202 local $FS::UID::AutoCommit = 0;
2205 #this needs to handle mysql as well as Pg, like svc_acct.pm
2206 #(make it into a common function if folks need to do batching with mysql)
2207 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2208 or return "Cannot lock pay_batch: " . $dbh->errstr;
2212 'payby' => FS::payby->payby2payment($payby),
2215 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2217 unless ( $pay_batch ) {
2218 $pay_batch = new FS::pay_batch \%pay_batch;
2219 my $error = $pay_batch->insert;
2221 $dbh->rollback if $oldAutoCommit;
2222 die "error creating new batch: $error\n";
2226 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2227 'batchnum' => $pay_batch->batchnum,
2228 'custnum' => $self->custnum,
2231 foreach (qw( address1 address2 city state zip country payby payinfo paydate
2233 $options{$_} = '' unless exists($options{$_});
2236 my $cust_pay_batch = new FS::cust_pay_batch ( {
2237 'batchnum' => $pay_batch->batchnum,
2238 'invnum' => $invnum || 0, # is there a better value?
2239 # this field should be
2241 # cust_bill_pay_batch now
2242 'custnum' => $self->custnum,
2243 'last' => $self->getfield('last'),
2244 'first' => $self->getfield('first'),
2245 'address1' => $options{address1} || $self->address1,
2246 'address2' => $options{address2} || $self->address2,
2247 'city' => $options{city} || $self->city,
2248 'state' => $options{state} || $self->state,
2249 'zip' => $options{zip} || $self->zip,
2250 'country' => $options{country} || $self->country,
2251 'payby' => $options{payby} || $self->payby,
2252 'payinfo' => $options{payinfo} || $self->payinfo,
2253 'exp' => $options{paydate} || $self->paydate,
2254 'payname' => $options{payname} || $self->payname,
2255 'amount' => $amount, # consolidating
2258 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2259 if $old_cust_pay_batch;
2262 if ($old_cust_pay_batch) {
2263 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2265 $error = $cust_pay_batch->insert;
2269 $dbh->rollback if $oldAutoCommit;
2273 my $unapplied = $self->total_unapplied_credits
2274 + $self->total_unapplied_payments
2275 + $self->in_transit_payments;
2276 foreach my $cust_bill ($self->open_cust_bill) {
2277 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2278 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2279 'invnum' => $cust_bill->invnum,
2280 'paybatchnum' => $cust_pay_batch->paybatchnum,
2281 'amount' => $cust_bill->owed,
2284 if ($unapplied >= $cust_bill_pay_batch->amount){
2285 $unapplied -= $cust_bill_pay_batch->amount;
2288 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2289 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2291 $error = $cust_bill_pay_batch->insert;
2293 $dbh->rollback if $oldAutoCommit;
2298 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2304 Returns the total owed for this customer on all invoices
2305 (see L<FS::cust_bill/owed>).
2311 $self->total_owed_date(2145859200); #12/31/2037
2314 =item total_owed_date TIME
2316 Returns the total owed for this customer on all invoices with date earlier than
2317 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2318 see L<Time::Local> and L<Date::Parse> for conversion functions.
2322 sub total_owed_date {
2326 my $custnum = $self->custnum;
2328 my $owed_sql = FS::cust_bill->owed_sql;
2331 SELECT SUM($owed_sql) FROM cust_bill
2332 WHERE custnum = $custnum
2336 sprintf( "%.2f", $self->scalar_sql($sql) );
2340 =item total_owed_pkgnum PKGNUM
2342 Returns the total owed on all invoices for this customer's specific package
2343 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2347 sub total_owed_pkgnum {
2348 my( $self, $pkgnum ) = @_;
2349 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2352 =item total_owed_date_pkgnum TIME PKGNUM
2354 Returns the total owed for this customer's specific package when using
2355 experimental package balances on all invoices with date earlier than
2356 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2357 see L<Time::Local> and L<Date::Parse> for conversion functions.
2361 sub total_owed_date_pkgnum {
2362 my( $self, $time, $pkgnum ) = @_;
2365 foreach my $cust_bill (
2366 grep { $_->_date <= $time }
2367 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2369 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2371 sprintf( "%.2f", $total_bill );
2377 Returns the total amount of all payments.
2384 $total += $_->paid foreach $self->cust_pay;
2385 sprintf( "%.2f", $total );
2388 =item total_unapplied_credits
2390 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2391 customer. See L<FS::cust_credit/credited>.
2393 =item total_credited
2395 Old name for total_unapplied_credits. Don't use.
2399 sub total_credited {
2400 #carp "total_credited deprecated, use total_unapplied_credits";
2401 shift->total_unapplied_credits(@_);
2404 sub total_unapplied_credits {
2407 my $custnum = $self->custnum;
2409 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2412 SELECT SUM($unapplied_sql) FROM cust_credit
2413 WHERE custnum = $custnum
2416 sprintf( "%.2f", $self->scalar_sql($sql) );
2420 =item total_unapplied_credits_pkgnum PKGNUM
2422 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2423 customer. See L<FS::cust_credit/credited>.
2427 sub total_unapplied_credits_pkgnum {
2428 my( $self, $pkgnum ) = @_;
2429 my $total_credit = 0;
2430 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2431 sprintf( "%.2f", $total_credit );
2435 =item total_unapplied_payments
2437 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2438 See L<FS::cust_pay/unapplied>.
2442 sub total_unapplied_payments {
2445 my $custnum = $self->custnum;
2447 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2450 SELECT SUM($unapplied_sql) FROM cust_pay
2451 WHERE custnum = $custnum
2454 sprintf( "%.2f", $self->scalar_sql($sql) );
2458 =item total_unapplied_payments_pkgnum PKGNUM
2460 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2461 specific package when using experimental package balances. See
2462 L<FS::cust_pay/unapplied>.
2466 sub total_unapplied_payments_pkgnum {
2467 my( $self, $pkgnum ) = @_;
2468 my $total_unapplied = 0;
2469 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2470 sprintf( "%.2f", $total_unapplied );
2474 =item total_unapplied_refunds
2476 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2477 customer. See L<FS::cust_refund/unapplied>.
2481 sub total_unapplied_refunds {
2483 my $custnum = $self->custnum;
2485 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2488 SELECT SUM($unapplied_sql) FROM cust_refund
2489 WHERE custnum = $custnum
2492 sprintf( "%.2f", $self->scalar_sql($sql) );
2498 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2499 total_unapplied_credits minus total_unapplied_payments).
2505 $self->balance_date_range;
2508 =item balance_date TIME
2510 Returns the balance for this customer, only considering invoices with date
2511 earlier than TIME (total_owed_date minus total_credited minus
2512 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2513 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2520 $self->balance_date_range(shift);
2523 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2525 Returns the balance for this customer, optionally considering invoices with
2526 date earlier than START_TIME, and not later than END_TIME
2527 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2529 Times are specified as SQL fragments or numeric
2530 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2531 L<Date::Parse> for conversion functions. The empty string can be passed
2532 to disable that time constraint completely.
2534 Available options are:
2538 =item unapplied_date
2540 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)
2546 sub balance_date_range {
2548 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2549 ') FROM cust_main WHERE custnum='. $self->custnum;
2550 sprintf( '%.2f', $self->scalar_sql($sql) );
2553 =item balance_pkgnum PKGNUM
2555 Returns the balance for this customer's specific package when using
2556 experimental package balances (total_owed plus total_unrefunded, minus
2557 total_unapplied_credits minus total_unapplied_payments)
2561 sub balance_pkgnum {
2562 my( $self, $pkgnum ) = @_;
2565 $self->total_owed_pkgnum($pkgnum)
2566 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2567 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2568 - $self->total_unapplied_credits_pkgnum($pkgnum)
2569 - $self->total_unapplied_payments_pkgnum($pkgnum)
2573 =item in_transit_payments
2575 Returns the total of requests for payments for this customer pending in
2576 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
2580 sub in_transit_payments {
2582 my $in_transit_payments = 0;
2583 foreach my $pay_batch ( qsearch('pay_batch', {
2586 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2587 'batchnum' => $pay_batch->batchnum,
2588 'custnum' => $self->custnum,
2590 $in_transit_payments += $cust_pay_batch->amount;
2593 sprintf( "%.2f", $in_transit_payments );
2598 Returns a hash of useful information for making a payment.
2608 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2609 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2610 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2614 For credit card transactions:
2626 For electronic check transactions:
2641 $return{balance} = $self->balance;
2643 $return{payname} = $self->payname
2644 || ( $self->first. ' '. $self->get('last') );
2646 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
2648 $return{payby} = $self->payby;
2649 $return{stateid_state} = $self->stateid_state;
2651 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2652 $return{card_type} = cardtype($self->payinfo);
2653 $return{payinfo} = $self->paymask;
2655 @return{'month', 'year'} = $self->paydate_monthyear;
2659 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2660 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2661 $return{payinfo1} = $payinfo1;
2662 $return{payinfo2} = $payinfo2;
2663 $return{paytype} = $self->paytype;
2664 $return{paystate} = $self->paystate;
2668 #doubleclick protection
2670 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2676 =item paydate_monthyear
2678 Returns a two-element list consisting of the month and year of this customer's
2679 paydate (credit card expiration date for CARD customers)
2683 sub paydate_monthyear {
2685 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2687 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2694 =item tax_exemption TAXNAME
2699 my( $self, $taxname ) = @_;
2701 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2702 'taxname' => $taxname,
2707 =item cust_main_exemption
2711 sub cust_main_exemption {
2713 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
2716 =item invoicing_list [ ARRAYREF ]
2718 If an arguement is given, sets these email addresses as invoice recipients
2719 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2720 (except as warnings), so use check_invoicing_list first.
2722 Returns a list of email addresses (with svcnum entries expanded).
2724 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2725 check it without disturbing anything by passing nothing.
2727 This interface may change in the future.
2731 sub invoicing_list {
2732 my( $self, $arrayref ) = @_;
2735 my @cust_main_invoice;
2736 if ( $self->custnum ) {
2737 @cust_main_invoice =
2738 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2740 @cust_main_invoice = ();
2742 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2743 #warn $cust_main_invoice->destnum;
2744 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2745 #warn $cust_main_invoice->destnum;
2746 my $error = $cust_main_invoice->delete;
2747 warn $error if $error;
2750 if ( $self->custnum ) {
2751 @cust_main_invoice =
2752 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2754 @cust_main_invoice = ();
2756 my %seen = map { $_->address => 1 } @cust_main_invoice;
2757 foreach my $address ( @{$arrayref} ) {
2758 next if exists $seen{$address} && $seen{$address};
2759 $seen{$address} = 1;
2760 my $cust_main_invoice = new FS::cust_main_invoice ( {
2761 'custnum' => $self->custnum,
2764 my $error = $cust_main_invoice->insert;
2765 warn $error if $error;
2769 if ( $self->custnum ) {
2771 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2778 =item check_invoicing_list ARRAYREF
2780 Checks these arguements as valid input for the invoicing_list method. If there
2781 is an error, returns the error, otherwise returns false.
2785 sub check_invoicing_list {
2786 my( $self, $arrayref ) = @_;
2788 foreach my $address ( @$arrayref ) {
2790 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2791 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2794 my $cust_main_invoice = new FS::cust_main_invoice ( {
2795 'custnum' => $self->custnum,
2798 my $error = $self->custnum
2799 ? $cust_main_invoice->check
2800 : $cust_main_invoice->checkdest
2802 return $error if $error;
2806 return "Email address required"
2807 if $conf->exists('cust_main-require_invoicing_list_email')
2808 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2813 =item set_default_invoicing_list
2815 Sets the invoicing list to all accounts associated with this customer,
2816 overwriting any previous invoicing list.
2820 sub set_default_invoicing_list {
2822 $self->invoicing_list($self->all_emails);
2827 Returns the email addresses of all accounts provisioned for this customer.
2834 foreach my $cust_pkg ( $self->all_pkgs ) {
2835 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2837 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2838 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2840 $list{$_}=1 foreach map { $_->email } @svc_acct;
2845 =item invoicing_list_addpost
2847 Adds postal invoicing to this customer. If this customer is already configured
2848 to receive postal invoices, does nothing.
2852 sub invoicing_list_addpost {
2854 return if grep { $_ eq 'POST' } $self->invoicing_list;
2855 my @invoicing_list = $self->invoicing_list;
2856 push @invoicing_list, 'POST';
2857 $self->invoicing_list(\@invoicing_list);
2860 =item invoicing_list_emailonly
2862 Returns the list of email invoice recipients (invoicing_list without non-email
2863 destinations such as POST and FAX).
2867 sub invoicing_list_emailonly {
2869 warn "$me invoicing_list_emailonly called"
2871 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
2874 =item invoicing_list_emailonly_scalar
2876 Returns the list of email invoice recipients (invoicing_list without non-email
2877 destinations such as POST and FAX) as a comma-separated scalar.
2881 sub invoicing_list_emailonly_scalar {
2883 warn "$me invoicing_list_emailonly_scalar called"
2885 join(', ', $self->invoicing_list_emailonly);
2888 =item referral_custnum_cust_main
2890 Returns the customer who referred this customer (or the empty string, if
2891 this customer was not referred).
2893 Note the difference with referral_cust_main method: This method,
2894 referral_custnum_cust_main returns the single customer (if any) who referred
2895 this customer, while referral_cust_main returns an array of customers referred
2900 sub referral_custnum_cust_main {
2902 return '' unless $self->referral_custnum;
2903 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2906 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2908 Returns an array of customers referred by this customer (referral_custnum set
2909 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2910 customers referred by customers referred by this customer and so on, inclusive.
2911 The default behavior is DEPTH 1 (no recursion).
2913 Note the difference with referral_custnum_cust_main method: This method,
2914 referral_cust_main, returns an array of customers referred BY this customer,
2915 while referral_custnum_cust_main returns the single customer (if any) who
2916 referred this customer.
2920 sub referral_cust_main {
2922 my $depth = @_ ? shift : 1;
2923 my $exclude = @_ ? shift : {};
2926 map { $exclude->{$_->custnum}++; $_; }
2927 grep { ! $exclude->{ $_->custnum } }
2928 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2932 map { $_->referral_cust_main($depth-1, $exclude) }
2939 =item referral_cust_main_ncancelled
2941 Same as referral_cust_main, except only returns customers with uncancelled
2946 sub referral_cust_main_ncancelled {
2948 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2951 =item referral_cust_pkg [ DEPTH ]
2953 Like referral_cust_main, except returns a flat list of all unsuspended (and
2954 uncancelled) packages for each customer. The number of items in this list may
2955 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2959 sub referral_cust_pkg {
2961 my $depth = @_ ? shift : 1;
2963 map { $_->unsuspended_pkgs }
2964 grep { $_->unsuspended_pkgs }
2965 $self->referral_cust_main($depth);
2968 =item referring_cust_main
2970 Returns the single cust_main record for the customer who referred this customer
2971 (referral_custnum), or false.
2975 sub referring_cust_main {
2977 return '' unless $self->referral_custnum;
2978 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2981 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
2983 Applies a credit to this customer. If there is an error, returns the error,
2984 otherwise returns false.
2986 REASON can be a text string, an FS::reason object, or a scalar reference to
2987 a reasonnum. If a text string, it will be automatically inserted as a new
2988 reason, and a 'reason_type' option must be passed to indicate the
2989 FS::reason_type for the new reason.
2991 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
2993 Any other options are passed to FS::cust_credit::insert.
2998 my( $self, $amount, $reason, %options ) = @_;
3000 my $cust_credit = new FS::cust_credit {
3001 'custnum' => $self->custnum,
3002 'amount' => $amount,
3005 if ( ref($reason) ) {
3007 if ( ref($reason) eq 'SCALAR' ) {
3008 $cust_credit->reasonnum( $$reason );
3010 $cust_credit->reasonnum( $reason->reasonnum );
3014 $cust_credit->set('reason', $reason)
3017 for (qw( addlinfo eventnum )) {
3018 $cust_credit->$_( delete $options{$_} )
3019 if exists($options{$_});
3022 $cust_credit->insert(%options);
3026 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3028 Creates a one-time charge for this customer. If there is an error, returns
3029 the error, otherwise returns false.
3031 New-style, with a hashref of options:
3033 my $error = $cust_main->charge(
3037 'start_date' => str2time('7/4/2009'),
3038 'pkg' => 'Description',
3039 'comment' => 'Comment',
3040 'additional' => [], #extra invoice detail
3041 'classnum' => 1, #pkg_class
3043 'setuptax' => '', # or 'Y' for tax exempt
3046 'taxclass' => 'Tax class',
3049 'taxproduct' => 2, #part_pkg_taxproduct
3050 'override' => {}, #XXX describe
3052 #will be filled in with the new object
3053 'cust_pkg_ref' => \$cust_pkg,
3055 #generate an invoice immediately
3057 'invoice_terms' => '', #with these terms
3063 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3069 my ( $amount, $quantity, $start_date, $classnum );
3070 my ( $pkg, $comment, $additional );
3071 my ( $setuptax, $taxclass ); #internal taxes
3072 my ( $taxproduct, $override ); #vendor (CCH) taxes
3074 my $cust_pkg_ref = '';
3075 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3076 if ( ref( $_[0] ) ) {
3077 $amount = $_[0]->{amount};
3078 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3079 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3080 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3081 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3082 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3083 : '$'. sprintf("%.2f",$amount);
3084 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3085 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3086 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3087 $additional = $_[0]->{additional} || [];
3088 $taxproduct = $_[0]->{taxproductnum};
3089 $override = { '' => $_[0]->{tax_override} };
3090 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3091 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3092 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3097 $pkg = @_ ? shift : 'One-time charge';
3098 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3100 $taxclass = @_ ? shift : '';
3104 local $SIG{HUP} = 'IGNORE';
3105 local $SIG{INT} = 'IGNORE';
3106 local $SIG{QUIT} = 'IGNORE';
3107 local $SIG{TERM} = 'IGNORE';
3108 local $SIG{TSTP} = 'IGNORE';
3109 local $SIG{PIPE} = 'IGNORE';
3111 my $oldAutoCommit = $FS::UID::AutoCommit;
3112 local $FS::UID::AutoCommit = 0;
3115 my $part_pkg = new FS::part_pkg ( {
3117 'comment' => $comment,
3121 'classnum' => ( $classnum ? $classnum : '' ),
3122 'setuptax' => $setuptax,
3123 'taxclass' => $taxclass,
3124 'taxproductnum' => $taxproduct,
3127 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3128 ( 0 .. @$additional - 1 )
3130 'additional_count' => scalar(@$additional),
3131 'setup_fee' => $amount,
3134 my $error = $part_pkg->insert( options => \%options,
3135 tax_overrides => $override,
3138 $dbh->rollback if $oldAutoCommit;
3142 my $pkgpart = $part_pkg->pkgpart;
3143 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3144 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3145 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3146 $error = $type_pkgs->insert;
3148 $dbh->rollback if $oldAutoCommit;
3153 my $cust_pkg = new FS::cust_pkg ( {
3154 'custnum' => $self->custnum,
3155 'pkgpart' => $pkgpart,
3156 'quantity' => $quantity,
3157 'start_date' => $start_date,
3158 'no_auto' => $no_auto,
3161 $error = $cust_pkg->insert;
3163 $dbh->rollback if $oldAutoCommit;
3165 } elsif ( $cust_pkg_ref ) {
3166 ${$cust_pkg_ref} = $cust_pkg;
3170 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3171 'pkg_list' => [ $cust_pkg ],
3174 $dbh->rollback if $oldAutoCommit;
3179 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3184 #=item charge_postal_fee
3186 #Applies a one time charge this customer. If there is an error,
3187 #returns the error, returns the cust_pkg charge object or false
3188 #if there was no charge.
3192 # This should be a customer event. For that to work requires that bill
3193 # also be a customer event.
3195 sub charge_postal_fee {
3198 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
3199 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3201 my $cust_pkg = new FS::cust_pkg ( {
3202 'custnum' => $self->custnum,
3203 'pkgpart' => $pkgpart,
3207 my $error = $cust_pkg->insert;
3208 $error ? $error : $cust_pkg;
3211 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3213 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3215 Optionally, a list or hashref of additional arguments to the qsearch call can
3222 my $opt = ref($_[0]) ? shift : { @_ };
3224 #return $self->num_cust_bill unless wantarray || keys %$opt;
3226 $opt->{'table'} = 'cust_bill';
3227 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3228 $opt->{'hashref'}{'custnum'} = $self->custnum;
3229 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3231 map { $_ } #behavior of sort undefined in scalar context
3232 sort { $a->_date <=> $b->_date }
3236 =item open_cust_bill
3238 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3243 sub open_cust_bill {
3247 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3253 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3255 Returns all the statements (see L<FS::cust_statement>) for this customer.
3257 Optionally, a list or hashref of additional arguments to the qsearch call can
3262 sub cust_statement {
3264 my $opt = ref($_[0]) ? shift : { @_ };
3266 #return $self->num_cust_statement unless wantarray || keys %$opt;
3268 $opt->{'table'} = 'cust_statement';
3269 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3270 $opt->{'hashref'}{'custnum'} = $self->custnum;
3271 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3273 map { $_ } #behavior of sort undefined in scalar context
3274 sort { $a->_date <=> $b->_date }
3280 Returns all the credits (see L<FS::cust_credit>) for this customer.
3286 map { $_ } #return $self->num_cust_credit unless wantarray;
3287 sort { $a->_date <=> $b->_date }
3288 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3291 =item cust_credit_pkgnum
3293 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3294 package when using experimental package balances.
3298 sub cust_credit_pkgnum {
3299 my( $self, $pkgnum ) = @_;
3300 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3301 sort { $a->_date <=> $b->_date }
3302 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3303 'pkgnum' => $pkgnum,
3310 Returns all the payments (see L<FS::cust_pay>) for this customer.
3316 return $self->num_cust_pay unless wantarray;
3317 sort { $a->_date <=> $b->_date }
3318 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3323 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3324 called automatically when the cust_pay method is used in a scalar context.
3330 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3331 my $sth = dbh->prepare($sql) or die dbh->errstr;
3332 $sth->execute($self->custnum) or die $sth->errstr;
3333 $sth->fetchrow_arrayref->[0];
3336 =item cust_pay_pkgnum
3338 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3339 package when using experimental package balances.
3343 sub cust_pay_pkgnum {
3344 my( $self, $pkgnum ) = @_;
3345 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3346 sort { $a->_date <=> $b->_date }
3347 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3348 'pkgnum' => $pkgnum,
3355 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3361 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3362 sort { $a->_date <=> $b->_date }
3363 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3366 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3368 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3370 Optionally, a list or hashref of additional arguments to the qsearch call can
3375 sub cust_pay_batch {
3377 my $opt = ref($_[0]) ? shift : { @_ };
3379 #return $self->num_cust_statement unless wantarray || keys %$opt;
3381 $opt->{'table'} = 'cust_pay_batch';
3382 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3383 $opt->{'hashref'}{'custnum'} = $self->custnum;
3384 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3386 map { $_ } #behavior of sort undefined in scalar context
3387 sort { $a->paybatchnum <=> $b->paybatchnum }
3391 =item cust_pay_pending
3393 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3394 (without status "done").
3398 sub cust_pay_pending {
3400 return $self->num_cust_pay_pending unless wantarray;
3401 sort { $a->_date <=> $b->_date }
3402 qsearch( 'cust_pay_pending', {
3403 'custnum' => $self->custnum,
3404 'status' => { op=>'!=', value=>'done' },
3409 =item cust_pay_pending_attempt
3411 Returns all payment attempts / declined payments for this customer, as pending
3412 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3413 a corresponding payment (see L<FS::cust_pay>).
3417 sub cust_pay_pending_attempt {
3419 return $self->num_cust_pay_pending_attempt unless wantarray;
3420 sort { $a->_date <=> $b->_date }
3421 qsearch( 'cust_pay_pending', {
3422 'custnum' => $self->custnum,
3429 =item num_cust_pay_pending
3431 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3432 customer (without status "done"). Also called automatically when the
3433 cust_pay_pending method is used in a scalar context.
3437 sub num_cust_pay_pending {
3440 " SELECT COUNT(*) FROM cust_pay_pending ".
3441 " WHERE custnum = ? AND status != 'done' ",
3446 =item num_cust_pay_pending_attempt
3448 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3449 customer, with status "done" but without a corresp. Also called automatically when the
3450 cust_pay_pending method is used in a scalar context.
3454 sub num_cust_pay_pending_attempt {
3457 " SELECT COUNT(*) FROM cust_pay_pending ".
3458 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3465 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3471 map { $_ } #return $self->num_cust_refund unless wantarray;
3472 sort { $a->_date <=> $b->_date }
3473 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3476 =item display_custnum
3478 Returns the displayed customer number for this customer: agent_custid if
3479 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3483 sub display_custnum {
3485 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3486 return $self->agent_custid;
3488 return $self->custnum;
3494 Returns a name string for this customer, either "Company (Last, First)" or
3501 my $name = $self->contact;
3502 $name = $self->company. " ($name)" if $self->company;
3508 Returns a name string for this (service/shipping) contact, either
3509 "Company (Last, First)" or "Last, First".
3515 if ( $self->get('ship_last') ) {
3516 my $name = $self->ship_contact;
3517 $name = $self->ship_company. " ($name)" if $self->ship_company;
3526 Returns a name string for this customer, either "Company" or "First Last".
3532 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3535 =item ship_name_short
3537 Returns a name string for this (service/shipping) contact, either "Company"
3542 sub ship_name_short {
3544 if ( $self->get('ship_last') ) {
3545 $self->ship_company !~ /^\s*$/
3546 ? $self->ship_company
3547 : $self->ship_contact_firstlast;
3549 $self->name_company_or_firstlast;
3555 Returns this customer's full (billing) contact name only, "Last, First"
3561 $self->get('last'). ', '. $self->first;
3566 Returns this customer's full (shipping) contact name only, "Last, First"
3572 $self->get('ship_last')
3573 ? $self->get('ship_last'). ', '. $self->ship_first
3577 =item contact_firstlast
3579 Returns this customers full (billing) contact name only, "First Last".
3583 sub contact_firstlast {
3585 $self->first. ' '. $self->get('last');
3588 =item ship_contact_firstlast
3590 Returns this customer's full (shipping) contact name only, "First Last".
3594 sub ship_contact_firstlast {
3596 $self->get('ship_last')
3597 ? $self->first. ' '. $self->get('ship_last')
3598 : $self->contact_firstlast;
3603 Returns this customer's full country name
3609 code2country($self->country);
3612 =item geocode DATA_VENDOR
3614 Returns a value for the customer location as encoded by DATA_VENDOR.
3615 Currently this only makes sense for "CCH" as DATA_VENDOR.
3620 my ($self, $data_vendor) = (shift, shift); #always cch for now
3622 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
3623 return $geocode if $geocode;
3625 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3629 my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
3630 if $self->country eq 'US';
3634 #CCH specific location stuff
3635 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
3637 my @cust_tax_location =
3639 'table' => 'cust_tax_location',
3640 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
3641 'extra_sql' => $extra_sql,
3642 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
3645 $geocode = $cust_tax_location[0]->geocode
3646 if scalar(@cust_tax_location);
3655 Returns a status string for this customer, currently:
3659 =item prospect - No packages have ever been ordered
3661 =item ordered - Recurring packages all are new (not yet billed).
3663 =item active - One or more recurring packages is active
3665 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3667 =item suspended - All non-cancelled recurring packages are suspended
3669 =item cancelled - All recurring packages are cancelled
3675 sub status { shift->cust_status(@_); }
3679 # prospect ordered active inactive suspended cancelled
3680 for my $status ( FS::cust_main->statuses() ) {
3681 my $method = $status.'_sql';
3682 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3683 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3684 $sth->execute( ($self->custnum) x $numnum )
3685 or die "Error executing 'SELECT $sql': ". $sth->errstr;
3686 return $status if $sth->fetchrow_arrayref->[0];
3690 =item ucfirst_cust_status
3692 =item ucfirst_status
3694 Returns the status with the first character capitalized.
3698 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
3700 sub ucfirst_cust_status {
3702 ucfirst($self->cust_status);
3707 Returns a hex triplet color string for this customer's status.
3711 use vars qw(%statuscolor);
3712 tie %statuscolor, 'Tie::IxHash',
3713 'prospect' => '7e0079', #'000000', #black? naw, purple
3714 'active' => '00CC00', #green
3715 'ordered' => '009999', #teal? cyan?
3716 'inactive' => '0000CC', #blue
3717 'suspended' => 'FF9900', #yellow
3718 'cancelled' => 'FF0000', #red
3721 sub statuscolor { shift->cust_statuscolor(@_); }
3723 sub cust_statuscolor {
3725 $statuscolor{$self->cust_status};
3730 Returns an array of hashes representing the customer's RT tickets.
3737 my $num = $conf->config('cust_main-max_tickets') || 10;
3740 if ( $conf->config('ticket_system') ) {
3741 unless ( $conf->config('ticket_system-custom_priority_field') ) {
3743 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
3747 foreach my $priority (
3748 $conf->config('ticket_system-custom_priority_field-values'), ''
3750 last if scalar(@tickets) >= $num;
3752 @{ FS::TicketSystem->customer_tickets( $self->custnum,
3753 $num - scalar(@tickets),
3763 # Return services representing svc_accts in customer support packages
3764 sub support_services {
3766 my %packages = map { $_ => 1 } $conf->config('support_packages');
3768 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
3769 grep { $_->part_svc->svcdb eq 'svc_acct' }
3770 map { $_->cust_svc }
3771 grep { exists $packages{ $_->pkgpart } }
3772 $self->ncancelled_pkgs;
3776 # Return a list of latitude/longitude for one of the services (if any)
3777 sub service_coordinates {
3781 grep { $_->latitude && $_->longitude }
3783 map { $_->cust_svc }
3784 $self->ncancelled_pkgs;
3786 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
3791 Returns a masked version of the named field
3796 my ($self,$field) = @_;
3800 'x'x(length($self->getfield($field))-4).
3801 substr($self->getfield($field), (length($self->getfield($field))-4));
3807 =head1 CLASS METHODS
3813 Class method that returns the list of possible status strings for customers
3814 (see L<the status method|/status>). For example:
3816 @statuses = FS::cust_main->statuses();
3821 #my $self = shift; #could be class...
3827 Returns an SQL expression identifying prospective cust_main records (customers
3828 with no packages ever ordered)
3832 use vars qw($select_count_pkgs);
3833 $select_count_pkgs =
3834 "SELECT COUNT(*) FROM cust_pkg
3835 WHERE cust_pkg.custnum = cust_main.custnum";
3837 sub select_count_pkgs_sql {
3842 " 0 = ( $select_count_pkgs ) ";
3847 Returns an SQL expression identifying ordered cust_main records (customers with
3848 recurring packages not yet setup).
3853 FS::cust_main->none_active_sql.
3854 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
3859 Returns an SQL expression identifying active cust_main records (customers with
3860 active recurring packages).
3865 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
3868 =item none_active_sql
3870 Returns an SQL expression identifying cust_main records with no active
3871 recurring packages. This includes customers of status prospect, ordered,
3872 inactive, and suspended.
3876 sub none_active_sql {
3877 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
3882 Returns an SQL expression identifying inactive cust_main records (customers with
3883 no active recurring packages, but otherwise unsuspended/uncancelled).
3888 FS::cust_main->none_active_sql.
3889 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
3895 Returns an SQL expression identifying suspended cust_main records.
3900 sub suspended_sql { susp_sql(@_); }
3902 FS::cust_main->none_active_sql.
3903 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
3909 Returns an SQL expression identifying cancelled cust_main records.
3913 sub cancelled_sql { cancel_sql(@_); }
3916 my $recurring_sql = FS::cust_pkg->recurring_sql;
3917 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
3920 0 < ( $select_count_pkgs )
3921 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
3922 AND 0 = ( $select_count_pkgs AND $recurring_sql
3923 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3925 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3931 =item uncancelled_sql
3933 Returns an SQL expression identifying un-cancelled cust_main records.
3937 sub uncancelled_sql { uncancel_sql(@_); }
3938 sub uncancel_sql { "
3939 ( 0 < ( $select_count_pkgs
3940 AND ( cust_pkg.cancel IS NULL
3941 OR cust_pkg.cancel = 0
3944 OR 0 = ( $select_count_pkgs )
3950 Returns an SQL fragment to retreive the balance.
3955 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
3956 WHERE cust_bill.custnum = cust_main.custnum )
3957 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
3958 WHERE cust_pay.custnum = cust_main.custnum )
3959 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
3960 WHERE cust_credit.custnum = cust_main.custnum )
3961 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
3962 WHERE cust_refund.custnum = cust_main.custnum )
3965 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3967 Returns an SQL fragment to retreive the balance for this customer, optionally
3968 considering invoices with date earlier than START_TIME, and not
3969 later than END_TIME (total_owed_date minus total_unapplied_credits minus
3970 total_unapplied_payments).
3972 Times are specified as SQL fragments or numeric
3973 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
3974 L<Date::Parse> for conversion functions. The empty string can be passed
3975 to disable that time constraint completely.
3977 Available options are:
3981 =item unapplied_date
3983 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)
3988 set to true to remove all customer comparison clauses, for totals
3993 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
3998 JOIN clause (typically used with the total option)
4002 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4003 time will be ignored. Note that START_TIME and END_TIME only limit the date
4004 range for invoices and I<unapplied> payments, credits, and refunds.
4010 sub balance_date_sql {
4011 my( $class, $start, $end, %opt ) = @_;
4013 my $cutoff = $opt{'cutoff'};
4015 my $owed = FS::cust_bill->owed_sql($cutoff);
4016 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4017 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4018 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4020 my $j = $opt{'join'} || '';
4022 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4023 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4024 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4025 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4027 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4028 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4029 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4030 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4035 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4037 Returns an SQL fragment to retreive the total unapplied payments for this
4038 customer, only considering invoices with date earlier than START_TIME, and
4039 optionally not later than END_TIME.
4041 Times are specified as SQL fragments or numeric
4042 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4043 L<Date::Parse> for conversion functions. The empty string can be passed
4044 to disable that time constraint completely.
4046 Available options are:
4050 sub unapplied_payments_date_sql {
4051 my( $class, $start, $end, %opt ) = @_;
4053 my $cutoff = $opt{'cutoff'};
4055 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4057 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4058 'unapplied_date'=>1 );
4060 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4063 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4065 Helper method for balance_date_sql; name (and usage) subject to change
4066 (suggestions welcome).
4068 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4069 cust_refund, cust_credit or cust_pay).
4071 If TABLE is "cust_bill" or the unapplied_date option is true, only
4072 considers records with date earlier than START_TIME, and optionally not
4073 later than END_TIME .
4077 sub _money_table_where {
4078 my( $class, $table, $start, $end, %opt ) = @_;
4081 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4082 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4083 push @where, "$table._date <= $start" if defined($start) && length($start);
4084 push @where, "$table._date > $end" if defined($end) && length($end);
4086 push @where, @{$opt{'where'}} if $opt{'where'};
4087 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4093 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4094 use FS::cust_main::Search;
4097 FS::cust_main::Search->search(@_);
4106 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
4110 use FS::cust_main::Search;
4111 sub append_fuzzyfiles {
4112 #my( $first, $last, $company ) = @_;
4114 FS::cust_main::Search::check_and_rebuild_fuzzyfiles();
4116 use Fcntl qw(:flock);
4118 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
4120 foreach my $field (@fuzzyfields) {
4125 open(CACHE,">>$dir/cust_main.$field")
4126 or die "can't open $dir/cust_main.$field: $!";
4127 flock(CACHE,LOCK_EX)
4128 or die "can't lock $dir/cust_main.$field: $!";
4130 print CACHE "$value\n";
4132 flock(CACHE,LOCK_UN)
4133 or die "can't unlock $dir/cust_main.$field: $!";
4148 #warn join('-',keys %$param);
4149 my $fh = $param->{filehandle};
4150 my $agentnum = $param->{agentnum};
4151 my $format = $param->{format};
4153 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4156 if ( $format eq 'simple' ) {
4157 @fields = qw( custnum agent_custid amount pkg );
4159 die "unknown format $format";
4162 eval "use Text::CSV_XS;";
4165 my $csv = new Text::CSV_XS;
4172 local $SIG{HUP} = 'IGNORE';
4173 local $SIG{INT} = 'IGNORE';
4174 local $SIG{QUIT} = 'IGNORE';
4175 local $SIG{TERM} = 'IGNORE';
4176 local $SIG{TSTP} = 'IGNORE';
4177 local $SIG{PIPE} = 'IGNORE';
4179 my $oldAutoCommit = $FS::UID::AutoCommit;
4180 local $FS::UID::AutoCommit = 0;
4183 #while ( $columns = $csv->getline($fh) ) {
4185 while ( defined($line=<$fh>) ) {
4187 $csv->parse($line) or do {
4188 $dbh->rollback if $oldAutoCommit;
4189 return "can't parse: ". $csv->error_input();
4192 my @columns = $csv->fields();
4193 #warn join('-',@columns);
4196 foreach my $field ( @fields ) {
4197 $row{$field} = shift @columns;
4200 if ( $row{custnum} && $row{agent_custid} ) {
4201 dbh->rollback if $oldAutoCommit;
4202 return "can't specify custnum with agent_custid $row{agent_custid}";
4206 if ( $row{agent_custid} && $agentnum ) {
4207 %hash = ( 'agent_custid' => $row{agent_custid},
4208 'agentnum' => $agentnum,
4212 if ( $row{custnum} ) {
4213 %hash = ( 'custnum' => $row{custnum} );
4216 unless ( scalar(keys %hash) ) {
4217 $dbh->rollback if $oldAutoCommit;
4218 return "can't find customer without custnum or agent_custid and agentnum";
4221 my $cust_main = qsearchs('cust_main', { %hash } );
4222 unless ( $cust_main ) {
4223 $dbh->rollback if $oldAutoCommit;
4224 my $custnum = $row{custnum} || $row{agent_custid};
4225 return "unknown custnum $custnum";
4228 if ( $row{'amount'} > 0 ) {
4229 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4231 $dbh->rollback if $oldAutoCommit;
4235 } elsif ( $row{'amount'} < 0 ) {
4236 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4239 $dbh->rollback if $oldAutoCommit;
4249 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4251 return "Empty file!" unless $imported;
4257 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4259 Deprecated. Use event notification and message templates
4260 (L<FS::msg_template>) instead.
4262 Sends a templated email notification to the customer (see L<Text::Template>).
4264 OPTIONS is a hash and may include
4266 I<from> - the email sender (default is invoice_from)
4268 I<to> - comma-separated scalar or arrayref of recipients
4269 (default is invoicing_list)
4271 I<subject> - The subject line of the sent email notification
4272 (default is "Notice from company_name")
4274 I<extra_fields> - a hashref of name/value pairs which will be substituted
4277 The following variables are vavailable in the template.
4279 I<$first> - the customer first name
4280 I<$last> - the customer last name
4281 I<$company> - the customer company
4282 I<$payby> - a description of the method of payment for the customer
4283 # would be nice to use FS::payby::shortname
4284 I<$payinfo> - the account information used to collect for this customer
4285 I<$expdate> - the expiration of the customer payment in seconds from epoch
4290 my ($self, $template, %options) = @_;
4292 return unless $conf->exists($template);
4294 my $from = $conf->config('invoice_from', $self->agentnum)
4295 if $conf->exists('invoice_from', $self->agentnum);
4296 $from = $options{from} if exists($options{from});
4298 my $to = join(',', $self->invoicing_list_emailonly);
4299 $to = $options{to} if exists($options{to});
4301 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4302 if $conf->exists('company_name', $self->agentnum);
4303 $subject = $options{subject} if exists($options{subject});
4305 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4306 SOURCE => [ map "$_\n",
4307 $conf->config($template)]
4309 or die "can't create new Text::Template object: Text::Template::ERROR";
4310 $notify_template->compile()
4311 or die "can't compile template: Text::Template::ERROR";
4313 $FS::notify_template::_template::company_name =
4314 $conf->config('company_name', $self->agentnum);
4315 $FS::notify_template::_template::company_address =
4316 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4318 my $paydate = $self->paydate || '2037-12-31';
4319 $FS::notify_template::_template::first = $self->first;
4320 $FS::notify_template::_template::last = $self->last;
4321 $FS::notify_template::_template::company = $self->company;
4322 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4323 my $payby = $self->payby;
4324 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4325 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4327 #credit cards expire at the end of the month/year of their exp date
4328 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4329 $FS::notify_template::_template::payby = 'credit card';
4330 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4331 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4333 }elsif ($payby eq 'COMP') {
4334 $FS::notify_template::_template::payby = 'complimentary account';
4336 $FS::notify_template::_template::payby = 'current method';
4338 $FS::notify_template::_template::expdate = $expire_time;
4340 for (keys %{$options{extra_fields}}){
4342 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4345 send_email(from => $from,
4347 subject => $subject,
4348 body => $notify_template->fill_in( PACKAGE =>
4349 'FS::notify_template::_template' ),
4354 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4356 Generates a templated notification to the customer (see L<Text::Template>).
4358 OPTIONS is a hash and may include
4360 I<extra_fields> - a hashref of name/value pairs which will be substituted
4361 into the template. These values may override values mentioned below
4362 and those from the customer record.
4364 The following variables are available in the template instead of or in addition
4365 to the fields of the customer record.
4367 I<$payby> - a description of the method of payment for the customer
4368 # would be nice to use FS::payby::shortname
4369 I<$payinfo> - the masked account information used to collect for this customer
4370 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4371 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4375 # a lot like cust_bill::print_latex
4376 sub generate_letter {
4377 my ($self, $template, %options) = @_;
4379 return unless $conf->exists($template);
4381 my $letter_template = new Text::Template
4383 SOURCE => [ map "$_\n", $conf->config($template)],
4384 DELIMITERS => [ '[@--', '--@]' ],
4386 or die "can't create new Text::Template object: Text::Template::ERROR";
4388 $letter_template->compile()
4389 or die "can't compile template: Text::Template::ERROR";
4391 my %letter_data = map { $_ => $self->$_ } $self->fields;
4392 $letter_data{payinfo} = $self->mask_payinfo;
4394 #my $paydate = $self->paydate || '2037-12-31';
4395 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4397 my $payby = $self->payby;
4398 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4399 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4401 #credit cards expire at the end of the month/year of their exp date
4402 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4403 $letter_data{payby} = 'credit card';
4404 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4405 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4407 }elsif ($payby eq 'COMP') {
4408 $letter_data{payby} = 'complimentary account';
4410 $letter_data{payby} = 'current method';
4412 $letter_data{expdate} = $expire_time;
4414 for (keys %{$options{extra_fields}}){
4415 $letter_data{$_} = $options{extra_fields}->{$_};
4418 unless(exists($letter_data{returnaddress})){
4419 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4420 $self->agent_template)
4422 if ( length($retadd) ) {
4423 $letter_data{returnaddress} = $retadd;
4424 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4425 $letter_data{returnaddress} =
4426 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4430 ( $conf->config('company_name', $self->agentnum),
4431 $conf->config('company_address', $self->agentnum),
4435 $letter_data{returnaddress} = '~';
4439 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4441 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4443 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4445 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4449 ) or die "can't open temp file: $!\n";
4450 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4451 or die "can't write temp file: $!\n";
4453 $letter_data{'logo_file'} = $lh->filename;
4455 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4459 ) or die "can't open temp file: $!\n";
4461 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4463 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4464 return ($1, $letter_data{'logo_file'});
4468 =item print_ps TEMPLATE
4470 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4476 my($file, $lfile) = $self->generate_letter(@_);
4477 my $ps = FS::Misc::generate_ps($file);
4478 unlink($file.'.tex');
4484 =item print TEMPLATE
4486 Prints the filled in template.
4488 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4492 sub queueable_print {
4495 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4496 or die "invalid customer number: " . $opt{custvnum};
4498 my $error = $self->print( $opt{template} );
4499 die $error if $error;
4503 my ($self, $template) = (shift, shift);
4504 do_print [ $self->print_ps($template) ];
4507 #these three subs should just go away once agent stuff is all config overrides
4509 sub agent_template {
4511 $self->_agent_plandata('agent_templatename');
4514 sub agent_invoice_from {
4516 $self->_agent_plandata('agent_invoice_from');
4519 sub _agent_plandata {
4520 my( $self, $option ) = @_;
4522 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4523 #agent-specific Conf
4525 use FS::part_event::Condition;
4527 my $agentnum = $self->agentnum;
4529 my $regexp = regexp_sql();
4531 my $part_event_option =
4533 'select' => 'part_event_option.*',
4534 'table' => 'part_event_option',
4536 LEFT JOIN part_event USING ( eventpart )
4537 LEFT JOIN part_event_option AS peo_agentnum
4538 ON ( part_event.eventpart = peo_agentnum.eventpart
4539 AND peo_agentnum.optionname = 'agentnum'
4540 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4542 LEFT JOIN part_event_condition
4543 ON ( part_event.eventpart = part_event_condition.eventpart
4544 AND part_event_condition.conditionname = 'cust_bill_age'
4546 LEFT JOIN part_event_condition_option
4547 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4548 AND part_event_condition_option.optionname = 'age'
4551 #'hashref' => { 'optionname' => $option },
4552 #'hashref' => { 'part_event_option.optionname' => $option },
4554 " WHERE part_event_option.optionname = ". dbh->quote($option).
4555 " AND action = 'cust_bill_send_agent' ".
4556 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4557 " AND peo_agentnum.optionname = 'agentnum' ".
4558 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4560 CASE WHEN part_event_condition_option.optionname IS NULL
4562 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4564 , part_event.weight".
4568 unless ( $part_event_option ) {
4569 return $self->agent->invoice_template || ''
4570 if $option eq 'agent_templatename';
4574 $part_event_option->optionvalue;
4578 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4580 Subroutine (not a method), designed to be called from the queue.
4582 Takes a list of options and values.
4584 Pulls up the customer record via the custnum option and calls bill_and_collect.
4589 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4591 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4592 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4594 $cust_main->bill_and_collect( %args );
4597 sub process_bill_and_collect {
4599 my $param = thaw(decode_base64(shift));
4600 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4601 or die "custnum '$param->{custnum}' not found!\n";
4602 $param->{'job'} = $job;
4603 $param->{'fatal'} = 1; # runs from job queue, will be caught
4604 $param->{'retry'} = 1;
4606 $cust_main->bill_and_collect( %$param );
4609 sub _upgrade_data { #class method
4610 my ($class, %opts) = @_;
4612 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
4613 my $sth = dbh->prepare($sql) or die dbh->errstr;
4614 $sth->execute or die $sth->errstr;
4616 local($ignore_expired_card) = 1;
4617 local($ignore_illegal_zip) = 1;
4618 local($ignore_banned_card) = 1;
4619 local($skip_fuzzyfiles) = 1;
4620 $class->_upgrade_otaker(%opts);
4630 The delete method should possibly take an FS::cust_main object reference
4631 instead of a scalar customer number.
4633 Bill and collect options should probably be passed as references instead of a
4636 There should probably be a configuration file with a list of allowed credit
4639 No multiple currency support (probably a larger project than just this module).
4641 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4643 Birthdates rely on negative epoch values.
4645 The payby for card/check batches is broken. With mixed batching, bad
4648 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4652 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4653 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4654 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.