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 unless ( $ignore_banned_card ) {
1659 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1661 return 'Banned ACH account: banned on '.
1662 time2str('%a %h %o at %r', $ban->_date).
1663 ' by '. $ban->otaker.
1664 ' (ban# '. $ban->bannum. ')';
1668 } elsif ( $self->payby eq 'LECB' ) {
1670 my $payinfo = $self->payinfo;
1671 $payinfo =~ s/\D//g;
1672 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1674 $self->payinfo($payinfo);
1677 } elsif ( $self->payby eq 'BILL' ) {
1679 $error = $self->ut_textn('payinfo');
1680 return "Illegal P.O. number: ". $self->payinfo if $error;
1683 } elsif ( $self->payby eq 'COMP' ) {
1685 my $curuser = $FS::CurrentUser::CurrentUser;
1686 if ( ! $self->custnum
1687 && ! $curuser->access_right('Complimentary customer')
1690 return "You are not permitted to create complimentary accounts."
1693 $error = $self->ut_textn('payinfo');
1694 return "Illegal comp account issuer: ". $self->payinfo if $error;
1697 } elsif ( $self->payby eq 'PREPAY' ) {
1699 my $payinfo = $self->payinfo;
1700 $payinfo =~ s/\W//g; #anything else would just confuse things
1701 $self->payinfo($payinfo);
1702 $error = $self->ut_alpha('payinfo');
1703 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1704 return "Unknown prepayment identifier"
1705 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1710 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1711 return "Expiration date required"
1712 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1716 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1717 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1718 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1719 ( $m, $y ) = ( $2, "19$1" );
1720 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1721 ( $m, $y ) = ( $3, "20$2" );
1723 return "Illegal expiration date: ". $self->paydate;
1725 $self->paydate("$y-$m-01");
1726 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1727 return gettext('expired_card')
1729 && !$ignore_expired_card
1730 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1733 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1734 ( ! $conf->exists('require_cardname')
1735 || $self->payby !~ /^(CARD|DCRD)$/ )
1737 $self->payname( $self->first. " ". $self->getfield('last') );
1739 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1740 or return gettext('illegal_name'). " payname: ". $self->payname;
1744 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1745 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1749 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1751 warn "$me check AFTER: \n". $self->_dump
1754 $self->SUPER::check;
1759 Returns a list of fields which have ship_ duplicates.
1764 qw( last first company
1765 address1 address2 city county state zip country
1770 =item has_ship_address
1772 Returns true if this customer record has a separate shipping address.
1776 sub has_ship_address {
1778 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1783 Returns a list of key/value pairs, with the following keys: address1, adddress2,
1784 city, county, state, zip, country. The shipping address is used if present.
1788 #geocode? dependent on tax-ship_address config, not available in cust_location
1789 #mostly. not yet then.
1793 my $prefix = $self->has_ship_address ? 'ship_' : '';
1795 map { $_ => $self->get($prefix.$_) }
1796 qw( address1 address2 city county state zip country geocode );
1797 #fields that cust_location has
1802 Returns all locations (see L<FS::cust_location>) for this customer.
1808 qsearch('cust_location', { 'custnum' => $self->custnum } );
1811 =item location_label [ OPTION => VALUE ... ]
1813 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
1821 used to separate the address elements (defaults to ', ')
1823 =item escape_function
1825 a callback used for escaping the text of the address elements
1831 # false laziness with FS::cust_location::line
1833 sub location_label {
1837 my $separator = $opt{join_string} || ', ';
1838 my $escape = $opt{escape_function} || sub{ shift };
1840 my $cydefault = FS::conf->new->config('countrydefault') || 'US';
1841 my $prefix = length($self->ship_last) ? 'ship_' : '';
1844 foreach (qw ( address1 address2 ) ) {
1845 my $method = "$prefix$_";
1846 $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
1851 foreach (qw ( city county state zip ) ) {
1852 my $method = "$prefix$_";
1853 if ( $self->$method ) {
1854 $line .= ' (' if $method eq 'county';
1855 $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
1856 $line .= ' )' if $method eq 'county';
1860 $line .= $separator. &$escape(code2country($self->country))
1861 if $self->country ne $cydefault;
1868 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1869 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
1870 on success or a list of errors.
1876 grep { $_->unsuspend } $self->suspended_pkgs;
1881 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1883 Returns a list: an empty list on success or a list of errors.
1889 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1892 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1894 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1895 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
1896 of a list of pkgparts; the hashref has the following keys:
1900 =item pkgparts - listref of pkgparts
1902 =item (other options are passed to the suspend method)
1907 Returns a list: an empty list on success or a list of errors.
1911 sub suspend_if_pkgpart {
1913 my (@pkgparts, %opt);
1914 if (ref($_[0]) eq 'HASH'){
1915 @pkgparts = @{$_[0]{pkgparts}};
1920 grep { $_->suspend(%opt) }
1921 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1922 $self->unsuspended_pkgs;
1925 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1927 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1928 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
1929 instead of a list of pkgparts; the hashref has the following keys:
1933 =item pkgparts - listref of pkgparts
1935 =item (other options are passed to the suspend method)
1939 Returns a list: an empty list on success or a list of errors.
1943 sub suspend_unless_pkgpart {
1945 my (@pkgparts, %opt);
1946 if (ref($_[0]) eq 'HASH'){
1947 @pkgparts = @{$_[0]{pkgparts}};
1952 grep { $_->suspend(%opt) }
1953 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1954 $self->unsuspended_pkgs;
1957 =item cancel [ OPTION => VALUE ... ]
1959 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1961 Available options are:
1965 =item quiet - can be set true to supress email cancellation notices.
1967 =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.
1969 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
1971 =item nobill - can be set true to skip billing if it might otherwise be done.
1975 Always returns a list: an empty list on success or a list of errors.
1979 # nb that dates are not specified as valid options to this method
1982 my( $self, %opt ) = @_;
1984 warn "$me cancel called on customer ". $self->custnum. " with options ".
1985 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
1988 return ( 'access denied' )
1989 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
1991 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1993 #should try decryption (we might have the private key)
1994 # and if not maybe queue a job for the server that does?
1995 return ( "Can't (yet) ban encrypted credit cards" )
1996 if $self->is_encrypted($self->payinfo);
1998 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1999 my $error = $ban->insert;
2000 return ( $error ) if $error;
2004 my @pkgs = $self->ncancelled_pkgs;
2006 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2008 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2009 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2013 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2014 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2017 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2020 sub _banned_pay_hashref {
2031 'payby' => $payby2ban{$self->payby},
2032 'payinfo' => md5_base64($self->payinfo),
2033 #don't ever *search* on reason! #'reason' =>
2039 Returns all notes (see L<FS::cust_main_note>) for this customer.
2046 qsearch( 'cust_main_note',
2047 { 'custnum' => $self->custnum },
2049 'ORDER BY _DATE DESC'
2055 Returns the agent (see L<FS::agent>) for this customer.
2061 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2066 Returns the agent name (see L<FS::agent>) for this customer.
2072 $self->agent->agent;
2077 Returns any tags associated with this customer, as FS::cust_tag objects,
2078 or an empty list if there are no tags.
2084 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2089 Returns any tags associated with this customer, as FS::part_tag objects,
2090 or an empty list if there are no tags.
2096 map $_->part_tag, $self->cust_tag;
2102 Returns the customer class, as an FS::cust_class object, or the empty string
2103 if there is no customer class.
2109 if ( $self->classnum ) {
2110 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2118 Returns the customer category name, or the empty string if there is no customer
2125 my $cust_class = $self->cust_class;
2127 ? $cust_class->categoryname
2133 Returns the customer class name, or the empty string if there is no customer
2140 my $cust_class = $self->cust_class;
2142 ? $cust_class->classname
2146 =item BILLING METHODS
2148 Documentation on billing methods has been moved to
2149 L<FS::cust_main::Billing>.
2151 =item REALTIME BILLING METHODS
2153 Documentation on realtime billing methods has been moved to
2154 L<FS::cust_main::Billing_Realtime>.
2158 Removes the I<paycvv> field from the database directly.
2160 If there is an error, returns the error, otherwise returns false.
2166 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2167 or return dbh->errstr;
2168 $sth->execute($self->custnum)
2169 or return $sth->errstr;
2174 =item batch_card OPTION => VALUE...
2176 Adds a payment for this invoice to the pending credit card batch (see
2177 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2178 runs the payment using a realtime gateway.
2183 my ($self, %options) = @_;
2186 if (exists($options{amount})) {
2187 $amount = $options{amount};
2189 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2191 return '' unless $amount > 0;
2193 my $invnum = delete $options{invnum};
2194 my $payby = $options{payby} || $self->payby; #still dubious
2196 if ($options{'realtime'}) {
2197 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2203 my $oldAutoCommit = $FS::UID::AutoCommit;
2204 local $FS::UID::AutoCommit = 0;
2207 #this needs to handle mysql as well as Pg, like svc_acct.pm
2208 #(make it into a common function if folks need to do batching with mysql)
2209 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2210 or return "Cannot lock pay_batch: " . $dbh->errstr;
2214 'payby' => FS::payby->payby2payment($payby),
2217 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2219 unless ( $pay_batch ) {
2220 $pay_batch = new FS::pay_batch \%pay_batch;
2221 my $error = $pay_batch->insert;
2223 $dbh->rollback if $oldAutoCommit;
2224 die "error creating new batch: $error\n";
2228 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2229 'batchnum' => $pay_batch->batchnum,
2230 'custnum' => $self->custnum,
2233 foreach (qw( address1 address2 city state zip country payby payinfo paydate
2235 $options{$_} = '' unless exists($options{$_});
2238 my $cust_pay_batch = new FS::cust_pay_batch ( {
2239 'batchnum' => $pay_batch->batchnum,
2240 'invnum' => $invnum || 0, # is there a better value?
2241 # this field should be
2243 # cust_bill_pay_batch now
2244 'custnum' => $self->custnum,
2245 'last' => $self->getfield('last'),
2246 'first' => $self->getfield('first'),
2247 'address1' => $options{address1} || $self->address1,
2248 'address2' => $options{address2} || $self->address2,
2249 'city' => $options{city} || $self->city,
2250 'state' => $options{state} || $self->state,
2251 'zip' => $options{zip} || $self->zip,
2252 'country' => $options{country} || $self->country,
2253 'payby' => $options{payby} || $self->payby,
2254 'payinfo' => $options{payinfo} || $self->payinfo,
2255 'exp' => $options{paydate} || $self->paydate,
2256 'payname' => $options{payname} || $self->payname,
2257 'amount' => $amount, # consolidating
2260 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2261 if $old_cust_pay_batch;
2264 if ($old_cust_pay_batch) {
2265 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2267 $error = $cust_pay_batch->insert;
2271 $dbh->rollback if $oldAutoCommit;
2275 my $unapplied = $self->total_unapplied_credits
2276 + $self->total_unapplied_payments
2277 + $self->in_transit_payments;
2278 foreach my $cust_bill ($self->open_cust_bill) {
2279 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2280 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2281 'invnum' => $cust_bill->invnum,
2282 'paybatchnum' => $cust_pay_batch->paybatchnum,
2283 'amount' => $cust_bill->owed,
2286 if ($unapplied >= $cust_bill_pay_batch->amount){
2287 $unapplied -= $cust_bill_pay_batch->amount;
2290 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2291 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2293 $error = $cust_bill_pay_batch->insert;
2295 $dbh->rollback if $oldAutoCommit;
2300 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2306 Returns the total owed for this customer on all invoices
2307 (see L<FS::cust_bill/owed>).
2313 $self->total_owed_date(2145859200); #12/31/2037
2316 =item total_owed_date TIME
2318 Returns the total owed for this customer on all invoices with date earlier than
2319 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2320 see L<Time::Local> and L<Date::Parse> for conversion functions.
2324 sub total_owed_date {
2328 my $custnum = $self->custnum;
2330 my $owed_sql = FS::cust_bill->owed_sql;
2333 SELECT SUM($owed_sql) FROM cust_bill
2334 WHERE custnum = $custnum
2338 sprintf( "%.2f", $self->scalar_sql($sql) );
2342 =item total_owed_pkgnum PKGNUM
2344 Returns the total owed on all invoices for this customer's specific package
2345 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2349 sub total_owed_pkgnum {
2350 my( $self, $pkgnum ) = @_;
2351 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2354 =item total_owed_date_pkgnum TIME PKGNUM
2356 Returns the total owed for this customer's specific package when using
2357 experimental package balances on all invoices with date earlier than
2358 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2359 see L<Time::Local> and L<Date::Parse> for conversion functions.
2363 sub total_owed_date_pkgnum {
2364 my( $self, $time, $pkgnum ) = @_;
2367 foreach my $cust_bill (
2368 grep { $_->_date <= $time }
2369 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2371 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2373 sprintf( "%.2f", $total_bill );
2379 Returns the total amount of all payments.
2386 $total += $_->paid foreach $self->cust_pay;
2387 sprintf( "%.2f", $total );
2390 =item total_unapplied_credits
2392 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2393 customer. See L<FS::cust_credit/credited>.
2395 =item total_credited
2397 Old name for total_unapplied_credits. Don't use.
2401 sub total_credited {
2402 #carp "total_credited deprecated, use total_unapplied_credits";
2403 shift->total_unapplied_credits(@_);
2406 sub total_unapplied_credits {
2409 my $custnum = $self->custnum;
2411 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2414 SELECT SUM($unapplied_sql) FROM cust_credit
2415 WHERE custnum = $custnum
2418 #XXX fix harmless but loud: Argument "" isn't numeric in sprintf
2419 sprintf( "%.2f", $self->scalar_sql($sql) );
2423 =item total_unapplied_credits_pkgnum PKGNUM
2425 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2426 customer. See L<FS::cust_credit/credited>.
2430 sub total_unapplied_credits_pkgnum {
2431 my( $self, $pkgnum ) = @_;
2432 my $total_credit = 0;
2433 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2434 sprintf( "%.2f", $total_credit );
2438 =item total_unapplied_payments
2440 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2441 See L<FS::cust_pay/unapplied>.
2445 sub total_unapplied_payments {
2448 my $custnum = $self->custnum;
2450 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2453 SELECT SUM($unapplied_sql) FROM cust_pay
2454 WHERE custnum = $custnum
2457 #XXX fix harmless but loud: Argument "" isn't numeric in sprintf
2458 sprintf( "%.2f", $self->scalar_sql($sql) );
2462 =item total_unapplied_payments_pkgnum PKGNUM
2464 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2465 specific package when using experimental package balances. See
2466 L<FS::cust_pay/unapplied>.
2470 sub total_unapplied_payments_pkgnum {
2471 my( $self, $pkgnum ) = @_;
2472 my $total_unapplied = 0;
2473 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2474 sprintf( "%.2f", $total_unapplied );
2478 =item total_unapplied_refunds
2480 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2481 customer. See L<FS::cust_refund/unapplied>.
2485 sub total_unapplied_refunds {
2487 my $custnum = $self->custnum;
2489 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2492 SELECT SUM($unapplied_sql) FROM cust_refund
2493 WHERE custnum = $custnum
2496 #XXX fix harmless but loud: Argument "" isn't numeric in sprintf
2497 sprintf( "%.2f", $self->scalar_sql($sql) );
2503 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2504 total_unapplied_credits minus total_unapplied_payments).
2510 $self->balance_date_range;
2513 =item balance_date TIME
2515 Returns the balance for this customer, only considering invoices with date
2516 earlier than TIME (total_owed_date minus total_credited minus
2517 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2518 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2525 $self->balance_date_range(shift);
2528 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2530 Returns the balance for this customer, optionally considering invoices with
2531 date earlier than START_TIME, and not later than END_TIME
2532 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2534 Times are specified as SQL fragments or numeric
2535 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2536 L<Date::Parse> for conversion functions. The empty string can be passed
2537 to disable that time constraint completely.
2539 Available options are:
2543 =item unapplied_date
2545 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)
2551 sub balance_date_range {
2553 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2554 ') FROM cust_main WHERE custnum='. $self->custnum;
2555 sprintf( '%.2f', $self->scalar_sql($sql) );
2558 =item balance_pkgnum PKGNUM
2560 Returns the balance for this customer's specific package when using
2561 experimental package balances (total_owed plus total_unrefunded, minus
2562 total_unapplied_credits minus total_unapplied_payments)
2566 sub balance_pkgnum {
2567 my( $self, $pkgnum ) = @_;
2570 $self->total_owed_pkgnum($pkgnum)
2571 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2572 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2573 - $self->total_unapplied_credits_pkgnum($pkgnum)
2574 - $self->total_unapplied_payments_pkgnum($pkgnum)
2578 =item in_transit_payments
2580 Returns the total of requests for payments for this customer pending in
2581 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
2585 sub in_transit_payments {
2587 my $in_transit_payments = 0;
2588 foreach my $pay_batch ( qsearch('pay_batch', {
2591 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2592 'batchnum' => $pay_batch->batchnum,
2593 'custnum' => $self->custnum,
2595 $in_transit_payments += $cust_pay_batch->amount;
2598 sprintf( "%.2f", $in_transit_payments );
2603 Returns a hash of useful information for making a payment.
2613 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2614 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2615 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2619 For credit card transactions:
2631 For electronic check transactions:
2646 $return{balance} = $self->balance;
2648 $return{payname} = $self->payname
2649 || ( $self->first. ' '. $self->get('last') );
2651 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
2653 $return{payby} = $self->payby;
2654 $return{stateid_state} = $self->stateid_state;
2656 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2657 $return{card_type} = cardtype($self->payinfo);
2658 $return{payinfo} = $self->paymask;
2660 @return{'month', 'year'} = $self->paydate_monthyear;
2664 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2665 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2666 $return{payinfo1} = $payinfo1;
2667 $return{payinfo2} = $payinfo2;
2668 $return{paytype} = $self->paytype;
2669 $return{paystate} = $self->paystate;
2673 #doubleclick protection
2675 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2681 =item paydate_monthyear
2683 Returns a two-element list consisting of the month and year of this customer's
2684 paydate (credit card expiration date for CARD customers)
2688 sub paydate_monthyear {
2690 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2692 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2699 =item tax_exemption TAXNAME
2704 my( $self, $taxname ) = @_;
2706 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2707 'taxname' => $taxname,
2712 =item cust_main_exemption
2716 sub cust_main_exemption {
2718 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
2721 =item invoicing_list [ ARRAYREF ]
2723 If an arguement is given, sets these email addresses as invoice recipients
2724 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
2725 (except as warnings), so use check_invoicing_list first.
2727 Returns a list of email addresses (with svcnum entries expanded).
2729 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
2730 check it without disturbing anything by passing nothing.
2732 This interface may change in the future.
2736 sub invoicing_list {
2737 my( $self, $arrayref ) = @_;
2740 my @cust_main_invoice;
2741 if ( $self->custnum ) {
2742 @cust_main_invoice =
2743 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2745 @cust_main_invoice = ();
2747 foreach my $cust_main_invoice ( @cust_main_invoice ) {
2748 #warn $cust_main_invoice->destnum;
2749 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2750 #warn $cust_main_invoice->destnum;
2751 my $error = $cust_main_invoice->delete;
2752 warn $error if $error;
2755 if ( $self->custnum ) {
2756 @cust_main_invoice =
2757 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2759 @cust_main_invoice = ();
2761 my %seen = map { $_->address => 1 } @cust_main_invoice;
2762 foreach my $address ( @{$arrayref} ) {
2763 next if exists $seen{$address} && $seen{$address};
2764 $seen{$address} = 1;
2765 my $cust_main_invoice = new FS::cust_main_invoice ( {
2766 'custnum' => $self->custnum,
2769 my $error = $cust_main_invoice->insert;
2770 warn $error if $error;
2774 if ( $self->custnum ) {
2776 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2783 =item check_invoicing_list ARRAYREF
2785 Checks these arguements as valid input for the invoicing_list method. If there
2786 is an error, returns the error, otherwise returns false.
2790 sub check_invoicing_list {
2791 my( $self, $arrayref ) = @_;
2793 foreach my $address ( @$arrayref ) {
2795 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2796 return 'Can\'t add FAX invoice destination with a blank FAX number.';
2799 my $cust_main_invoice = new FS::cust_main_invoice ( {
2800 'custnum' => $self->custnum,
2803 my $error = $self->custnum
2804 ? $cust_main_invoice->check
2805 : $cust_main_invoice->checkdest
2807 return $error if $error;
2811 return "Email address required"
2812 if $conf->exists('cust_main-require_invoicing_list_email')
2813 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2818 =item set_default_invoicing_list
2820 Sets the invoicing list to all accounts associated with this customer,
2821 overwriting any previous invoicing list.
2825 sub set_default_invoicing_list {
2827 $self->invoicing_list($self->all_emails);
2832 Returns the email addresses of all accounts provisioned for this customer.
2839 foreach my $cust_pkg ( $self->all_pkgs ) {
2840 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2842 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2843 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2845 $list{$_}=1 foreach map { $_->email } @svc_acct;
2850 =item invoicing_list_addpost
2852 Adds postal invoicing to this customer. If this customer is already configured
2853 to receive postal invoices, does nothing.
2857 sub invoicing_list_addpost {
2859 return if grep { $_ eq 'POST' } $self->invoicing_list;
2860 my @invoicing_list = $self->invoicing_list;
2861 push @invoicing_list, 'POST';
2862 $self->invoicing_list(\@invoicing_list);
2865 =item invoicing_list_emailonly
2867 Returns the list of email invoice recipients (invoicing_list without non-email
2868 destinations such as POST and FAX).
2872 sub invoicing_list_emailonly {
2874 warn "$me invoicing_list_emailonly called"
2876 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
2879 =item invoicing_list_emailonly_scalar
2881 Returns the list of email invoice recipients (invoicing_list without non-email
2882 destinations such as POST and FAX) as a comma-separated scalar.
2886 sub invoicing_list_emailonly_scalar {
2888 warn "$me invoicing_list_emailonly_scalar called"
2890 join(', ', $self->invoicing_list_emailonly);
2893 =item referral_custnum_cust_main
2895 Returns the customer who referred this customer (or the empty string, if
2896 this customer was not referred).
2898 Note the difference with referral_cust_main method: This method,
2899 referral_custnum_cust_main returns the single customer (if any) who referred
2900 this customer, while referral_cust_main returns an array of customers referred
2905 sub referral_custnum_cust_main {
2907 return '' unless $self->referral_custnum;
2908 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2911 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2913 Returns an array of customers referred by this customer (referral_custnum set
2914 to this custnum). If DEPTH is given, recurses up to the given depth, returning
2915 customers referred by customers referred by this customer and so on, inclusive.
2916 The default behavior is DEPTH 1 (no recursion).
2918 Note the difference with referral_custnum_cust_main method: This method,
2919 referral_cust_main, returns an array of customers referred BY this customer,
2920 while referral_custnum_cust_main returns the single customer (if any) who
2921 referred this customer.
2925 sub referral_cust_main {
2927 my $depth = @_ ? shift : 1;
2928 my $exclude = @_ ? shift : {};
2931 map { $exclude->{$_->custnum}++; $_; }
2932 grep { ! $exclude->{ $_->custnum } }
2933 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2937 map { $_->referral_cust_main($depth-1, $exclude) }
2944 =item referral_cust_main_ncancelled
2946 Same as referral_cust_main, except only returns customers with uncancelled
2951 sub referral_cust_main_ncancelled {
2953 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2956 =item referral_cust_pkg [ DEPTH ]
2958 Like referral_cust_main, except returns a flat list of all unsuspended (and
2959 uncancelled) packages for each customer. The number of items in this list may
2960 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2964 sub referral_cust_pkg {
2966 my $depth = @_ ? shift : 1;
2968 map { $_->unsuspended_pkgs }
2969 grep { $_->unsuspended_pkgs }
2970 $self->referral_cust_main($depth);
2973 =item referring_cust_main
2975 Returns the single cust_main record for the customer who referred this customer
2976 (referral_custnum), or false.
2980 sub referring_cust_main {
2982 return '' unless $self->referral_custnum;
2983 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2986 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
2988 Applies a credit to this customer. If there is an error, returns the error,
2989 otherwise returns false.
2991 REASON can be a text string, an FS::reason object, or a scalar reference to
2992 a reasonnum. If a text string, it will be automatically inserted as a new
2993 reason, and a 'reason_type' option must be passed to indicate the
2994 FS::reason_type for the new reason.
2996 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
2998 Any other options are passed to FS::cust_credit::insert.
3003 my( $self, $amount, $reason, %options ) = @_;
3005 my $cust_credit = new FS::cust_credit {
3006 'custnum' => $self->custnum,
3007 'amount' => $amount,
3010 if ( ref($reason) ) {
3012 if ( ref($reason) eq 'SCALAR' ) {
3013 $cust_credit->reasonnum( $$reason );
3015 $cust_credit->reasonnum( $reason->reasonnum );
3019 $cust_credit->set('reason', $reason)
3022 for (qw( addlinfo eventnum )) {
3023 $cust_credit->$_( delete $options{$_} )
3024 if exists($options{$_});
3027 $cust_credit->insert(%options);
3031 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3033 Creates a one-time charge for this customer. If there is an error, returns
3034 the error, otherwise returns false.
3036 New-style, with a hashref of options:
3038 my $error = $cust_main->charge(
3042 'start_date' => str2time('7/4/2009'),
3043 'pkg' => 'Description',
3044 'comment' => 'Comment',
3045 'additional' => [], #extra invoice detail
3046 'classnum' => 1, #pkg_class
3048 'setuptax' => '', # or 'Y' for tax exempt
3051 'taxclass' => 'Tax class',
3054 'taxproduct' => 2, #part_pkg_taxproduct
3055 'override' => {}, #XXX describe
3057 #will be filled in with the new object
3058 'cust_pkg_ref' => \$cust_pkg,
3060 #generate an invoice immediately
3062 'invoice_terms' => '', #with these terms
3068 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3074 my ( $amount, $quantity, $start_date, $classnum );
3075 my ( $pkg, $comment, $additional );
3076 my ( $setuptax, $taxclass ); #internal taxes
3077 my ( $taxproduct, $override ); #vendor (CCH) taxes
3079 my $cust_pkg_ref = '';
3080 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3081 if ( ref( $_[0] ) ) {
3082 $amount = $_[0]->{amount};
3083 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3084 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3085 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3086 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3087 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3088 : '$'. sprintf("%.2f",$amount);
3089 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3090 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3091 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3092 $additional = $_[0]->{additional} || [];
3093 $taxproduct = $_[0]->{taxproductnum};
3094 $override = { '' => $_[0]->{tax_override} };
3095 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3096 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3097 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3102 $pkg = @_ ? shift : 'One-time charge';
3103 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3105 $taxclass = @_ ? shift : '';
3109 local $SIG{HUP} = 'IGNORE';
3110 local $SIG{INT} = 'IGNORE';
3111 local $SIG{QUIT} = 'IGNORE';
3112 local $SIG{TERM} = 'IGNORE';
3113 local $SIG{TSTP} = 'IGNORE';
3114 local $SIG{PIPE} = 'IGNORE';
3116 my $oldAutoCommit = $FS::UID::AutoCommit;
3117 local $FS::UID::AutoCommit = 0;
3120 my $part_pkg = new FS::part_pkg ( {
3122 'comment' => $comment,
3126 'classnum' => ( $classnum ? $classnum : '' ),
3127 'setuptax' => $setuptax,
3128 'taxclass' => $taxclass,
3129 'taxproductnum' => $taxproduct,
3132 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3133 ( 0 .. @$additional - 1 )
3135 'additional_count' => scalar(@$additional),
3136 'setup_fee' => $amount,
3139 my $error = $part_pkg->insert( options => \%options,
3140 tax_overrides => $override,
3143 $dbh->rollback if $oldAutoCommit;
3147 my $pkgpart = $part_pkg->pkgpart;
3148 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3149 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3150 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3151 $error = $type_pkgs->insert;
3153 $dbh->rollback if $oldAutoCommit;
3158 my $cust_pkg = new FS::cust_pkg ( {
3159 'custnum' => $self->custnum,
3160 'pkgpart' => $pkgpart,
3161 'quantity' => $quantity,
3162 'start_date' => $start_date,
3163 'no_auto' => $no_auto,
3166 $error = $cust_pkg->insert;
3168 $dbh->rollback if $oldAutoCommit;
3170 } elsif ( $cust_pkg_ref ) {
3171 ${$cust_pkg_ref} = $cust_pkg;
3175 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3176 'pkg_list' => [ $cust_pkg ],
3179 $dbh->rollback if $oldAutoCommit;
3184 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3189 #=item charge_postal_fee
3191 #Applies a one time charge this customer. If there is an error,
3192 #returns the error, returns the cust_pkg charge object or false
3193 #if there was no charge.
3197 # This should be a customer event. For that to work requires that bill
3198 # also be a customer event.
3200 sub charge_postal_fee {
3203 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
3204 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3206 my $cust_pkg = new FS::cust_pkg ( {
3207 'custnum' => $self->custnum,
3208 'pkgpart' => $pkgpart,
3212 my $error = $cust_pkg->insert;
3213 $error ? $error : $cust_pkg;
3216 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3218 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3220 Optionally, a list or hashref of additional arguments to the qsearch call can
3227 my $opt = ref($_[0]) ? shift : { @_ };
3229 #return $self->num_cust_bill unless wantarray || keys %$opt;
3231 $opt->{'table'} = 'cust_bill';
3232 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3233 $opt->{'hashref'}{'custnum'} = $self->custnum;
3234 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3236 map { $_ } #behavior of sort undefined in scalar context
3237 sort { $a->_date <=> $b->_date }
3241 =item open_cust_bill
3243 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3248 sub open_cust_bill {
3252 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3258 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3260 Returns all the statements (see L<FS::cust_statement>) for this customer.
3262 Optionally, a list or hashref of additional arguments to the qsearch call can
3267 sub cust_statement {
3269 my $opt = ref($_[0]) ? shift : { @_ };
3271 #return $self->num_cust_statement unless wantarray || keys %$opt;
3273 $opt->{'table'} = 'cust_statement';
3274 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3275 $opt->{'hashref'}{'custnum'} = $self->custnum;
3276 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3278 map { $_ } #behavior of sort undefined in scalar context
3279 sort { $a->_date <=> $b->_date }
3285 Returns all the credits (see L<FS::cust_credit>) for this customer.
3291 map { $_ } #return $self->num_cust_credit unless wantarray;
3292 sort { $a->_date <=> $b->_date }
3293 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3296 =item cust_credit_pkgnum
3298 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3299 package when using experimental package balances.
3303 sub cust_credit_pkgnum {
3304 my( $self, $pkgnum ) = @_;
3305 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3306 sort { $a->_date <=> $b->_date }
3307 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3308 'pkgnum' => $pkgnum,
3315 Returns all the payments (see L<FS::cust_pay>) for this customer.
3321 return $self->num_cust_pay unless wantarray;
3322 sort { $a->_date <=> $b->_date }
3323 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3328 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3329 called automatically when the cust_pay method is used in a scalar context.
3335 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3336 my $sth = dbh->prepare($sql) or die dbh->errstr;
3337 $sth->execute($self->custnum) or die $sth->errstr;
3338 $sth->fetchrow_arrayref->[0];
3341 =item cust_pay_pkgnum
3343 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3344 package when using experimental package balances.
3348 sub cust_pay_pkgnum {
3349 my( $self, $pkgnum ) = @_;
3350 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3351 sort { $a->_date <=> $b->_date }
3352 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3353 'pkgnum' => $pkgnum,
3360 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3366 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3367 sort { $a->_date <=> $b->_date }
3368 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3371 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3373 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3375 Optionally, a list or hashref of additional arguments to the qsearch call can
3380 sub cust_pay_batch {
3382 my $opt = ref($_[0]) ? shift : { @_ };
3384 #return $self->num_cust_statement unless wantarray || keys %$opt;
3386 $opt->{'table'} = 'cust_pay_batch';
3387 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3388 $opt->{'hashref'}{'custnum'} = $self->custnum;
3389 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3391 map { $_ } #behavior of sort undefined in scalar context
3392 sort { $a->paybatchnum <=> $b->paybatchnum }
3396 =item cust_pay_pending
3398 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3399 (without status "done").
3403 sub cust_pay_pending {
3405 return $self->num_cust_pay_pending unless wantarray;
3406 sort { $a->_date <=> $b->_date }
3407 qsearch( 'cust_pay_pending', {
3408 'custnum' => $self->custnum,
3409 'status' => { op=>'!=', value=>'done' },
3414 =item cust_pay_pending_attempt
3416 Returns all payment attempts / declined payments for this customer, as pending
3417 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3418 a corresponding payment (see L<FS::cust_pay>).
3422 sub cust_pay_pending_attempt {
3424 return $self->num_cust_pay_pending_attempt unless wantarray;
3425 sort { $a->_date <=> $b->_date }
3426 qsearch( 'cust_pay_pending', {
3427 'custnum' => $self->custnum,
3434 =item num_cust_pay_pending
3436 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3437 customer (without status "done"). Also called automatically when the
3438 cust_pay_pending method is used in a scalar context.
3442 sub num_cust_pay_pending {
3445 " SELECT COUNT(*) FROM cust_pay_pending ".
3446 " WHERE custnum = ? AND status != 'done' ",
3451 =item num_cust_pay_pending_attempt
3453 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3454 customer, with status "done" but without a corresp. Also called automatically when the
3455 cust_pay_pending method is used in a scalar context.
3459 sub num_cust_pay_pending_attempt {
3462 " SELECT COUNT(*) FROM cust_pay_pending ".
3463 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3470 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3476 map { $_ } #return $self->num_cust_refund unless wantarray;
3477 sort { $a->_date <=> $b->_date }
3478 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3481 =item display_custnum
3483 Returns the displayed customer number for this customer: agent_custid if
3484 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3488 sub display_custnum {
3490 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3491 return $self->agent_custid;
3493 return $self->custnum;
3499 Returns a name string for this customer, either "Company (Last, First)" or
3506 my $name = $self->contact;
3507 $name = $self->company. " ($name)" if $self->company;
3513 Returns a name string for this (service/shipping) contact, either
3514 "Company (Last, First)" or "Last, First".
3520 if ( $self->get('ship_last') ) {
3521 my $name = $self->ship_contact;
3522 $name = $self->ship_company. " ($name)" if $self->ship_company;
3531 Returns a name string for this customer, either "Company" or "First Last".
3537 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3540 =item ship_name_short
3542 Returns a name string for this (service/shipping) contact, either "Company"
3547 sub ship_name_short {
3549 if ( $self->get('ship_last') ) {
3550 $self->ship_company !~ /^\s*$/
3551 ? $self->ship_company
3552 : $self->ship_contact_firstlast;
3554 $self->name_company_or_firstlast;
3560 Returns this customer's full (billing) contact name only, "Last, First"
3566 $self->get('last'). ', '. $self->first;
3571 Returns this customer's full (shipping) contact name only, "Last, First"
3577 $self->get('ship_last')
3578 ? $self->get('ship_last'). ', '. $self->ship_first
3582 =item contact_firstlast
3584 Returns this customers full (billing) contact name only, "First Last".
3588 sub contact_firstlast {
3590 $self->first. ' '. $self->get('last');
3593 =item ship_contact_firstlast
3595 Returns this customer's full (shipping) contact name only, "First Last".
3599 sub ship_contact_firstlast {
3601 $self->get('ship_last')
3602 ? $self->first. ' '. $self->get('ship_last')
3603 : $self->contact_firstlast;
3608 Returns this customer's full country name
3614 code2country($self->country);
3617 =item geocode DATA_VENDOR
3619 Returns a value for the customer location as encoded by DATA_VENDOR.
3620 Currently this only makes sense for "CCH" as DATA_VENDOR.
3625 my ($self, $data_vendor) = (shift, shift); #always cch for now
3627 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
3628 return $geocode if $geocode;
3630 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3634 my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
3635 if $self->country eq 'US';
3639 #CCH specific location stuff
3640 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
3642 my @cust_tax_location =
3644 'table' => 'cust_tax_location',
3645 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
3646 'extra_sql' => $extra_sql,
3647 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
3650 $geocode = $cust_tax_location[0]->geocode
3651 if scalar(@cust_tax_location);
3660 Returns a status string for this customer, currently:
3664 =item prospect - No packages have ever been ordered
3666 =item ordered - Recurring packages all are new (not yet billed).
3668 =item active - One or more recurring packages is active
3670 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3672 =item suspended - All non-cancelled recurring packages are suspended
3674 =item cancelled - All recurring packages are cancelled
3680 sub status { shift->cust_status(@_); }
3684 # prospect ordered active inactive suspended cancelled
3685 for my $status ( FS::cust_main->statuses() ) {
3686 my $method = $status.'_sql';
3687 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3688 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3689 $sth->execute( ($self->custnum) x $numnum )
3690 or die "Error executing 'SELECT $sql': ". $sth->errstr;
3691 return $status if $sth->fetchrow_arrayref->[0];
3695 =item ucfirst_cust_status
3697 =item ucfirst_status
3699 Returns the status with the first character capitalized.
3703 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
3705 sub ucfirst_cust_status {
3707 ucfirst($self->cust_status);
3712 Returns a hex triplet color string for this customer's status.
3716 use vars qw(%statuscolor);
3717 tie %statuscolor, 'Tie::IxHash',
3718 'prospect' => '7e0079', #'000000', #black? naw, purple
3719 'active' => '00CC00', #green
3720 'ordered' => '009999', #teal? cyan?
3721 'inactive' => '0000CC', #blue
3722 'suspended' => 'FF9900', #yellow
3723 'cancelled' => 'FF0000', #red
3726 sub statuscolor { shift->cust_statuscolor(@_); }
3728 sub cust_statuscolor {
3730 $statuscolor{$self->cust_status};
3735 Returns an array of hashes representing the customer's RT tickets.
3742 my $num = $conf->config('cust_main-max_tickets') || 10;
3745 if ( $conf->config('ticket_system') ) {
3746 unless ( $conf->config('ticket_system-custom_priority_field') ) {
3748 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
3752 foreach my $priority (
3753 $conf->config('ticket_system-custom_priority_field-values'), ''
3755 last if scalar(@tickets) >= $num;
3757 @{ FS::TicketSystem->customer_tickets( $self->custnum,
3758 $num - scalar(@tickets),
3768 # Return services representing svc_accts in customer support packages
3769 sub support_services {
3771 my %packages = map { $_ => 1 } $conf->config('support_packages');
3773 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
3774 grep { $_->part_svc->svcdb eq 'svc_acct' }
3775 map { $_->cust_svc }
3776 grep { exists $packages{ $_->pkgpart } }
3777 $self->ncancelled_pkgs;
3781 # Return a list of latitude/longitude for one of the services (if any)
3782 sub service_coordinates {
3786 grep { $_->latitude && $_->longitude }
3788 map { $_->cust_svc }
3789 $self->ncancelled_pkgs;
3791 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
3796 Returns a masked version of the named field
3801 my ($self,$field) = @_;
3805 'x'x(length($self->getfield($field))-4).
3806 substr($self->getfield($field), (length($self->getfield($field))-4));
3812 =head1 CLASS METHODS
3818 Class method that returns the list of possible status strings for customers
3819 (see L<the status method|/status>). For example:
3821 @statuses = FS::cust_main->statuses();
3826 #my $self = shift; #could be class...
3832 Returns an SQL expression identifying prospective cust_main records (customers
3833 with no packages ever ordered)
3837 use vars qw($select_count_pkgs);
3838 $select_count_pkgs =
3839 "SELECT COUNT(*) FROM cust_pkg
3840 WHERE cust_pkg.custnum = cust_main.custnum";
3842 sub select_count_pkgs_sql {
3847 " 0 = ( $select_count_pkgs ) ";
3852 Returns an SQL expression identifying ordered cust_main records (customers with
3853 recurring packages not yet setup).
3858 FS::cust_main->none_active_sql.
3859 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
3864 Returns an SQL expression identifying active cust_main records (customers with
3865 active recurring packages).
3870 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
3873 =item none_active_sql
3875 Returns an SQL expression identifying cust_main records with no active
3876 recurring packages. This includes customers of status prospect, ordered,
3877 inactive, and suspended.
3881 sub none_active_sql {
3882 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
3887 Returns an SQL expression identifying inactive cust_main records (customers with
3888 no active recurring packages, but otherwise unsuspended/uncancelled).
3893 FS::cust_main->none_active_sql.
3894 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
3900 Returns an SQL expression identifying suspended cust_main records.
3905 sub suspended_sql { susp_sql(@_); }
3907 FS::cust_main->none_active_sql.
3908 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
3914 Returns an SQL expression identifying cancelled cust_main records.
3918 sub cancelled_sql { cancel_sql(@_); }
3921 my $recurring_sql = FS::cust_pkg->recurring_sql;
3922 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
3925 0 < ( $select_count_pkgs )
3926 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
3927 AND 0 = ( $select_count_pkgs AND $recurring_sql
3928 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3930 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3936 =item uncancelled_sql
3938 Returns an SQL expression identifying un-cancelled cust_main records.
3942 sub uncancelled_sql { uncancel_sql(@_); }
3943 sub uncancel_sql { "
3944 ( 0 < ( $select_count_pkgs
3945 AND ( cust_pkg.cancel IS NULL
3946 OR cust_pkg.cancel = 0
3949 OR 0 = ( $select_count_pkgs )
3955 Returns an SQL fragment to retreive the balance.
3960 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
3961 WHERE cust_bill.custnum = cust_main.custnum )
3962 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
3963 WHERE cust_pay.custnum = cust_main.custnum )
3964 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
3965 WHERE cust_credit.custnum = cust_main.custnum )
3966 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
3967 WHERE cust_refund.custnum = cust_main.custnum )
3970 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3972 Returns an SQL fragment to retreive the balance for this customer, optionally
3973 considering invoices with date earlier than START_TIME, and not
3974 later than END_TIME (total_owed_date minus total_unapplied_credits minus
3975 total_unapplied_payments).
3977 Times are specified as SQL fragments or numeric
3978 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
3979 L<Date::Parse> for conversion functions. The empty string can be passed
3980 to disable that time constraint completely.
3982 Available options are:
3986 =item unapplied_date
3988 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)
3993 set to true to remove all customer comparison clauses, for totals
3998 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4003 JOIN clause (typically used with the total option)
4007 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4008 time will be ignored. Note that START_TIME and END_TIME only limit the date
4009 range for invoices and I<unapplied> payments, credits, and refunds.
4015 sub balance_date_sql {
4016 my( $class, $start, $end, %opt ) = @_;
4018 my $cutoff = $opt{'cutoff'};
4020 my $owed = FS::cust_bill->owed_sql($cutoff);
4021 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4022 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4023 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4025 my $j = $opt{'join'} || '';
4027 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4028 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4029 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4030 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4032 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4033 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4034 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4035 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4040 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4042 Returns an SQL fragment to retreive the total unapplied payments for this
4043 customer, only considering invoices with date earlier than START_TIME, and
4044 optionally not later than END_TIME.
4046 Times are specified as SQL fragments or numeric
4047 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4048 L<Date::Parse> for conversion functions. The empty string can be passed
4049 to disable that time constraint completely.
4051 Available options are:
4055 sub unapplied_payments_date_sql {
4056 my( $class, $start, $end, %opt ) = @_;
4058 my $cutoff = $opt{'cutoff'};
4060 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4062 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4063 'unapplied_date'=>1 );
4065 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4068 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4070 Helper method for balance_date_sql; name (and usage) subject to change
4071 (suggestions welcome).
4073 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4074 cust_refund, cust_credit or cust_pay).
4076 If TABLE is "cust_bill" or the unapplied_date option is true, only
4077 considers records with date earlier than START_TIME, and optionally not
4078 later than END_TIME .
4082 sub _money_table_where {
4083 my( $class, $table, $start, $end, %opt ) = @_;
4086 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4087 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4088 push @where, "$table._date <= $start" if defined($start) && length($start);
4089 push @where, "$table._date > $end" if defined($end) && length($end);
4091 push @where, @{$opt{'where'}} if $opt{'where'};
4092 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4098 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4099 use FS::cust_main::Search;
4102 FS::cust_main::Search->search(@_);
4111 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
4115 use FS::cust_main::Search;
4116 sub append_fuzzyfiles {
4117 #my( $first, $last, $company ) = @_;
4119 FS::cust_main::Search::check_and_rebuild_fuzzyfiles();
4121 use Fcntl qw(:flock);
4123 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
4125 foreach my $field (@fuzzyfields) {
4130 open(CACHE,">>$dir/cust_main.$field")
4131 or die "can't open $dir/cust_main.$field: $!";
4132 flock(CACHE,LOCK_EX)
4133 or die "can't lock $dir/cust_main.$field: $!";
4135 print CACHE "$value\n";
4137 flock(CACHE,LOCK_UN)
4138 or die "can't unlock $dir/cust_main.$field: $!";
4153 #warn join('-',keys %$param);
4154 my $fh = $param->{filehandle};
4155 my $agentnum = $param->{agentnum};
4156 my $format = $param->{format};
4158 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4161 if ( $format eq 'simple' ) {
4162 @fields = qw( custnum agent_custid amount pkg );
4164 die "unknown format $format";
4167 eval "use Text::CSV_XS;";
4170 my $csv = new Text::CSV_XS;
4177 local $SIG{HUP} = 'IGNORE';
4178 local $SIG{INT} = 'IGNORE';
4179 local $SIG{QUIT} = 'IGNORE';
4180 local $SIG{TERM} = 'IGNORE';
4181 local $SIG{TSTP} = 'IGNORE';
4182 local $SIG{PIPE} = 'IGNORE';
4184 my $oldAutoCommit = $FS::UID::AutoCommit;
4185 local $FS::UID::AutoCommit = 0;
4188 #while ( $columns = $csv->getline($fh) ) {
4190 while ( defined($line=<$fh>) ) {
4192 $csv->parse($line) or do {
4193 $dbh->rollback if $oldAutoCommit;
4194 return "can't parse: ". $csv->error_input();
4197 my @columns = $csv->fields();
4198 #warn join('-',@columns);
4201 foreach my $field ( @fields ) {
4202 $row{$field} = shift @columns;
4205 if ( $row{custnum} && $row{agent_custid} ) {
4206 dbh->rollback if $oldAutoCommit;
4207 return "can't specify custnum with agent_custid $row{agent_custid}";
4211 if ( $row{agent_custid} && $agentnum ) {
4212 %hash = ( 'agent_custid' => $row{agent_custid},
4213 'agentnum' => $agentnum,
4217 if ( $row{custnum} ) {
4218 %hash = ( 'custnum' => $row{custnum} );
4221 unless ( scalar(keys %hash) ) {
4222 $dbh->rollback if $oldAutoCommit;
4223 return "can't find customer without custnum or agent_custid and agentnum";
4226 my $cust_main = qsearchs('cust_main', { %hash } );
4227 unless ( $cust_main ) {
4228 $dbh->rollback if $oldAutoCommit;
4229 my $custnum = $row{custnum} || $row{agent_custid};
4230 return "unknown custnum $custnum";
4233 if ( $row{'amount'} > 0 ) {
4234 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4236 $dbh->rollback if $oldAutoCommit;
4240 } elsif ( $row{'amount'} < 0 ) {
4241 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4244 $dbh->rollback if $oldAutoCommit;
4254 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4256 return "Empty file!" unless $imported;
4262 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4264 Deprecated. Use event notification and message templates
4265 (L<FS::msg_template>) instead.
4267 Sends a templated email notification to the customer (see L<Text::Template>).
4269 OPTIONS is a hash and may include
4271 I<from> - the email sender (default is invoice_from)
4273 I<to> - comma-separated scalar or arrayref of recipients
4274 (default is invoicing_list)
4276 I<subject> - The subject line of the sent email notification
4277 (default is "Notice from company_name")
4279 I<extra_fields> - a hashref of name/value pairs which will be substituted
4282 The following variables are vavailable in the template.
4284 I<$first> - the customer first name
4285 I<$last> - the customer last name
4286 I<$company> - the customer company
4287 I<$payby> - a description of the method of payment for the customer
4288 # would be nice to use FS::payby::shortname
4289 I<$payinfo> - the account information used to collect for this customer
4290 I<$expdate> - the expiration of the customer payment in seconds from epoch
4295 my ($self, $template, %options) = @_;
4297 return unless $conf->exists($template);
4299 my $from = $conf->config('invoice_from', $self->agentnum)
4300 if $conf->exists('invoice_from', $self->agentnum);
4301 $from = $options{from} if exists($options{from});
4303 my $to = join(',', $self->invoicing_list_emailonly);
4304 $to = $options{to} if exists($options{to});
4306 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4307 if $conf->exists('company_name', $self->agentnum);
4308 $subject = $options{subject} if exists($options{subject});
4310 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4311 SOURCE => [ map "$_\n",
4312 $conf->config($template)]
4314 or die "can't create new Text::Template object: Text::Template::ERROR";
4315 $notify_template->compile()
4316 or die "can't compile template: Text::Template::ERROR";
4318 $FS::notify_template::_template::company_name =
4319 $conf->config('company_name', $self->agentnum);
4320 $FS::notify_template::_template::company_address =
4321 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4323 my $paydate = $self->paydate || '2037-12-31';
4324 $FS::notify_template::_template::first = $self->first;
4325 $FS::notify_template::_template::last = $self->last;
4326 $FS::notify_template::_template::company = $self->company;
4327 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4328 my $payby = $self->payby;
4329 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4330 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4332 #credit cards expire at the end of the month/year of their exp date
4333 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4334 $FS::notify_template::_template::payby = 'credit card';
4335 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4336 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4338 }elsif ($payby eq 'COMP') {
4339 $FS::notify_template::_template::payby = 'complimentary account';
4341 $FS::notify_template::_template::payby = 'current method';
4343 $FS::notify_template::_template::expdate = $expire_time;
4345 for (keys %{$options{extra_fields}}){
4347 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4350 send_email(from => $from,
4352 subject => $subject,
4353 body => $notify_template->fill_in( PACKAGE =>
4354 'FS::notify_template::_template' ),
4359 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4361 Generates a templated notification to the customer (see L<Text::Template>).
4363 OPTIONS is a hash and may include
4365 I<extra_fields> - a hashref of name/value pairs which will be substituted
4366 into the template. These values may override values mentioned below
4367 and those from the customer record.
4369 The following variables are available in the template instead of or in addition
4370 to the fields of the customer record.
4372 I<$payby> - a description of the method of payment for the customer
4373 # would be nice to use FS::payby::shortname
4374 I<$payinfo> - the masked account information used to collect for this customer
4375 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4376 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4380 # a lot like cust_bill::print_latex
4381 sub generate_letter {
4382 my ($self, $template, %options) = @_;
4384 return unless $conf->exists($template);
4386 my $letter_template = new Text::Template
4388 SOURCE => [ map "$_\n", $conf->config($template)],
4389 DELIMITERS => [ '[@--', '--@]' ],
4391 or die "can't create new Text::Template object: Text::Template::ERROR";
4393 $letter_template->compile()
4394 or die "can't compile template: Text::Template::ERROR";
4396 my %letter_data = map { $_ => $self->$_ } $self->fields;
4397 $letter_data{payinfo} = $self->mask_payinfo;
4399 #my $paydate = $self->paydate || '2037-12-31';
4400 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4402 my $payby = $self->payby;
4403 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4404 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4406 #credit cards expire at the end of the month/year of their exp date
4407 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4408 $letter_data{payby} = 'credit card';
4409 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4410 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4412 }elsif ($payby eq 'COMP') {
4413 $letter_data{payby} = 'complimentary account';
4415 $letter_data{payby} = 'current method';
4417 $letter_data{expdate} = $expire_time;
4419 for (keys %{$options{extra_fields}}){
4420 $letter_data{$_} = $options{extra_fields}->{$_};
4423 unless(exists($letter_data{returnaddress})){
4424 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4425 $self->agent_template)
4427 if ( length($retadd) ) {
4428 $letter_data{returnaddress} = $retadd;
4429 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4430 $letter_data{returnaddress} =
4431 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4435 ( $conf->config('company_name', $self->agentnum),
4436 $conf->config('company_address', $self->agentnum),
4440 $letter_data{returnaddress} = '~';
4444 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4446 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4448 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4450 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4454 ) or die "can't open temp file: $!\n";
4455 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4456 or die "can't write temp file: $!\n";
4458 $letter_data{'logo_file'} = $lh->filename;
4460 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4464 ) or die "can't open temp file: $!\n";
4466 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4468 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4469 return ($1, $letter_data{'logo_file'});
4473 =item print_ps TEMPLATE
4475 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4481 my($file, $lfile) = $self->generate_letter(@_);
4482 my $ps = FS::Misc::generate_ps($file);
4483 unlink($file.'.tex');
4489 =item print TEMPLATE
4491 Prints the filled in template.
4493 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4497 sub queueable_print {
4500 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4501 or die "invalid customer number: " . $opt{custvnum};
4503 my $error = $self->print( $opt{template} );
4504 die $error if $error;
4508 my ($self, $template) = (shift, shift);
4509 do_print [ $self->print_ps($template) ];
4512 #these three subs should just go away once agent stuff is all config overrides
4514 sub agent_template {
4516 $self->_agent_plandata('agent_templatename');
4519 sub agent_invoice_from {
4521 $self->_agent_plandata('agent_invoice_from');
4524 sub _agent_plandata {
4525 my( $self, $option ) = @_;
4527 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4528 #agent-specific Conf
4530 use FS::part_event::Condition;
4532 my $agentnum = $self->agentnum;
4534 my $regexp = regexp_sql();
4536 my $part_event_option =
4538 'select' => 'part_event_option.*',
4539 'table' => 'part_event_option',
4541 LEFT JOIN part_event USING ( eventpart )
4542 LEFT JOIN part_event_option AS peo_agentnum
4543 ON ( part_event.eventpart = peo_agentnum.eventpart
4544 AND peo_agentnum.optionname = 'agentnum'
4545 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4547 LEFT JOIN part_event_condition
4548 ON ( part_event.eventpart = part_event_condition.eventpart
4549 AND part_event_condition.conditionname = 'cust_bill_age'
4551 LEFT JOIN part_event_condition_option
4552 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4553 AND part_event_condition_option.optionname = 'age'
4556 #'hashref' => { 'optionname' => $option },
4557 #'hashref' => { 'part_event_option.optionname' => $option },
4559 " WHERE part_event_option.optionname = ". dbh->quote($option).
4560 " AND action = 'cust_bill_send_agent' ".
4561 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4562 " AND peo_agentnum.optionname = 'agentnum' ".
4563 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4565 CASE WHEN part_event_condition_option.optionname IS NULL
4567 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4569 , part_event.weight".
4573 unless ( $part_event_option ) {
4574 return $self->agent->invoice_template || ''
4575 if $option eq 'agent_templatename';
4579 $part_event_option->optionvalue;
4583 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4585 Subroutine (not a method), designed to be called from the queue.
4587 Takes a list of options and values.
4589 Pulls up the customer record via the custnum option and calls bill_and_collect.
4594 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4596 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4597 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4599 $cust_main->bill_and_collect( %args );
4602 sub process_bill_and_collect {
4604 my $param = thaw(decode_base64(shift));
4605 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4606 or die "custnum '$param->{custnum}' not found!\n";
4607 $param->{'job'} = $job;
4608 $param->{'fatal'} = 1; # runs from job queue, will be caught
4609 $param->{'retry'} = 1;
4611 $cust_main->bill_and_collect( %$param );
4614 sub _upgrade_data { #class method
4615 my ($class, %opts) = @_;
4618 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
4619 'UPDATE cust_main SET signupdate = (SELECT signupdate FROM h_cust_main WHERE signupdate IS NOT NULL AND h_cust_main.custnum = cust_main.custnum ORDER BY historynum DESC LIMIT 1) WHERE signupdate IS NULL',
4621 my $sth = dbh->prepare($sql) or die dbh->errstr;
4622 $sth->execute or die $sth->errstr;
4625 local($ignore_expired_card) = 1;
4626 local($ignore_illegal_zip) = 1;
4627 local($ignore_banned_card) = 1;
4628 local($skip_fuzzyfiles) = 1;
4629 $class->_upgrade_otaker(%opts);
4639 The delete method should possibly take an FS::cust_main object reference
4640 instead of a scalar customer number.
4642 Bill and collect options should probably be passed as references instead of a
4645 There should probably be a configuration file with a list of allowed credit
4648 No multiple currency support (probably a larger project than just this module).
4650 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4652 Birthdates rely on negative epoch values.
4654 The payby for card/check batches is broken. With mixed batching, bad
4657 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4661 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4662 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4663 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.