5 #FS::cust_main:_Marketgear when they're ready to move to 2.1
6 use base qw( FS::cust_main::Packages FS::cust_main::Status
7 FS::cust_main::Billing FS::cust_main::Billing_Realtime
8 FS::cust_main::Billing_Discount
9 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
13 use vars qw( $DEBUG $me $conf
16 $ignore_expired_card $ignore_illegal_zip $ignore_banned_card
21 use Scalar::Util qw( blessed );
22 use Time::Local qw(timelocal);
23 use Storable qw(thaw);
27 use Digest::MD5 qw(md5_base64);
30 use File::Temp; #qw( tempfile );
31 use Business::CreditCard 0.28;
33 use FS::UID qw( getotaker dbh driver_name );
34 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
35 use FS::Misc qw( generate_email send_email generate_ps do_print );
36 use FS::Msgcat qw(gettext);
43 use FS::legacy_cust_bill;
45 use FS::cust_pay_pending;
46 use FS::cust_pay_void;
47 use FS::cust_pay_batch;
50 use FS::part_referral;
51 use FS::cust_main_county;
52 use FS::cust_location;
54 use FS::cust_main_exemption;
55 use FS::cust_tax_adjustment;
56 use FS::cust_tax_location;
58 use FS::cust_main_invoice;
60 use FS::prepay_credit;
66 use FS::payment_gateway;
67 use FS::agent_payment_gateway;
69 use FS::cust_main_note;
70 use FS::cust_attachment;
74 # 1 is mostly method/subroutine entry and options
75 # 2 traces progress of some operations
76 # 3 is even more information including possibly sensitive data
78 $me = '[FS::cust_main]';
81 $ignore_expired_card = 0;
82 $ignore_illegal_zip = 0;
83 $ignore_banned_card = 0;
87 @encrypted_fields = ('payinfo', 'paycvv');
88 sub nohistory_fields { ('payinfo', 'paycvv'); }
90 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
92 #ask FS::UID to run this stuff for us later
93 #$FS::UID::callback{'FS::cust_main'} = sub {
94 install_callback FS::UID sub {
96 #yes, need it for stuff below (prolly should be cached)
101 my ( $hashref, $cache ) = @_;
102 if ( exists $hashref->{'pkgnum'} ) {
103 #@{ $self->{'_pkgnum'} } = ();
104 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
105 $self->{'_pkgnum'} = $subcache;
106 #push @{ $self->{'_pkgnum'} },
107 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
113 FS::cust_main - Object methods for cust_main records
119 $record = new FS::cust_main \%hash;
120 $record = new FS::cust_main { 'column' => 'value' };
122 $error = $record->insert;
124 $error = $new_record->replace($old_record);
126 $error = $record->delete;
128 $error = $record->check;
130 @cust_pkg = $record->all_pkgs;
132 @cust_pkg = $record->ncancelled_pkgs;
134 @cust_pkg = $record->suspended_pkgs;
136 $error = $record->bill;
137 $error = $record->bill %options;
138 $error = $record->bill 'time' => $time;
140 $error = $record->collect;
141 $error = $record->collect %options;
142 $error = $record->collect 'invoice_time' => $time,
147 An FS::cust_main object represents a customer. FS::cust_main inherits from
148 FS::Record. The following fields are currently supported:
154 Primary key (assigned automatically for new customers)
158 Agent (see L<FS::agent>)
162 Advertising source (see L<FS::part_referral>)
174 Cocial security number (optional)
190 (optional, see L<FS::cust_main_county>)
194 (see L<FS::cust_main_county>)
200 (see L<FS::cust_main_county>)
240 (optional, see L<FS::cust_main_county>)
244 (see L<FS::cust_main_county>)
250 (see L<FS::cust_main_county>)
270 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
274 Payment Information (See L<FS::payinfo_Mixin> for data format)
278 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
282 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
286 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
290 Start date month (maestro/solo cards only)
294 Start date year (maestro/solo cards only)
298 Issue number (maestro/solo cards only)
302 Name on card or billing name
306 IP address from which payment information was received
310 Tax exempt, empty or `Y'
314 Order taker (see L<FS::access_user>)
320 =item referral_custnum
322 Referring customer number
326 Enable individual CDR spooling, empty or `Y'
330 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
334 Discourage individual CDR printing, empty or `Y'
338 Allow self-service editing of ticket subjects, empty or 'Y'
340 =item calling_list_exempt
342 Do not call, empty or 'Y'
352 Creates a new customer. To add the customer to the database, see L<"insert">.
354 Note that this stores the hash reference, not a distinct copy of the hash it
355 points to. You can ask the object for a copy with the I<hash> method.
359 sub table { 'cust_main'; }
361 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
363 Adds this customer to the database. If there is an error, returns the error,
364 otherwise returns false.
366 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
367 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
368 are inserted atomicly, or the transaction is rolled back. Passing an empty
369 hash reference is equivalent to not supplying this parameter. There should be
370 a better explanation of this, but until then, here's an example:
373 tie %hash, 'Tie::RefHash'; #this part is important
375 $cust_pkg => [ $svc_acct ],
378 $cust_main->insert( \%hash );
380 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
381 be set as the invoicing list (see L<"invoicing_list">). Errors return as
382 expected and rollback the entire transaction; it is not necessary to call
383 check_invoicing_list first. The invoicing_list is set after the records in the
384 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
385 invoicing_list destination to the newly-created svc_acct. Here's an example:
387 $cust_main->insert( {}, [ $email, 'POST' ] );
389 Currently available options are: I<depend_jobnum>, I<noexport>,
390 I<tax_exemption> and I<prospectnum>.
392 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
393 on the supplied jobnum (they will not run until the specific job completes).
394 This can be used to defer provisioning until some action completes (such
395 as running the customer's credit card successfully).
397 The I<noexport> option is deprecated. If I<noexport> is set true, no
398 provisioning jobs (exports) are scheduled. (You can schedule them later with
399 the B<reexport> method.)
401 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
402 of tax names and exemption numbers. FS::cust_main_exemption records will be
403 created and inserted.
405 If I<prospectnum> is set, moves contacts and locations from that prospect.
411 my $cust_pkgs = @_ ? shift : {};
412 my $invoicing_list = @_ ? shift : '';
414 warn "$me insert called with options ".
415 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
418 local $SIG{HUP} = 'IGNORE';
419 local $SIG{INT} = 'IGNORE';
420 local $SIG{QUIT} = 'IGNORE';
421 local $SIG{TERM} = 'IGNORE';
422 local $SIG{TSTP} = 'IGNORE';
423 local $SIG{PIPE} = 'IGNORE';
425 my $oldAutoCommit = $FS::UID::AutoCommit;
426 local $FS::UID::AutoCommit = 0;
429 my $prepay_identifier = '';
430 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
432 if ( $self->payby eq 'PREPAY' ) {
434 $self->payby('BILL');
435 $prepay_identifier = $self->payinfo;
438 warn " looking up prepaid card $prepay_identifier\n"
441 my $error = $self->get_prepay( $prepay_identifier,
442 'amount_ref' => \$amount,
443 'seconds_ref' => \$seconds,
444 'upbytes_ref' => \$upbytes,
445 'downbytes_ref' => \$downbytes,
446 'totalbytes_ref' => \$totalbytes,
449 $dbh->rollback if $oldAutoCommit;
450 #return "error applying prepaid card (transaction rolled back): $error";
454 $payby = 'PREP' if $amount;
456 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
459 $self->payby('BILL');
460 $amount = $self->paid;
464 warn " inserting $self\n"
467 $self->signupdate(time) unless $self->signupdate;
469 $self->censusyear($conf->config('census_year')||'2012') if $self->censustract;
471 $self->auto_agent_custid()
472 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
474 my $error = $self->SUPER::insert;
476 $dbh->rollback if $oldAutoCommit;
477 #return "inserting cust_main record (transaction rolled back): $error";
481 warn " setting invoicing list\n"
484 if ( $invoicing_list ) {
485 $error = $self->check_invoicing_list( $invoicing_list );
487 $dbh->rollback if $oldAutoCommit;
488 #return "checking invoicing_list (transaction rolled back): $error";
491 $self->invoicing_list( $invoicing_list );
494 warn " setting customer tags\n"
497 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
498 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
499 'custnum' => $self->custnum };
500 my $error = $cust_tag->insert;
502 $dbh->rollback if $oldAutoCommit;
507 my $prospectnum = delete $options{'prospectnum'};
508 if ( $prospectnum ) {
510 warn " moving contacts and locations from prospect $prospectnum\n"
514 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
515 unless ( $prospect_main ) {
516 $dbh->rollback if $oldAutoCommit;
517 return "Unknown prospectnum $prospectnum";
519 $prospect_main->custnum($self->custnum);
520 $prospect_main->disabled('Y');
521 my $error = $prospect_main->replace;
523 $dbh->rollback if $oldAutoCommit;
527 my @contact = $prospect_main->contact;
528 my @cust_location = $prospect_main->cust_location;
529 my @qual = $prospect_main->qual;
531 foreach my $r ( @contact, @cust_location, @qual ) {
533 $r->custnum($self->custnum);
534 my $error = $r->replace;
536 $dbh->rollback if $oldAutoCommit;
543 warn " setting cust_main_exemption\n"
546 my $tax_exemption = delete $options{'tax_exemption'};
547 if ( $tax_exemption ) {
549 $tax_exemption = { map { $_ => '' } @$tax_exemption }
550 if ref($tax_exemption) eq 'ARRAY';
552 foreach my $taxname ( keys %$tax_exemption ) {
553 my $cust_main_exemption = new FS::cust_main_exemption {
554 'custnum' => $self->custnum,
555 'taxname' => $taxname,
556 'exempt_number' => $tax_exemption->{$taxname},
558 my $error = $cust_main_exemption->insert;
560 $dbh->rollback if $oldAutoCommit;
561 return "inserting cust_main_exemption (transaction rolled back): $error";
566 if ( $self->can('start_copy_skel') ) {
567 my $error = $self->start_copy_skel;
569 $dbh->rollback if $oldAutoCommit;
574 warn " ordering packages\n"
577 $error = $self->order_pkgs( $cust_pkgs,
579 'seconds_ref' => \$seconds,
580 'upbytes_ref' => \$upbytes,
581 'downbytes_ref' => \$downbytes,
582 'totalbytes_ref' => \$totalbytes,
585 $dbh->rollback if $oldAutoCommit;
590 $dbh->rollback if $oldAutoCommit;
591 return "No svc_acct record to apply pre-paid time";
593 if ( $upbytes || $downbytes || $totalbytes ) {
594 $dbh->rollback if $oldAutoCommit;
595 return "No svc_acct record to apply pre-paid data";
599 warn " inserting initial $payby payment of $amount\n"
601 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
603 $dbh->rollback if $oldAutoCommit;
604 return "inserting payment (transaction rolled back): $error";
608 unless ( $import || $skip_fuzzyfiles ) {
609 warn " queueing fuzzyfiles update\n"
611 $error = $self->queue_fuzzyfiles_update;
613 $dbh->rollback if $oldAutoCommit;
614 return "updating fuzzy search cache: $error";
618 # FS::geocode_Mixin::after_insert or something?
619 if ( $conf->config('tax_district_method') and !$import ) {
620 # if anything non-empty, try to look it up
621 my $queue = new FS::queue {
622 'job' => 'FS::geocode_Mixin::process_district_update',
623 'custnum' => $self->custnum,
625 my $error = $queue->insert( ref($self), $self->custnum );
627 $dbh->rollback if $oldAutoCommit;
628 return "queueing tax district update: $error";
633 warn " exporting\n" if $DEBUG > 1;
635 my $export_args = $options{'export_args'} || [];
638 map qsearch( 'part_export', {exportnum=>$_} ),
639 $conf->config('cust_main-exports'); #, $agentnum
641 foreach my $part_export ( @part_export ) {
642 my $error = $part_export->export_insert($self, @$export_args);
644 $dbh->rollback if $oldAutoCommit;
645 return "exporting to ". $part_export->exporttype.
646 " (transaction rolled back): $error";
650 #foreach my $depend_jobnum ( @$depend_jobnums ) {
651 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
653 # foreach my $jobnum ( @jobnums ) {
654 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
655 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
657 # my $error = $queue->depend_insert($depend_jobnum);
659 # $dbh->rollback if $oldAutoCommit;
660 # return "error queuing job dependancy: $error";
667 #if ( exists $options{'jobnums'} ) {
668 # push @{ $options{'jobnums'} }, @jobnums;
671 warn " insert complete; committing transaction\n"
674 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
679 use File::CounterFile;
680 sub auto_agent_custid {
683 my $format = $conf->config('cust_main-auto_agent_custid');
685 if ( $format eq '1YMMXXXXXXXX' ) {
687 my $counter = new File::CounterFile 'cust_main.agent_custid';
690 my $ym = 100000000000 + time2str('%y%m00000000', time);
691 if ( $ym > $counter->value ) {
692 $counter->{'value'} = $agent_custid = $ym;
693 $counter->{'updated'} = 1;
695 $agent_custid = $counter->inc;
701 die "Unknown cust_main-auto_agent_custid format: $format";
704 $self->agent_custid($agent_custid);
708 =item PACKAGE METHODS
710 Documentation on customer package methods has been moved to
711 L<FS::cust_main::Packages>.
713 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
715 Recharges this (existing) customer with the specified prepaid card (see
716 L<FS::prepay_credit>), specified either by I<identifier> or as an
717 FS::prepay_credit object. If there is an error, returns the error, otherwise
720 Optionally, five scalar references can be passed as well. They will have their
721 values filled in with the amount, number of seconds, and number of upload,
722 download, and total bytes applied by this prepaid card.
726 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
727 #the only place that uses these args
728 sub recharge_prepay {
729 my( $self, $prepay_credit, $amountref, $secondsref,
730 $upbytesref, $downbytesref, $totalbytesref ) = @_;
732 local $SIG{HUP} = 'IGNORE';
733 local $SIG{INT} = 'IGNORE';
734 local $SIG{QUIT} = 'IGNORE';
735 local $SIG{TERM} = 'IGNORE';
736 local $SIG{TSTP} = 'IGNORE';
737 local $SIG{PIPE} = 'IGNORE';
739 my $oldAutoCommit = $FS::UID::AutoCommit;
740 local $FS::UID::AutoCommit = 0;
743 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
745 my $error = $self->get_prepay( $prepay_credit,
746 'amount_ref' => \$amount,
747 'seconds_ref' => \$seconds,
748 'upbytes_ref' => \$upbytes,
749 'downbytes_ref' => \$downbytes,
750 'totalbytes_ref' => \$totalbytes,
752 || $self->increment_seconds($seconds)
753 || $self->increment_upbytes($upbytes)
754 || $self->increment_downbytes($downbytes)
755 || $self->increment_totalbytes($totalbytes)
756 || $self->insert_cust_pay_prepay( $amount,
758 ? $prepay_credit->identifier
763 $dbh->rollback if $oldAutoCommit;
767 if ( defined($amountref) ) { $$amountref = $amount; }
768 if ( defined($secondsref) ) { $$secondsref = $seconds; }
769 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
770 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
771 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
773 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
778 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
780 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
781 specified either by I<identifier> or as an FS::prepay_credit object.
783 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
784 incremented by the values of the prepaid card.
786 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
787 check or set this customer's I<agentnum>.
789 If there is an error, returns the error, otherwise returns false.
795 my( $self, $prepay_credit, %opt ) = @_;
797 local $SIG{HUP} = 'IGNORE';
798 local $SIG{INT} = 'IGNORE';
799 local $SIG{QUIT} = 'IGNORE';
800 local $SIG{TERM} = 'IGNORE';
801 local $SIG{TSTP} = 'IGNORE';
802 local $SIG{PIPE} = 'IGNORE';
804 my $oldAutoCommit = $FS::UID::AutoCommit;
805 local $FS::UID::AutoCommit = 0;
808 unless ( ref($prepay_credit) ) {
810 my $identifier = $prepay_credit;
812 $prepay_credit = qsearchs(
814 { 'identifier' => $identifier },
819 unless ( $prepay_credit ) {
820 $dbh->rollback if $oldAutoCommit;
821 return "Invalid prepaid card: ". $identifier;
826 if ( $prepay_credit->agentnum ) {
827 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
828 $dbh->rollback if $oldAutoCommit;
829 return "prepaid card not valid for agent ". $self->agentnum;
831 $self->agentnum($prepay_credit->agentnum);
834 my $error = $prepay_credit->delete;
836 $dbh->rollback if $oldAutoCommit;
837 return "removing prepay_credit (transaction rolled back): $error";
840 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
841 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
843 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
848 =item increment_upbytes SECONDS
850 Updates this customer's single or primary account (see L<FS::svc_acct>) by
851 the specified number of upbytes. If there is an error, returns the error,
852 otherwise returns false.
856 sub increment_upbytes {
857 _increment_column( shift, 'upbytes', @_);
860 =item increment_downbytes SECONDS
862 Updates this customer's single or primary account (see L<FS::svc_acct>) by
863 the specified number of downbytes. If there is an error, returns the error,
864 otherwise returns false.
868 sub increment_downbytes {
869 _increment_column( shift, 'downbytes', @_);
872 =item increment_totalbytes SECONDS
874 Updates this customer's single or primary account (see L<FS::svc_acct>) by
875 the specified number of totalbytes. If there is an error, returns the error,
876 otherwise returns false.
880 sub increment_totalbytes {
881 _increment_column( shift, 'totalbytes', @_);
884 =item increment_seconds SECONDS
886 Updates this customer's single or primary account (see L<FS::svc_acct>) by
887 the specified number of seconds. If there is an error, returns the error,
888 otherwise returns false.
892 sub increment_seconds {
893 _increment_column( shift, 'seconds', @_);
896 =item _increment_column AMOUNT
898 Updates this customer's single or primary account (see L<FS::svc_acct>) by
899 the specified number of seconds or bytes. If there is an error, returns
900 the error, otherwise returns false.
904 sub _increment_column {
905 my( $self, $column, $amount ) = @_;
906 warn "$me increment_column called: $column, $amount\n"
909 return '' unless $amount;
911 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
912 $self->ncancelled_pkgs;
915 return 'No packages with primary or single services found'.
916 ' to apply pre-paid time';
917 } elsif ( scalar(@cust_pkg) > 1 ) {
918 #maybe have a way to specify the package/account?
919 return 'Multiple packages found to apply pre-paid time';
922 my $cust_pkg = $cust_pkg[0];
923 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
927 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
930 return 'No account found to apply pre-paid time';
931 } elsif ( scalar(@cust_svc) > 1 ) {
932 return 'Multiple accounts found to apply pre-paid time';
935 my $svc_acct = $cust_svc[0]->svc_x;
936 warn " found service svcnum ". $svc_acct->pkgnum.
937 ' ('. $svc_acct->email. ")\n"
940 $column = "increment_$column";
941 $svc_acct->$column($amount);
945 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
947 Inserts a prepayment in the specified amount for this customer. An optional
948 second argument can specify the prepayment identifier for tracking purposes.
949 If there is an error, returns the error, otherwise returns false.
953 sub insert_cust_pay_prepay {
954 shift->insert_cust_pay('PREP', @_);
957 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
959 Inserts a cash payment in the specified amount for this customer. An optional
960 second argument can specify the payment identifier for tracking purposes.
961 If there is an error, returns the error, otherwise returns false.
965 sub insert_cust_pay_cash {
966 shift->insert_cust_pay('CASH', @_);
969 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
971 Inserts a Western Union payment in the specified amount for this customer. An
972 optional second argument can specify the prepayment identifier for tracking
973 purposes. If there is an error, returns the error, otherwise returns false.
977 sub insert_cust_pay_west {
978 shift->insert_cust_pay('WEST', @_);
981 sub insert_cust_pay {
982 my( $self, $payby, $amount ) = splice(@_, 0, 3);
983 my $payinfo = scalar(@_) ? shift : '';
985 my $cust_pay = new FS::cust_pay {
986 'custnum' => $self->custnum,
987 'paid' => sprintf('%.2f', $amount),
988 #'_date' => #date the prepaid card was purchased???
990 'payinfo' => $payinfo,
998 This method is deprecated. See the I<depend_jobnum> option to the insert and
999 order_pkgs methods for a better way to defer provisioning.
1001 Re-schedules all exports by calling the B<reexport> method of all associated
1002 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1003 otherwise returns false.
1010 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1011 "use the depend_jobnum option to insert or order_pkgs to delay export";
1013 local $SIG{HUP} = 'IGNORE';
1014 local $SIG{INT} = 'IGNORE';
1015 local $SIG{QUIT} = 'IGNORE';
1016 local $SIG{TERM} = 'IGNORE';
1017 local $SIG{TSTP} = 'IGNORE';
1018 local $SIG{PIPE} = 'IGNORE';
1020 my $oldAutoCommit = $FS::UID::AutoCommit;
1021 local $FS::UID::AutoCommit = 0;
1024 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1025 my $error = $cust_pkg->reexport;
1027 $dbh->rollback if $oldAutoCommit;
1032 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1037 =item delete [ OPTION => VALUE ... ]
1039 This deletes the customer. If there is an error, returns the error, otherwise
1042 This will completely remove all traces of the customer record. This is not
1043 what you want when a customer cancels service; for that, cancel all of the
1044 customer's packages (see L</cancel>).
1046 If the customer has any uncancelled packages, you need to pass a new (valid)
1047 customer number for those packages to be transferred to, as the "new_customer"
1048 option. Cancelled packages will be deleted. Did I mention that this is NOT
1049 what you want when a customer cancels service and that you really should be
1050 looking at L<FS::cust_pkg/cancel>?
1052 You can't delete a customer with invoices (see L<FS::cust_bill>),
1053 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1054 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1055 set the "delete_financials" option to a true value.
1060 my( $self, %opt ) = @_;
1062 local $SIG{HUP} = 'IGNORE';
1063 local $SIG{INT} = 'IGNORE';
1064 local $SIG{QUIT} = 'IGNORE';
1065 local $SIG{TERM} = 'IGNORE';
1066 local $SIG{TSTP} = 'IGNORE';
1067 local $SIG{PIPE} = 'IGNORE';
1069 my $oldAutoCommit = $FS::UID::AutoCommit;
1070 local $FS::UID::AutoCommit = 0;
1073 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1074 $dbh->rollback if $oldAutoCommit;
1075 return "Can't delete a master agent customer";
1078 #use FS::access_user
1079 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1080 $dbh->rollback if $oldAutoCommit;
1081 return "Can't delete a master employee customer";
1084 tie my %financial_tables, 'Tie::IxHash',
1085 'cust_bill' => 'invoices',
1086 'cust_statement' => 'statements',
1087 'cust_credit' => 'credits',
1088 'cust_pay' => 'payments',
1089 'cust_refund' => 'refunds',
1092 foreach my $table ( keys %financial_tables ) {
1094 my @records = $self->$table();
1096 if ( @records && ! $opt{'delete_financials'} ) {
1097 $dbh->rollback if $oldAutoCommit;
1098 return "Can't delete a customer with ". $financial_tables{$table};
1101 foreach my $record ( @records ) {
1102 my $error = $record->delete;
1104 $dbh->rollback if $oldAutoCommit;
1105 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1111 my @cust_pkg = $self->ncancelled_pkgs;
1113 my $new_custnum = $opt{'new_custnum'};
1114 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1115 $dbh->rollback if $oldAutoCommit;
1116 return "Invalid new customer number: $new_custnum";
1118 foreach my $cust_pkg ( @cust_pkg ) {
1119 my %hash = $cust_pkg->hash;
1120 $hash{'custnum'} = $new_custnum;
1121 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1122 my $error = $new_cust_pkg->replace($cust_pkg,
1123 options => { $cust_pkg->options },
1126 $dbh->rollback if $oldAutoCommit;
1131 my @cancelled_cust_pkg = $self->all_pkgs;
1132 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1133 my $error = $cust_pkg->delete;
1135 $dbh->rollback if $oldAutoCommit;
1140 #cust_tax_adjustment in financials?
1141 #cust_pay_pending? ouch
1143 foreach my $table (qw(
1144 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1145 cust_location cust_main_note cust_tax_adjustment
1146 cust_pay_void cust_pay_batch queue cust_tax_exempt
1148 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1149 my $error = $record->delete;
1151 $dbh->rollback if $oldAutoCommit;
1157 my $sth = $dbh->prepare(
1158 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1160 my $errstr = $dbh->errstr;
1161 $dbh->rollback if $oldAutoCommit;
1164 $sth->execute($self->custnum) or do {
1165 my $errstr = $sth->errstr;
1166 $dbh->rollback if $oldAutoCommit;
1172 my $ticket_dbh = '';
1173 if ($conf->config('ticket_system') eq 'RT_Internal') {
1175 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1176 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1177 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1178 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1181 if ( $ticket_dbh ) {
1183 my $ticket_sth = $ticket_dbh->prepare(
1184 'DELETE FROM Links WHERE Target = ?'
1186 my $errstr = $ticket_dbh->errstr;
1187 $dbh->rollback if $oldAutoCommit;
1190 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1192 my $errstr = $ticket_sth->errstr;
1193 $dbh->rollback if $oldAutoCommit;
1197 #check and see if the customer is the only link on the ticket, and
1198 #if so, set the ticket to deleted status in RT?
1199 #maybe someday, for now this will at least fix tickets not displaying
1203 #delete the customer record
1205 my $error = $self->SUPER::delete;
1207 $dbh->rollback if $oldAutoCommit;
1211 # cust_main exports!
1213 #my $export_args = $options{'export_args'} || [];
1216 map qsearch( 'part_export', {exportnum=>$_} ),
1217 $conf->config('cust_main-exports'); #, $agentnum
1219 foreach my $part_export ( @part_export ) {
1220 my $error = $part_export->export_delete( $self ); #, @$export_args);
1222 $dbh->rollback if $oldAutoCommit;
1223 return "exporting to ". $part_export->exporttype.
1224 " (transaction rolled back): $error";
1228 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1233 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1235 This merges this customer into the provided new custnum, and then deletes the
1236 customer. If there is an error, returns the error, otherwise returns false.
1238 The source customer's name, company name, phone numbers, agent,
1239 referring customer, customer class, advertising source, order taker, and
1240 billing information (except balance) are discarded.
1242 All packages are moved to the target customer. Packages with package locations
1243 are preserved. Packages without package locations are moved to a new package
1244 location with the source customer's service/shipping address.
1246 All invoices, statements, payments, credits and refunds are moved to the target
1247 customer. The source customer's balance is added to the target customer.
1249 All notes, attachments, tickets and customer tags are moved to the target
1252 Change history is not currently moved.
1257 my( $self, $new_custnum, %opt ) = @_;
1259 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1261 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1262 return "Invalid new customer number: $new_custnum";
1265 local $SIG{HUP} = 'IGNORE';
1266 local $SIG{INT} = 'IGNORE';
1267 local $SIG{QUIT} = 'IGNORE';
1268 local $SIG{TERM} = 'IGNORE';
1269 local $SIG{TSTP} = 'IGNORE';
1270 local $SIG{PIPE} = 'IGNORE';
1272 my $oldAutoCommit = $FS::UID::AutoCommit;
1273 local $FS::UID::AutoCommit = 0;
1276 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1277 $dbh->rollback if $oldAutoCommit;
1278 return "Can't merge a master agent customer";
1281 #use FS::access_user
1282 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1283 $dbh->rollback if $oldAutoCommit;
1284 return "Can't merge a master employee customer";
1287 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1288 'status' => { op=>'!=', value=>'done' },
1292 $dbh->rollback if $oldAutoCommit;
1293 return "Can't merge a customer with pending payments";
1296 tie my %financial_tables, 'Tie::IxHash',
1297 'cust_bill' => 'invoices',
1298 'cust_statement' => 'statements',
1299 'cust_credit' => 'credits',
1300 'cust_pay' => 'payments',
1301 'cust_pay_void' => 'voided payments',
1302 'cust_refund' => 'refunds',
1305 foreach my $table ( keys %financial_tables ) {
1307 my @records = $self->$table();
1309 foreach my $record ( @records ) {
1310 $record->custnum($new_custnum);
1311 my $error = $record->replace;
1313 $dbh->rollback if $oldAutoCommit;
1314 return "Error merging ". $financial_tables{$table}. ": $error\n";
1320 my $name = $self->ship_name;
1322 my $locationnum = '';
1323 foreach my $cust_pkg ( $self->all_pkgs ) {
1324 $cust_pkg->custnum($new_custnum);
1326 unless ( $cust_pkg->locationnum ) {
1327 unless ( $locationnum ) {
1328 my $cust_location = new FS::cust_location {
1329 $self->location_hash,
1330 'custnum' => $new_custnum,
1332 my $error = $cust_location->insert;
1334 $dbh->rollback if $oldAutoCommit;
1337 $locationnum = $cust_location->locationnum;
1339 $cust_pkg->locationnum($locationnum);
1342 my $error = $cust_pkg->replace;
1344 $dbh->rollback if $oldAutoCommit;
1348 # add customer (ship) name to svc_phone.phone_name if blank
1349 my @cust_svc = $cust_pkg->cust_svc;
1350 foreach my $cust_svc (@cust_svc) {
1351 my($label, $value, $svcdb) = $cust_svc->label;
1352 next unless $svcdb eq 'svc_phone';
1353 my $svc_phone = $cust_svc->svc_x;
1354 next if $svc_phone->phone_name;
1355 $svc_phone->phone_name($name);
1356 my $error = $svc_phone->replace;
1358 $dbh->rollback if $oldAutoCommit;
1366 # cust_tax_exempt (texas tax exemptions)
1367 # cust_recon (some sort of not-well understood thing for OnPac)
1369 #these are moved over
1370 foreach my $table (qw(
1371 cust_tag cust_location contact cust_attachment cust_main_note
1372 cust_tax_adjustment cust_pay_batch queue
1374 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1375 $record->custnum($new_custnum);
1376 my $error = $record->replace;
1378 $dbh->rollback if $oldAutoCommit;
1384 #these aren't preserved
1385 foreach my $table (qw(
1386 cust_main_exemption cust_main_invoice
1388 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1389 my $error = $record->delete;
1391 $dbh->rollback if $oldAutoCommit;
1398 my $sth = $dbh->prepare(
1399 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1401 my $errstr = $dbh->errstr;
1402 $dbh->rollback if $oldAutoCommit;
1405 $sth->execute($new_custnum, $self->custnum) or do {
1406 my $errstr = $sth->errstr;
1407 $dbh->rollback if $oldAutoCommit;
1413 my $ticket_dbh = '';
1414 if ($conf->config('ticket_system') eq 'RT_Internal') {
1416 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1417 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1418 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1419 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1422 if ( $ticket_dbh ) {
1424 my $ticket_sth = $ticket_dbh->prepare(
1425 'UPDATE Links SET Target = ? WHERE Target = ?'
1427 my $errstr = $ticket_dbh->errstr;
1428 $dbh->rollback if $oldAutoCommit;
1431 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1432 'freeside://freeside/cust_main/'.$self->custnum)
1434 my $errstr = $ticket_sth->errstr;
1435 $dbh->rollback if $oldAutoCommit;
1441 #delete the customer record
1443 my $error = $self->delete;
1445 $dbh->rollback if $oldAutoCommit;
1449 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1454 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1457 Replaces the OLD_RECORD with this one in the database. If there is an error,
1458 returns the error, otherwise returns false.
1460 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1461 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1462 expected and rollback the entire transaction; it is not necessary to call
1463 check_invoicing_list first. Here's an example:
1465 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1467 Currently available options are: I<tax_exemption>.
1469 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1470 of tax names and exemption numbers. FS::cust_main_exemption records will be
1471 deleted and inserted as appropriate.
1478 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1480 : $self->replace_old;
1484 warn "$me replace called\n"
1487 my $curuser = $FS::CurrentUser::CurrentUser;
1488 if ( $self->payby eq 'COMP'
1489 && $self->payby ne $old->payby
1490 && ! $curuser->access_right('Complimentary customer')
1493 return "You are not permitted to create complimentary accounts.";
1496 if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode')
1497 && $conf->exists('enable_taxproducts')
1500 my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip)
1502 $self->set('geocode', '')
1503 if $old->get($pre.'zip') ne $self->get($pre.'zip')
1504 && length($self->get($pre.'zip')) >= 10;
1507 for my $pre ( grep $old->get($_.'coord_auto'), ( '', 'ship_' ) ) {
1509 $self->set($pre.'coord_auto', '') && next
1510 if $self->get($pre.'latitude') && $self->get($pre.'longitude')
1511 && ( $self->get($pre.'latitude') != $old->get($pre.'latitude')
1512 || $self->get($pre.'longitude') != $old->get($pre.'longitude')
1515 $self->set_coord($pre)
1516 if $old->get($pre.'address1') ne $self->get($pre.'address1')
1517 || $old->get($pre.'city') ne $self->get($pre.'city')
1518 || $old->get($pre.'state') ne $self->get($pre.'state')
1519 || $old->get($pre.'country') ne $self->get($pre.'country');
1523 unless ( $import ) {
1525 if ! $self->coord_auto && ! $self->latitude && ! $self->longitude;
1527 $self->set_coord('ship_')
1528 if $self->has_ship_address && ! $self->ship_coord_auto
1529 && ! $self->ship_latitude && ! $self->ship_longitude;
1532 local($ignore_expired_card) = 1
1533 if $old->payby =~ /^(CARD|DCRD)$/
1534 && $self->payby =~ /^(CARD|DCRD)$/
1535 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1537 local($ignore_banned_card) = 1
1538 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1539 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1540 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1542 if ( $self->censustract ne '' and $self->censustract ne $old->censustract ) {
1543 # update censusyear whenever tract code changes
1544 $self->censusyear($conf->config('census_year')||'2012');
1547 return "Invoicing locale is required"
1550 && $conf->exists('cust_main-require_locale');
1552 local $SIG{HUP} = 'IGNORE';
1553 local $SIG{INT} = 'IGNORE';
1554 local $SIG{QUIT} = 'IGNORE';
1555 local $SIG{TERM} = 'IGNORE';
1556 local $SIG{TSTP} = 'IGNORE';
1557 local $SIG{PIPE} = 'IGNORE';
1559 my $oldAutoCommit = $FS::UID::AutoCommit;
1560 local $FS::UID::AutoCommit = 0;
1563 my $error = $self->SUPER::replace($old);
1566 $dbh->rollback if $oldAutoCommit;
1570 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1571 my $invoicing_list = shift @param;
1572 $error = $self->check_invoicing_list( $invoicing_list );
1574 $dbh->rollback if $oldAutoCommit;
1577 $self->invoicing_list( $invoicing_list );
1580 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1582 #this could be more efficient than deleting and re-inserting, if it matters
1583 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1584 my $error = $cust_tag->delete;
1586 $dbh->rollback if $oldAutoCommit;
1590 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1591 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1592 'custnum' => $self->custnum };
1593 my $error = $cust_tag->insert;
1595 $dbh->rollback if $oldAutoCommit;
1602 my %options = @param;
1604 my $tax_exemption = delete $options{'tax_exemption'};
1605 if ( $tax_exemption ) {
1607 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1608 if ref($tax_exemption) eq 'ARRAY';
1610 my %cust_main_exemption =
1611 map { $_->taxname => $_ }
1612 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1614 foreach my $taxname ( keys %$tax_exemption ) {
1616 if ( $cust_main_exemption{$taxname} &&
1617 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1620 delete $cust_main_exemption{$taxname};
1624 my $cust_main_exemption = new FS::cust_main_exemption {
1625 'custnum' => $self->custnum,
1626 'taxname' => $taxname,
1627 'exempt_number' => $tax_exemption->{$taxname},
1629 my $error = $cust_main_exemption->insert;
1631 $dbh->rollback if $oldAutoCommit;
1632 return "inserting cust_main_exemption (transaction rolled back): $error";
1636 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1637 my $error = $cust_main_exemption->delete;
1639 $dbh->rollback if $oldAutoCommit;
1640 return "deleting cust_main_exemption (transaction rolled back): $error";
1646 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1647 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1648 && $self->get('payinfo') !~ /^99\d{14}$/
1650 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1655 # card/check/lec info has changed, want to retry realtime_ invoice events
1656 my $error = $self->retry_realtime;
1658 $dbh->rollback if $oldAutoCommit;
1663 unless ( $import || $skip_fuzzyfiles ) {
1664 $error = $self->queue_fuzzyfiles_update;
1666 $dbh->rollback if $oldAutoCommit;
1667 return "updating fuzzy search cache: $error";
1671 # FS::geocode_Mixin::after_replace ?
1672 # though this will go away anyway once we move customer bill/service
1673 # locations into cust_location
1674 # We can trigger this on any address change--just have to make sure
1675 # not to trigger it on itself.
1676 if ( $conf->config('tax_district_method') and !$import
1677 and ( $self->get('ship_address1') ne $old->get('ship_address1')
1678 or $self->get('address1') ne $old->get('address1') ) ) {
1679 my $queue = new FS::queue {
1680 'job' => 'FS::geocode_Mixin::process_district_update',
1681 'custnum' => $self->custnum,
1683 my $error = $queue->insert( ref($self), $self->custnum );
1685 $dbh->rollback if $oldAutoCommit;
1686 return "queueing tax district update: $error";
1690 # cust_main exports!
1692 my $export_args = $options{'export_args'} || [];
1695 map qsearch( 'part_export', {exportnum=>$_} ),
1696 $conf->config('cust_main-exports'); #, $agentnum
1698 foreach my $part_export ( @part_export ) {
1699 my $error = $part_export->export_replace( $self, $old, @$export_args);
1701 $dbh->rollback if $oldAutoCommit;
1702 return "exporting to ". $part_export->exporttype.
1703 " (transaction rolled back): $error";
1707 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1712 =item queue_fuzzyfiles_update
1714 Used by insert & replace to update the fuzzy search cache
1718 use FS::cust_main::Search;
1719 sub queue_fuzzyfiles_update {
1722 local $SIG{HUP} = 'IGNORE';
1723 local $SIG{INT} = 'IGNORE';
1724 local $SIG{QUIT} = 'IGNORE';
1725 local $SIG{TERM} = 'IGNORE';
1726 local $SIG{TSTP} = 'IGNORE';
1727 local $SIG{PIPE} = 'IGNORE';
1729 my $oldAutoCommit = $FS::UID::AutoCommit;
1730 local $FS::UID::AutoCommit = 0;
1733 my $queue = new FS::queue { 'job' => 'FS::cust_main::Search::append_fuzzyfiles' };
1734 my $error = $queue->insert( map $self->getfield($_), @FS::cust_main::Search::fuzzyfields );
1736 $dbh->rollback if $oldAutoCommit;
1737 return "queueing job (transaction rolled back): $error";
1740 if ( $self->ship_last ) {
1741 $queue = new FS::queue { 'job' => 'FS::cust_main::Search::append_fuzzyfiles' };
1742 $error = $queue->insert( map $self->getfield("ship_$_"), @FS::cust_main::Search::fuzzyfields );
1744 $dbh->rollback if $oldAutoCommit;
1745 return "queueing job (transaction rolled back): $error";
1749 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1756 Checks all fields to make sure this is a valid customer record. If there is
1757 an error, returns the error, otherwise returns false. Called by the insert
1758 and replace methods.
1765 warn "$me check BEFORE: \n". $self->_dump
1769 $self->ut_numbern('custnum')
1770 || $self->ut_number('agentnum')
1771 || $self->ut_textn('agent_custid')
1772 || $self->ut_number('refnum')
1773 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1774 || $self->ut_textn('custbatch')
1775 || $self->ut_name('last')
1776 || $self->ut_name('first')
1777 || $self->ut_snumbern('birthdate')
1778 || $self->ut_snumbern('signupdate')
1779 || $self->ut_textn('company')
1780 || $self->ut_text('address1')
1781 || $self->ut_textn('address2')
1782 || $self->ut_text('city')
1783 || $self->ut_textn('county')
1784 || $self->ut_textn('state')
1785 || $self->ut_country('country')
1786 || $self->ut_coordn('latitude')
1787 || $self->ut_coordn('longitude')
1788 || $self->ut_enum('coord_auto', [ '', 'Y' ])
1789 || $self->ut_numbern('censusyear')
1790 || $self->ut_anything('comments')
1791 || $self->ut_numbern('referral_custnum')
1792 || $self->ut_textn('stateid')
1793 || $self->ut_textn('stateid_state')
1794 || $self->ut_textn('invoice_terms')
1795 || $self->ut_alphan('geocode')
1796 || $self->ut_alphan('district')
1797 || $self->ut_floatn('cdr_termination_percentage')
1798 || $self->ut_floatn('credit_limit')
1799 || $self->ut_numbern('billday')
1800 || $self->ut_enum('edit_subject', [ '', 'Y' ] )
1801 || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] )
1802 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1806 unless $import || ($self->latitude && $self->longitude);
1808 #barf. need message catalogs. i18n. etc.
1809 $error .= "Please select an advertising source."
1810 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1811 return $error if $error;
1813 return "Unknown agent"
1814 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1816 return "Unknown refnum"
1817 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1819 return "Unknown referring custnum: ". $self->referral_custnum
1820 unless ! $self->referral_custnum
1821 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1823 if ( $self->censustract ne '' ) {
1824 $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1825 or return "Illegal census tract: ". $self->censustract;
1827 $self->censustract("$1.$2");
1830 if ( $self->ss eq '' ) {
1835 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1836 or return "Illegal social security number: ". $self->ss;
1837 $self->ss("$1-$2-$3");
1841 # bad idea to disable, causes billing to fail because of no tax rates later
1842 # except we don't fail any more
1843 unless ( $import ) {
1844 unless ( qsearch('cust_main_county', {
1845 'country' => $self->country,
1848 return "Unknown state/county/country: ".
1849 $self->state. "/". $self->county. "/". $self->country
1850 unless qsearch('cust_main_county',{
1851 'state' => $self->state,
1852 'county' => $self->county,
1853 'country' => $self->country,
1859 $self->ut_phonen('daytime', $self->country)
1860 || $self->ut_phonen('night', $self->country)
1861 || $self->ut_phonen('fax', $self->country)
1862 || $self->ut_phonen('mobile', $self->country)
1864 return $error if $error;
1866 unless ( $ignore_illegal_zip ) {
1867 $error = $self->ut_zip('zip', $self->country);
1868 return $error if $error;
1871 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1872 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1875 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1877 : FS::Msgcat::_gettext('daytime');
1878 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1880 : FS::Msgcat::_gettext('night');
1882 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1884 : FS::Msgcat::_gettext('mobile');
1886 return "$daytime_label, $night_label or $mobile_label is required"
1890 if ( $self->has_ship_address
1891 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1892 $self->addr_fields )
1896 $self->ut_name('ship_last')
1897 || $self->ut_name('ship_first')
1898 || $self->ut_textn('ship_company')
1899 || $self->ut_text('ship_address1')
1900 || $self->ut_textn('ship_address2')
1901 || $self->ut_text('ship_city')
1902 || $self->ut_textn('ship_county')
1903 || $self->ut_textn('ship_state')
1904 || $self->ut_country('ship_country')
1905 || $self->ut_coordn('ship_latitude')
1906 || $self->ut_coordn('ship_longitude')
1907 || $self->ut_enum('ship_coord_auto', [ '', 'Y' ] )
1909 return $error if $error;
1911 $self->set_coord('ship_')
1912 unless $import || ($self->ship_latitude && $self->ship_longitude);
1914 #false laziness with above
1915 unless ( qsearchs('cust_main_county', {
1916 'country' => $self->ship_country,
1919 return "Unknown ship_state/ship_county/ship_country: ".
1920 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1921 unless qsearch('cust_main_county',{
1922 'state' => $self->ship_state,
1923 'county' => $self->ship_county,
1924 'country' => $self->ship_country,
1930 $self->ut_phonen('ship_daytime', $self->ship_country)
1931 || $self->ut_phonen('ship_night', $self->ship_country)
1932 || $self->ut_phonen('ship_fax', $self->ship_country)
1933 || $self->ut_phonen('ship_mobile', $self->ship_country)
1935 return $error if $error;
1937 unless ( $ignore_illegal_zip ) {
1938 $error = $self->ut_zip('ship_zip', $self->ship_country);
1939 return $error if $error;
1941 return "Unit # is required."
1942 if $self->ship_address2 =~ /^\s*$/
1943 && $conf->exists('cust_main-require_address2');
1945 } else { # ship_ info eq billing info, so don't store dup info in database
1947 $self->setfield("ship_$_", '')
1948 foreach $self->addr_fields;
1950 return "Unit # is required."
1951 if $self->address2 =~ /^\s*$/
1952 && $conf->exists('cust_main-require_address2');
1956 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1957 # or return "Illegal payby: ". $self->payby;
1959 FS::payby->can_payby($self->table, $self->payby)
1960 or return "Illegal payby: ". $self->payby;
1962 $error = $self->ut_numbern('paystart_month')
1963 || $self->ut_numbern('paystart_year')
1964 || $self->ut_numbern('payissue')
1965 || $self->ut_textn('paytype')
1967 return $error if $error;
1969 if ( $self->payip eq '' ) {
1972 $error = $self->ut_ip('payip');
1973 return $error if $error;
1976 # If it is encrypted and the private key is not availaible then we can't
1977 # check the credit card.
1978 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1980 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1982 my $payinfo = $self->payinfo;
1983 $payinfo =~ s/\D//g;
1984 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1985 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1987 $self->payinfo($payinfo);
1989 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1991 return gettext('unknown_card_type')
1992 if $self->payinfo !~ /^99\d{14}$/ #token
1993 && cardtype($self->payinfo) eq "Unknown";
1995 unless ( $ignore_banned_card ) {
1996 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1998 if ( $ban->bantype eq 'warn' ) {
1999 #or others depending on value of $ban->reason ?
2000 return '_duplicate_card'.
2001 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
2002 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
2003 ' (ban# '. $ban->bannum. ')'
2004 unless $self->override_ban_warn;
2006 return 'Banned credit card: banned on '.
2007 time2str('%a %h %o at %r', $ban->_date).
2008 ' by '. $ban->otaker.
2009 ' (ban# '. $ban->bannum. ')';
2014 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
2015 if ( cardtype($self->payinfo) eq 'American Express card' ) {
2016 $self->paycvv =~ /^(\d{4})$/
2017 or return "CVV2 (CID) for American Express cards is four digits.";
2020 $self->paycvv =~ /^(\d{3})$/
2021 or return "CVV2 (CVC2/CID) is three digits.";
2028 my $cardtype = cardtype($payinfo);
2029 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
2031 return "Start date or issue number is required for $cardtype cards"
2032 unless $self->paystart_month && $self->paystart_year or $self->payissue;
2034 return "Start month must be between 1 and 12"
2035 if $self->paystart_month
2036 and $self->paystart_month < 1 || $self->paystart_month > 12;
2038 return "Start year must be 1990 or later"
2039 if $self->paystart_year
2040 and $self->paystart_year < 1990;
2042 return "Issue number must be beween 1 and 99"
2044 and $self->payissue < 1 || $self->payissue > 99;
2047 $self->paystart_month('');
2048 $self->paystart_year('');
2049 $self->payissue('');
2052 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
2054 my $payinfo = $self->payinfo;
2055 $payinfo =~ s/[^\d\@\.]//g;
2056 if ( $conf->config('echeck-country') eq 'CA' ) {
2057 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
2058 or return 'invalid echeck account@branch.bank';
2059 $payinfo = "$1\@$2.$3";
2060 } elsif ( $conf->config('echeck-country') eq 'US' ) {
2061 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
2062 $payinfo = "$1\@$2";
2064 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
2065 $payinfo = "$1\@$2";
2067 $self->payinfo($payinfo);
2070 unless ( $ignore_banned_card ) {
2071 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
2073 if ( $ban->bantype eq 'warn' ) {
2074 #or others depending on value of $ban->reason ?
2075 return '_duplicate_ach' unless $self->override_ban_warn;
2077 return 'Banned ACH account: banned on '.
2078 time2str('%a %h %o at %r', $ban->_date).
2079 ' by '. $ban->otaker.
2080 ' (ban# '. $ban->bannum. ')';
2085 } elsif ( $self->payby eq 'LECB' ) {
2087 my $payinfo = $self->payinfo;
2088 $payinfo =~ s/\D//g;
2089 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2091 $self->payinfo($payinfo);
2094 } elsif ( $self->payby eq 'BILL' ) {
2096 $error = $self->ut_textn('payinfo');
2097 return "Illegal P.O. number: ". $self->payinfo if $error;
2100 } elsif ( $self->payby eq 'COMP' ) {
2102 my $curuser = $FS::CurrentUser::CurrentUser;
2103 if ( ! $self->custnum
2104 && ! $curuser->access_right('Complimentary customer')
2107 return "You are not permitted to create complimentary accounts."
2110 $error = $self->ut_textn('payinfo');
2111 return "Illegal comp account issuer: ". $self->payinfo if $error;
2114 } elsif ( $self->payby eq 'PREPAY' ) {
2116 my $payinfo = $self->payinfo;
2117 $payinfo =~ s/\W//g; #anything else would just confuse things
2118 $self->payinfo($payinfo);
2119 $error = $self->ut_alpha('payinfo');
2120 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2121 return "Unknown prepayment identifier"
2122 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2127 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2128 return "Expiration date required"
2129 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2133 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2134 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2135 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2136 ( $m, $y ) = ( $2, "19$1" );
2137 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2138 ( $m, $y ) = ( $3, "20$2" );
2140 return "Illegal expiration date: ". $self->paydate;
2142 $m = sprintf('%02d',$m);
2143 $self->paydate("$y-$m-01");
2144 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2145 return gettext('expired_card')
2147 && !$ignore_expired_card
2148 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2151 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2152 ( ! $conf->exists('require_cardname')
2153 || $self->payby !~ /^(CARD|DCRD)$/ )
2155 $self->payname( $self->first. " ". $self->getfield('last') );
2157 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2158 or return gettext('illegal_name'). " payname: ". $self->payname;
2162 return "Please select an invoicing locale"
2165 && $conf->exists('cust_main-require_locale');
2167 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2168 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2172 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2174 warn "$me check AFTER: \n". $self->_dump
2177 $self->SUPER::check;
2182 Returns a list of fields which have ship_ duplicates.
2187 qw( last first company
2188 address1 address2 city county state zip country
2190 daytime night fax mobile
2194 =item has_ship_address
2196 Returns true if this customer record has a separate shipping address.
2200 sub has_ship_address {
2202 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2207 Returns a list of key/value pairs, with the following keys: address1,
2208 adddress2, city, county, state, zip, country, district, and geocode. The
2209 shipping address is used if present.
2215 Returns all locations (see L<FS::cust_location>) for this customer.
2221 qsearch('cust_location', { 'custnum' => $self->custnum } );
2226 Returns all contacts (see L<FS::contact>) for this customer.
2230 #already used :/ sub contact {
2233 qsearch('contact', { 'custnum' => $self->custnum } );
2238 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2239 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2240 on success or a list of errors.
2246 grep { $_->unsuspend } $self->suspended_pkgs;
2251 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2253 Returns a list: an empty list on success or a list of errors.
2259 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2262 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2264 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2265 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2266 of a list of pkgparts; the hashref has the following keys:
2270 =item pkgparts - listref of pkgparts
2272 =item (other options are passed to the suspend method)
2277 Returns a list: an empty list on success or a list of errors.
2281 sub suspend_if_pkgpart {
2283 my (@pkgparts, %opt);
2284 if (ref($_[0]) eq 'HASH'){
2285 @pkgparts = @{$_[0]{pkgparts}};
2290 grep { $_->suspend(%opt) }
2291 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2292 $self->unsuspended_pkgs;
2295 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2297 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2298 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2299 instead of a list of pkgparts; the hashref has the following keys:
2303 =item pkgparts - listref of pkgparts
2305 =item (other options are passed to the suspend method)
2309 Returns a list: an empty list on success or a list of errors.
2313 sub suspend_unless_pkgpart {
2315 my (@pkgparts, %opt);
2316 if (ref($_[0]) eq 'HASH'){
2317 @pkgparts = @{$_[0]{pkgparts}};
2322 grep { $_->suspend(%opt) }
2323 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2324 $self->unsuspended_pkgs;
2327 =item cancel [ OPTION => VALUE ... ]
2329 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2331 Available options are:
2335 =item quiet - can be set true to supress email cancellation notices.
2337 =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.
2339 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2341 =item nobill - can be set true to skip billing if it might otherwise be done.
2345 Always returns a list: an empty list on success or a list of errors.
2349 # nb that dates are not specified as valid options to this method
2352 my( $self, %opt ) = @_;
2354 warn "$me cancel called on customer ". $self->custnum. " with options ".
2355 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2358 return ( 'access denied' )
2359 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2361 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2363 #should try decryption (we might have the private key)
2364 # and if not maybe queue a job for the server that does?
2365 return ( "Can't (yet) ban encrypted credit cards" )
2366 if $self->is_encrypted($self->payinfo);
2368 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2369 my $error = $ban->insert;
2370 return ( $error ) if $error;
2374 my @pkgs = $self->ncancelled_pkgs;
2376 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2378 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2379 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2383 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2384 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2387 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2390 sub _banned_pay_hashref {
2401 'payby' => $payby2ban{$self->payby},
2402 'payinfo' => $self->payinfo,
2403 #don't ever *search* on reason! #'reason' =>
2407 sub _new_banned_pay_hashref {
2409 my $hr = $self->_banned_pay_hashref;
2410 $hr->{payinfo} = md5_base64($hr->{payinfo});
2416 Returns all notes (see L<FS::cust_main_note>) for this customer.
2421 my($self,$orderby_classnum) = (shift,shift);
2422 my $orderby = "_DATE DESC";
2423 $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
2424 qsearch( 'cust_main_note',
2425 { 'custnum' => $self->custnum },
2427 "ORDER BY $orderby",
2433 Returns the agent (see L<FS::agent>) for this customer.
2439 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2444 Returns the agent name (see L<FS::agent>) for this customer.
2450 $self->agent->agent;
2455 Returns any tags associated with this customer, as FS::cust_tag objects,
2456 or an empty list if there are no tags.
2462 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2467 Returns any tags associated with this customer, as FS::part_tag objects,
2468 or an empty list if there are no tags.
2474 map $_->part_tag, $self->cust_tag;
2480 Returns the customer class, as an FS::cust_class object, or the empty string
2481 if there is no customer class.
2487 if ( $self->classnum ) {
2488 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2496 Returns the customer category name, or the empty string if there is no customer
2503 my $cust_class = $self->cust_class;
2505 ? $cust_class->categoryname
2511 Returns the customer class name, or the empty string if there is no customer
2518 my $cust_class = $self->cust_class;
2520 ? $cust_class->classname
2524 =item BILLING METHODS
2526 Documentation on billing methods has been moved to
2527 L<FS::cust_main::Billing>.
2529 =item REALTIME BILLING METHODS
2531 Documentation on realtime billing methods has been moved to
2532 L<FS::cust_main::Billing_Realtime>.
2536 Removes the I<paycvv> field from the database directly.
2538 If there is an error, returns the error, otherwise returns false.
2544 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2545 or return dbh->errstr;
2546 $sth->execute($self->custnum)
2547 or return $sth->errstr;
2552 =item batch_card OPTION => VALUE...
2554 Adds a payment for this invoice to the pending credit card batch (see
2555 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2556 runs the payment using a realtime gateway.
2561 my ($self, %options) = @_;
2564 if (exists($options{amount})) {
2565 $amount = $options{amount};
2567 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2569 return '' unless $amount > 0;
2571 my $invnum = delete $options{invnum};
2572 my $payby = $options{payby} || $self->payby; #still dubious
2574 if ($options{'realtime'}) {
2575 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2581 my $oldAutoCommit = $FS::UID::AutoCommit;
2582 local $FS::UID::AutoCommit = 0;
2585 #this needs to handle mysql as well as Pg, like svc_acct.pm
2586 #(make it into a common function if folks need to do batching with mysql)
2587 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2588 or return "Cannot lock pay_batch: " . $dbh->errstr;
2592 'payby' => FS::payby->payby2payment($payby),
2594 $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2596 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2598 unless ( $pay_batch ) {
2599 $pay_batch = new FS::pay_batch \%pay_batch;
2600 my $error = $pay_batch->insert;
2602 $dbh->rollback if $oldAutoCommit;
2603 die "error creating new batch: $error\n";
2607 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2608 'batchnum' => $pay_batch->batchnum,
2609 'custnum' => $self->custnum,
2612 foreach (qw( address1 address2 city state zip country latitude longitude
2613 payby payinfo paydate payname ))
2615 $options{$_} = '' unless exists($options{$_});
2618 my $cust_pay_batch = new FS::cust_pay_batch ( {
2619 'batchnum' => $pay_batch->batchnum,
2620 'invnum' => $invnum || 0, # is there a better value?
2621 # this field should be
2623 # cust_bill_pay_batch now
2624 'custnum' => $self->custnum,
2625 'last' => $self->getfield('last'),
2626 'first' => $self->getfield('first'),
2627 'address1' => $options{address1} || $self->address1,
2628 'address2' => $options{address2} || $self->address2,
2629 'city' => $options{city} || $self->city,
2630 'state' => $options{state} || $self->state,
2631 'zip' => $options{zip} || $self->zip,
2632 'country' => $options{country} || $self->country,
2633 'payby' => $options{payby} || $self->payby,
2634 'payinfo' => $options{payinfo} || $self->payinfo,
2635 'exp' => $options{paydate} || $self->paydate,
2636 'payname' => $options{payname} || $self->payname,
2637 'amount' => $amount, # consolidating
2640 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2641 if $old_cust_pay_batch;
2644 if ($old_cust_pay_batch) {
2645 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2647 $error = $cust_pay_batch->insert;
2651 $dbh->rollback if $oldAutoCommit;
2655 my $unapplied = $self->total_unapplied_credits
2656 + $self->total_unapplied_payments
2657 + $self->in_transit_payments;
2658 foreach my $cust_bill ($self->open_cust_bill) {
2659 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2660 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2661 'invnum' => $cust_bill->invnum,
2662 'paybatchnum' => $cust_pay_batch->paybatchnum,
2663 'amount' => $cust_bill->owed,
2666 if ($unapplied >= $cust_bill_pay_batch->amount){
2667 $unapplied -= $cust_bill_pay_batch->amount;
2670 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2671 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2673 $error = $cust_bill_pay_batch->insert;
2675 $dbh->rollback if $oldAutoCommit;
2680 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2686 Returns the total owed for this customer on all invoices
2687 (see L<FS::cust_bill/owed>).
2693 $self->total_owed_date(2145859200); #12/31/2037
2696 =item total_owed_date TIME
2698 Returns the total owed for this customer on all invoices with date earlier than
2699 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2700 see L<Time::Local> and L<Date::Parse> for conversion functions.
2704 sub total_owed_date {
2708 my $custnum = $self->custnum;
2710 my $owed_sql = FS::cust_bill->owed_sql;
2713 SELECT SUM($owed_sql) FROM cust_bill
2714 WHERE custnum = $custnum
2718 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2722 =item total_owed_pkgnum PKGNUM
2724 Returns the total owed on all invoices for this customer's specific package
2725 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2729 sub total_owed_pkgnum {
2730 my( $self, $pkgnum ) = @_;
2731 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2734 =item total_owed_date_pkgnum TIME PKGNUM
2736 Returns the total owed for this customer's specific package when using
2737 experimental package balances on all invoices with date earlier than
2738 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2739 see L<Time::Local> and L<Date::Parse> for conversion functions.
2743 sub total_owed_date_pkgnum {
2744 my( $self, $time, $pkgnum ) = @_;
2747 foreach my $cust_bill (
2748 grep { $_->_date <= $time }
2749 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2751 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2753 sprintf( "%.2f", $total_bill );
2759 Returns the total amount of all payments.
2766 $total += $_->paid foreach $self->cust_pay;
2767 sprintf( "%.2f", $total );
2770 =item total_unapplied_credits
2772 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2773 customer. See L<FS::cust_credit/credited>.
2775 =item total_credited
2777 Old name for total_unapplied_credits. Don't use.
2781 sub total_credited {
2782 #carp "total_credited deprecated, use total_unapplied_credits";
2783 shift->total_unapplied_credits(@_);
2786 sub total_unapplied_credits {
2789 my $custnum = $self->custnum;
2791 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2794 SELECT SUM($unapplied_sql) FROM cust_credit
2795 WHERE custnum = $custnum
2798 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2802 =item total_unapplied_credits_pkgnum PKGNUM
2804 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2805 customer. See L<FS::cust_credit/credited>.
2809 sub total_unapplied_credits_pkgnum {
2810 my( $self, $pkgnum ) = @_;
2811 my $total_credit = 0;
2812 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2813 sprintf( "%.2f", $total_credit );
2817 =item total_unapplied_payments
2819 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2820 See L<FS::cust_pay/unapplied>.
2824 sub total_unapplied_payments {
2827 my $custnum = $self->custnum;
2829 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2832 SELECT SUM($unapplied_sql) FROM cust_pay
2833 WHERE custnum = $custnum
2836 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2840 =item total_unapplied_payments_pkgnum PKGNUM
2842 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2843 specific package when using experimental package balances. See
2844 L<FS::cust_pay/unapplied>.
2848 sub total_unapplied_payments_pkgnum {
2849 my( $self, $pkgnum ) = @_;
2850 my $total_unapplied = 0;
2851 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2852 sprintf( "%.2f", $total_unapplied );
2856 =item total_unapplied_refunds
2858 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2859 customer. See L<FS::cust_refund/unapplied>.
2863 sub total_unapplied_refunds {
2865 my $custnum = $self->custnum;
2867 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2870 SELECT SUM($unapplied_sql) FROM cust_refund
2871 WHERE custnum = $custnum
2874 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2880 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2881 total_unapplied_credits minus total_unapplied_payments).
2887 $self->balance_date_range;
2890 =item balance_date TIME
2892 Returns the balance for this customer, only considering invoices with date
2893 earlier than TIME (total_owed_date minus total_credited minus
2894 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2895 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2902 $self->balance_date_range(shift);
2905 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2907 Returns the balance for this customer, optionally considering invoices with
2908 date earlier than START_TIME, and not later than END_TIME
2909 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2911 Times are specified as SQL fragments or numeric
2912 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2913 L<Date::Parse> for conversion functions. The empty string can be passed
2914 to disable that time constraint completely.
2916 Available options are:
2920 =item unapplied_date
2922 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)
2928 sub balance_date_range {
2930 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2931 ') FROM cust_main WHERE custnum='. $self->custnum;
2932 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2935 =item balance_pkgnum PKGNUM
2937 Returns the balance for this customer's specific package when using
2938 experimental package balances (total_owed plus total_unrefunded, minus
2939 total_unapplied_credits minus total_unapplied_payments)
2943 sub balance_pkgnum {
2944 my( $self, $pkgnum ) = @_;
2947 $self->total_owed_pkgnum($pkgnum)
2948 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2949 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2950 - $self->total_unapplied_credits_pkgnum($pkgnum)
2951 - $self->total_unapplied_payments_pkgnum($pkgnum)
2955 =item in_transit_payments
2957 Returns the total of requests for payments for this customer pending in
2958 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
2962 sub in_transit_payments {
2964 my $in_transit_payments = 0;
2965 foreach my $pay_batch ( qsearch('pay_batch', {
2968 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2969 'batchnum' => $pay_batch->batchnum,
2970 'custnum' => $self->custnum,
2972 $in_transit_payments += $cust_pay_batch->amount;
2975 sprintf( "%.2f", $in_transit_payments );
2980 Returns a hash of useful information for making a payment.
2990 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2991 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2992 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2996 For credit card transactions:
3008 For electronic check transactions:
3023 $return{balance} = $self->balance;
3025 $return{payname} = $self->payname
3026 || ( $self->first. ' '. $self->get('last') );
3028 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
3030 $return{payby} = $self->payby;
3031 $return{stateid_state} = $self->stateid_state;
3033 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3034 $return{card_type} = cardtype($self->payinfo);
3035 $return{payinfo} = $self->paymask;
3037 @return{'month', 'year'} = $self->paydate_monthyear;
3041 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3042 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3043 $return{payinfo1} = $payinfo1;
3044 $return{payinfo2} = $payinfo2;
3045 $return{paytype} = $self->paytype;
3046 $return{paystate} = $self->paystate;
3050 #doubleclick protection
3052 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3058 =item paydate_monthyear
3060 Returns a two-element list consisting of the month and year of this customer's
3061 paydate (credit card expiration date for CARD customers)
3065 sub paydate_monthyear {
3067 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3069 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3078 Returns the exact time in seconds corresponding to the payment method
3079 expiration date. For CARD/DCRD customers this is the end of the month;
3080 for others (COMP is the only other payby that uses paydate) it's the start.
3081 Returns 0 if the paydate is empty or set to the far future.
3087 my ($month, $year) = $self->paydate_monthyear;
3088 return 0 if !$year or $year >= 2037;
3089 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3091 if ( $month == 13 ) {
3095 return timelocal(0,0,0,1,$month-1,$year) - 1;
3098 return timelocal(0,0,0,1,$month-1,$year);
3102 =item paydate_epoch_sql
3104 Class method. Returns an SQL expression to obtain the payment expiration date
3105 as a number of seconds.
3109 # Special expiration date behavior for non-CARD/DCRD customers has been
3110 # carefully preserved. Do we really use that?
3111 sub paydate_epoch_sql {
3113 my $table = shift || 'cust_main';
3114 my ($case1, $case2);
3115 if ( driver_name eq 'Pg' ) {
3116 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3117 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3119 elsif ( lc(driver_name) eq 'mysql' ) {
3120 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3121 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3124 return "CASE WHEN $table.payby IN('CARD','DCRD')
3130 =item tax_exemption TAXNAME
3135 my( $self, $taxname ) = @_;
3137 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3138 'taxname' => $taxname,
3143 =item cust_main_exemption
3147 sub cust_main_exemption {
3149 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3152 =item invoicing_list [ ARRAYREF ]
3154 If an arguement is given, sets these email addresses as invoice recipients
3155 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3156 (except as warnings), so use check_invoicing_list first.
3158 Returns a list of email addresses (with svcnum entries expanded).
3160 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3161 check it without disturbing anything by passing nothing.
3163 This interface may change in the future.
3167 sub invoicing_list {
3168 my( $self, $arrayref ) = @_;
3171 my @cust_main_invoice;
3172 if ( $self->custnum ) {
3173 @cust_main_invoice =
3174 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3176 @cust_main_invoice = ();
3178 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3179 #warn $cust_main_invoice->destnum;
3180 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3181 #warn $cust_main_invoice->destnum;
3182 my $error = $cust_main_invoice->delete;
3183 warn $error if $error;
3186 if ( $self->custnum ) {
3187 @cust_main_invoice =
3188 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3190 @cust_main_invoice = ();
3192 my %seen = map { $_->address => 1 } @cust_main_invoice;
3193 foreach my $address ( @{$arrayref} ) {
3194 next if exists $seen{$address} && $seen{$address};
3195 $seen{$address} = 1;
3196 my $cust_main_invoice = new FS::cust_main_invoice ( {
3197 'custnum' => $self->custnum,
3200 my $error = $cust_main_invoice->insert;
3201 warn $error if $error;
3205 if ( $self->custnum ) {
3207 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3214 =item check_invoicing_list ARRAYREF
3216 Checks these arguements as valid input for the invoicing_list method. If there
3217 is an error, returns the error, otherwise returns false.
3221 sub check_invoicing_list {
3222 my( $self, $arrayref ) = @_;
3224 foreach my $address ( @$arrayref ) {
3226 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3227 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3230 my $cust_main_invoice = new FS::cust_main_invoice ( {
3231 'custnum' => $self->custnum,
3234 my $error = $self->custnum
3235 ? $cust_main_invoice->check
3236 : $cust_main_invoice->checkdest
3238 return $error if $error;
3242 return "Email address required"
3243 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3244 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3249 =item set_default_invoicing_list
3251 Sets the invoicing list to all accounts associated with this customer,
3252 overwriting any previous invoicing list.
3256 sub set_default_invoicing_list {
3258 $self->invoicing_list($self->all_emails);
3263 Returns the email addresses of all accounts provisioned for this customer.
3270 foreach my $cust_pkg ( $self->all_pkgs ) {
3271 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3273 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3274 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3276 $list{$_}=1 foreach map { $_->email } @svc_acct;
3281 =item invoicing_list_addpost
3283 Adds postal invoicing to this customer. If this customer is already configured
3284 to receive postal invoices, does nothing.
3288 sub invoicing_list_addpost {
3290 return if grep { $_ eq 'POST' } $self->invoicing_list;
3291 my @invoicing_list = $self->invoicing_list;
3292 push @invoicing_list, 'POST';
3293 $self->invoicing_list(\@invoicing_list);
3296 =item invoicing_list_emailonly
3298 Returns the list of email invoice recipients (invoicing_list without non-email
3299 destinations such as POST and FAX).
3303 sub invoicing_list_emailonly {
3305 warn "$me invoicing_list_emailonly called"
3307 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3310 =item invoicing_list_emailonly_scalar
3312 Returns the list of email invoice recipients (invoicing_list without non-email
3313 destinations such as POST and FAX) as a comma-separated scalar.
3317 sub invoicing_list_emailonly_scalar {
3319 warn "$me invoicing_list_emailonly_scalar called"
3321 join(', ', $self->invoicing_list_emailonly);
3324 =item referral_custnum_cust_main
3326 Returns the customer who referred this customer (or the empty string, if
3327 this customer was not referred).
3329 Note the difference with referral_cust_main method: This method,
3330 referral_custnum_cust_main returns the single customer (if any) who referred
3331 this customer, while referral_cust_main returns an array of customers referred
3336 sub referral_custnum_cust_main {
3338 return '' unless $self->referral_custnum;
3339 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3342 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3344 Returns an array of customers referred by this customer (referral_custnum set
3345 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3346 customers referred by customers referred by this customer and so on, inclusive.
3347 The default behavior is DEPTH 1 (no recursion).
3349 Note the difference with referral_custnum_cust_main method: This method,
3350 referral_cust_main, returns an array of customers referred BY this customer,
3351 while referral_custnum_cust_main returns the single customer (if any) who
3352 referred this customer.
3356 sub referral_cust_main {
3358 my $depth = @_ ? shift : 1;
3359 my $exclude = @_ ? shift : {};
3362 map { $exclude->{$_->custnum}++; $_; }
3363 grep { ! $exclude->{ $_->custnum } }
3364 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3368 map { $_->referral_cust_main($depth-1, $exclude) }
3375 =item referral_cust_main_ncancelled
3377 Same as referral_cust_main, except only returns customers with uncancelled
3382 sub referral_cust_main_ncancelled {
3384 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3387 =item referral_cust_pkg [ DEPTH ]
3389 Like referral_cust_main, except returns a flat list of all unsuspended (and
3390 uncancelled) packages for each customer. The number of items in this list may
3391 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3395 sub referral_cust_pkg {
3397 my $depth = @_ ? shift : 1;
3399 map { $_->unsuspended_pkgs }
3400 grep { $_->unsuspended_pkgs }
3401 $self->referral_cust_main($depth);
3404 =item referring_cust_main
3406 Returns the single cust_main record for the customer who referred this customer
3407 (referral_custnum), or false.
3411 sub referring_cust_main {
3413 return '' unless $self->referral_custnum;
3414 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3417 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3419 Applies a credit to this customer. If there is an error, returns the error,
3420 otherwise returns false.
3422 REASON can be a text string, an FS::reason object, or a scalar reference to
3423 a reasonnum. If a text string, it will be automatically inserted as a new
3424 reason, and a 'reason_type' option must be passed to indicate the
3425 FS::reason_type for the new reason.
3427 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3429 Any other options are passed to FS::cust_credit::insert.
3434 my( $self, $amount, $reason, %options ) = @_;
3436 my $cust_credit = new FS::cust_credit {
3437 'custnum' => $self->custnum,
3438 'amount' => $amount,
3441 if ( ref($reason) ) {
3443 if ( ref($reason) eq 'SCALAR' ) {
3444 $cust_credit->reasonnum( $$reason );
3446 $cust_credit->reasonnum( $reason->reasonnum );
3450 $cust_credit->set('reason', $reason)
3453 for (qw( addlinfo eventnum )) {
3454 $cust_credit->$_( delete $options{$_} )
3455 if exists($options{$_});
3458 $cust_credit->insert(%options);
3462 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3464 Creates a one-time charge for this customer. If there is an error, returns
3465 the error, otherwise returns false.
3467 New-style, with a hashref of options:
3469 my $error = $cust_main->charge(
3473 'start_date' => str2time('7/4/2009'),
3474 'pkg' => 'Description',
3475 'comment' => 'Comment',
3476 'additional' => [], #extra invoice detail
3477 'classnum' => 1, #pkg_class
3479 'setuptax' => '', # or 'Y' for tax exempt
3482 'taxclass' => 'Tax class',
3485 'taxproduct' => 2, #part_pkg_taxproduct
3486 'override' => {}, #XXX describe
3488 #will be filled in with the new object
3489 'cust_pkg_ref' => \$cust_pkg,
3491 #generate an invoice immediately
3493 'invoice_terms' => '', #with these terms
3499 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3505 my ( $amount, $quantity, $start_date, $classnum );
3506 my ( $pkg, $comment, $additional );
3507 my ( $setuptax, $taxclass ); #internal taxes
3508 my ( $taxproduct, $override ); #vendor (CCH) taxes
3510 my $cust_pkg_ref = '';
3511 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3512 if ( ref( $_[0] ) ) {
3513 $amount = $_[0]->{amount};
3514 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3515 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3516 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3517 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3518 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3519 : '$'. sprintf("%.2f",$amount);
3520 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3521 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3522 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3523 $additional = $_[0]->{additional} || [];
3524 $taxproduct = $_[0]->{taxproductnum};
3525 $override = { '' => $_[0]->{tax_override} };
3526 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3527 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3528 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3533 $pkg = @_ ? shift : 'One-time charge';
3534 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3536 $taxclass = @_ ? shift : '';
3540 local $SIG{HUP} = 'IGNORE';
3541 local $SIG{INT} = 'IGNORE';
3542 local $SIG{QUIT} = 'IGNORE';
3543 local $SIG{TERM} = 'IGNORE';
3544 local $SIG{TSTP} = 'IGNORE';
3545 local $SIG{PIPE} = 'IGNORE';
3547 my $oldAutoCommit = $FS::UID::AutoCommit;
3548 local $FS::UID::AutoCommit = 0;
3551 my $part_pkg = new FS::part_pkg ( {
3553 'comment' => $comment,
3557 'classnum' => ( $classnum ? $classnum : '' ),
3558 'setuptax' => $setuptax,
3559 'taxclass' => $taxclass,
3560 'taxproductnum' => $taxproduct,
3563 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3564 ( 0 .. @$additional - 1 )
3566 'additional_count' => scalar(@$additional),
3567 'setup_fee' => $amount,
3570 my $error = $part_pkg->insert( options => \%options,
3571 tax_overrides => $override,
3574 $dbh->rollback if $oldAutoCommit;
3578 my $pkgpart = $part_pkg->pkgpart;
3579 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3580 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3581 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3582 $error = $type_pkgs->insert;
3584 $dbh->rollback if $oldAutoCommit;
3589 my $cust_pkg = new FS::cust_pkg ( {
3590 'custnum' => $self->custnum,
3591 'pkgpart' => $pkgpart,
3592 'quantity' => $quantity,
3593 'start_date' => $start_date,
3594 'no_auto' => $no_auto,
3597 $error = $cust_pkg->insert;
3599 $dbh->rollback if $oldAutoCommit;
3601 } elsif ( $cust_pkg_ref ) {
3602 ${$cust_pkg_ref} = $cust_pkg;
3606 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3607 'pkg_list' => [ $cust_pkg ],
3610 $dbh->rollback if $oldAutoCommit;
3615 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3620 #=item charge_postal_fee
3622 #Applies a one time charge this customer. If there is an error,
3623 #returns the error, returns the cust_pkg charge object or false
3624 #if there was no charge.
3628 # This should be a customer event. For that to work requires that bill
3629 # also be a customer event.
3631 sub charge_postal_fee {
3634 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3635 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3637 my $cust_pkg = new FS::cust_pkg ( {
3638 'custnum' => $self->custnum,
3639 'pkgpart' => $pkgpart,
3643 my $error = $cust_pkg->insert;
3644 $error ? $error : $cust_pkg;
3647 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3649 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3651 Optionally, a list or hashref of additional arguments to the qsearch call can
3658 my $opt = ref($_[0]) ? shift : { @_ };
3660 #return $self->num_cust_bill unless wantarray || keys %$opt;
3662 $opt->{'table'} = 'cust_bill';
3663 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3664 $opt->{'hashref'}{'custnum'} = $self->custnum;
3665 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3667 map { $_ } #behavior of sort undefined in scalar context
3668 sort { $a->_date <=> $b->_date }
3672 =item open_cust_bill
3674 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3679 sub open_cust_bill {
3683 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3689 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3691 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3695 sub legacy_cust_bill {
3698 #return $self->num_legacy_cust_bill unless wantarray;
3700 map { $_ } #behavior of sort undefined in scalar context
3701 sort { $a->_date <=> $b->_date }
3702 qsearch({ 'table' => 'legacy_cust_bill',
3703 'hashref' => { 'custnum' => $self->custnum, },
3704 'order_by' => 'ORDER BY _date ASC',
3708 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3710 Returns all the statements (see L<FS::cust_statement>) for this customer.
3712 Optionally, a list or hashref of additional arguments to the qsearch call can
3717 sub cust_statement {
3719 my $opt = ref($_[0]) ? shift : { @_ };
3721 #return $self->num_cust_statement unless wantarray || keys %$opt;
3723 $opt->{'table'} = 'cust_statement';
3724 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3725 $opt->{'hashref'}{'custnum'} = $self->custnum;
3726 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3728 map { $_ } #behavior of sort undefined in scalar context
3729 sort { $a->_date <=> $b->_date }
3735 Returns all the credits (see L<FS::cust_credit>) for this customer.
3741 map { $_ } #return $self->num_cust_credit unless wantarray;
3742 sort { $a->_date <=> $b->_date }
3743 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3746 =item cust_credit_pkgnum
3748 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3749 package when using experimental package balances.
3753 sub cust_credit_pkgnum {
3754 my( $self, $pkgnum ) = @_;
3755 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3756 sort { $a->_date <=> $b->_date }
3757 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3758 'pkgnum' => $pkgnum,
3765 Returns all the payments (see L<FS::cust_pay>) for this customer.
3771 return $self->num_cust_pay unless wantarray;
3772 sort { $a->_date <=> $b->_date }
3773 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3778 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3779 called automatically when the cust_pay method is used in a scalar context.
3785 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3786 my $sth = dbh->prepare($sql) or die dbh->errstr;
3787 $sth->execute($self->custnum) or die $sth->errstr;
3788 $sth->fetchrow_arrayref->[0];
3791 =item cust_pay_pkgnum
3793 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3794 package when using experimental package balances.
3798 sub cust_pay_pkgnum {
3799 my( $self, $pkgnum ) = @_;
3800 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3801 sort { $a->_date <=> $b->_date }
3802 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3803 'pkgnum' => $pkgnum,
3810 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3816 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3817 sort { $a->_date <=> $b->_date }
3818 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3821 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3823 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3825 Optionally, a list or hashref of additional arguments to the qsearch call can
3830 sub cust_pay_batch {
3832 my $opt = ref($_[0]) ? shift : { @_ };
3834 #return $self->num_cust_statement unless wantarray || keys %$opt;
3836 $opt->{'table'} = 'cust_pay_batch';
3837 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3838 $opt->{'hashref'}{'custnum'} = $self->custnum;
3839 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3841 map { $_ } #behavior of sort undefined in scalar context
3842 sort { $a->paybatchnum <=> $b->paybatchnum }
3846 =item cust_pay_pending
3848 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3849 (without status "done").
3853 sub cust_pay_pending {
3855 return $self->num_cust_pay_pending unless wantarray;
3856 sort { $a->_date <=> $b->_date }
3857 qsearch( 'cust_pay_pending', {
3858 'custnum' => $self->custnum,
3859 'status' => { op=>'!=', value=>'done' },
3864 =item cust_pay_pending_attempt
3866 Returns all payment attempts / declined payments for this customer, as pending
3867 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3868 a corresponding payment (see L<FS::cust_pay>).
3872 sub cust_pay_pending_attempt {
3874 return $self->num_cust_pay_pending_attempt unless wantarray;
3875 sort { $a->_date <=> $b->_date }
3876 qsearch( 'cust_pay_pending', {
3877 'custnum' => $self->custnum,
3884 =item num_cust_pay_pending
3886 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3887 customer (without status "done"). Also called automatically when the
3888 cust_pay_pending method is used in a scalar context.
3892 sub num_cust_pay_pending {
3895 " SELECT COUNT(*) FROM cust_pay_pending ".
3896 " WHERE custnum = ? AND status != 'done' ",
3901 =item num_cust_pay_pending_attempt
3903 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3904 customer, with status "done" but without a corresp. Also called automatically when the
3905 cust_pay_pending method is used in a scalar context.
3909 sub num_cust_pay_pending_attempt {
3912 " SELECT COUNT(*) FROM cust_pay_pending ".
3913 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3920 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3926 map { $_ } #return $self->num_cust_refund unless wantarray;
3927 sort { $a->_date <=> $b->_date }
3928 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3931 =item display_custnum
3933 Returns the displayed customer number for this customer: agent_custid if
3934 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3938 sub display_custnum {
3941 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3942 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3943 if ( $special eq 'CoStAg' ) {
3944 $prefix = uc( join('',
3946 ($self->state =~ /^(..)/),
3947 $prefix || ($self->agent->agent =~ /^(..)/)
3950 elsif ( $special eq 'CoStCl' ) {
3951 $prefix = uc( join('',
3953 ($self->state =~ /^(..)/),
3954 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3957 # add any others here if needed
3960 my $length = $conf->config('cust_main-custnum-display_length');
3961 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3962 return $self->agent_custid;
3963 } elsif ( $prefix ) {
3964 $length = 8 if !defined($length);
3966 sprintf('%0'.$length.'d', $self->custnum)
3967 } elsif ( $length ) {
3968 return sprintf('%0'.$length.'d', $self->custnum);
3970 return $self->custnum;
3976 Returns a name string for this customer, either "Company (Last, First)" or
3983 my $name = $self->contact;
3984 $name = $self->company. " ($name)" if $self->company;
3990 Returns a name string for this (service/shipping) contact, either
3991 "Company (Last, First)" or "Last, First".
3997 if ( $self->get('ship_last') ) {
3998 my $name = $self->ship_contact;
3999 $name = $self->ship_company. " ($name)" if $self->ship_company;
4008 Returns a name string for this customer, either "Company" or "First Last".
4014 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4017 =item ship_name_short
4019 Returns a name string for this (service/shipping) contact, either "Company"
4024 sub ship_name_short {
4026 if ( $self->get('ship_last') ) {
4027 $self->ship_company !~ /^\s*$/
4028 ? $self->ship_company
4029 : $self->ship_contact_firstlast;
4031 $self->name_company_or_firstlast;
4037 Returns this customer's full (billing) contact name only, "Last, First"
4043 $self->get('last'). ', '. $self->first;
4048 Returns this customer's full (shipping) contact name only, "Last, First"
4054 $self->get('ship_last')
4055 ? $self->get('ship_last'). ', '. $self->ship_first
4059 =item contact_firstlast
4061 Returns this customers full (billing) contact name only, "First Last".
4065 sub contact_firstlast {
4067 $self->first. ' '. $self->get('last');
4070 =item ship_contact_firstlast
4072 Returns this customer's full (shipping) contact name only, "First Last".
4076 sub ship_contact_firstlast {
4078 $self->get('ship_last')
4079 ? $self->first. ' '. $self->get('ship_last')
4080 : $self->contact_firstlast;
4085 Returns this customer's full country name
4091 code2country($self->country);
4094 =item geocode DATA_VENDOR
4096 Returns a value for the customer location as encoded by DATA_VENDOR.
4097 Currently this only makes sense for "CCH" as DATA_VENDOR.
4105 Returns a status string for this customer, currently:
4109 =item prospect - No packages have ever been ordered
4111 =item ordered - Recurring packages all are new (not yet billed).
4113 =item active - One or more recurring packages is active
4115 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4117 =item suspended - All non-cancelled recurring packages are suspended
4119 =item cancelled - All recurring packages are cancelled
4123 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4124 cust_main-status_module configuration option.
4128 sub status { shift->cust_status(@_); }
4132 for my $status ( FS::cust_main->statuses() ) {
4133 my $method = $status.'_sql';
4134 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4135 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4136 $sth->execute( ($self->custnum) x $numnum )
4137 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4138 return $status if $sth->fetchrow_arrayref->[0];
4142 =item ucfirst_cust_status
4144 =item ucfirst_status
4146 Returns the status with the first character capitalized.
4150 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4152 sub ucfirst_cust_status {
4154 ucfirst($self->cust_status);
4159 Returns a hex triplet color string for this customer's status.
4163 sub statuscolor { shift->cust_statuscolor(@_); }
4165 sub cust_statuscolor {
4167 __PACKAGE__->statuscolors->{$self->cust_status};
4172 Returns an array of hashes representing the customer's RT tickets.
4179 my $num = $conf->config('cust_main-max_tickets') || 10;
4182 if ( $conf->config('ticket_system') ) {
4183 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4185 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4189 foreach my $priority (
4190 $conf->config('ticket_system-custom_priority_field-values'), ''
4192 last if scalar(@tickets) >= $num;
4194 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4195 $num - scalar(@tickets),
4205 # Return services representing svc_accts in customer support packages
4206 sub support_services {
4208 my %packages = map { $_ => 1 } $conf->config('support_packages');
4210 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4211 grep { $_->part_svc->svcdb eq 'svc_acct' }
4212 map { $_->cust_svc }
4213 grep { exists $packages{ $_->pkgpart } }
4214 $self->ncancelled_pkgs;
4218 # Return a list of latitude/longitude for one of the services (if any)
4219 sub service_coordinates {
4223 grep { $_->latitude && $_->longitude }
4225 map { $_->cust_svc }
4226 $self->ncancelled_pkgs;
4228 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4233 Returns a masked version of the named field
4238 my ($self,$field) = @_;
4242 'x'x(length($self->getfield($field))-4).
4243 substr($self->getfield($field), (length($self->getfield($field))-4));
4249 =head1 CLASS METHODS
4255 Class method that returns the list of possible status strings for customers
4256 (see L<the status method|/status>). For example:
4258 @statuses = FS::cust_main->statuses();
4264 keys %{ $self->statuscolors };
4267 =item cust_status_sql
4269 Returns an SQL fragment to determine the status of a cust_main record, as a
4274 sub cust_status_sql {
4276 for my $status ( FS::cust_main->statuses() ) {
4277 my $method = $status.'_sql';
4278 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4287 Returns an SQL expression identifying prospective cust_main records (customers
4288 with no packages ever ordered)
4292 use vars qw($select_count_pkgs);
4293 $select_count_pkgs =
4294 "SELECT COUNT(*) FROM cust_pkg
4295 WHERE cust_pkg.custnum = cust_main.custnum";
4297 sub select_count_pkgs_sql {
4302 " 0 = ( $select_count_pkgs ) ";
4307 Returns an SQL expression identifying ordered cust_main records (customers with
4308 no active packages, but recurring packages not yet setup or one time charges
4314 FS::cust_main->none_active_sql.
4315 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4320 Returns an SQL expression identifying active cust_main records (customers with
4321 active recurring packages).
4326 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4329 =item none_active_sql
4331 Returns an SQL expression identifying cust_main records with no active
4332 recurring packages. This includes customers of status prospect, ordered,
4333 inactive, and suspended.
4337 sub none_active_sql {
4338 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4343 Returns an SQL expression identifying inactive cust_main records (customers with
4344 no active recurring packages, but otherwise unsuspended/uncancelled).
4349 FS::cust_main->none_active_sql.
4350 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4356 Returns an SQL expression identifying suspended cust_main records.
4361 sub suspended_sql { susp_sql(@_); }
4363 FS::cust_main->none_active_sql.
4364 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4370 Returns an SQL expression identifying cancelled cust_main records.
4374 sub cancel_sql { shift->cancelled_sql(@_); }
4377 =item uncancelled_sql
4379 Returns an SQL expression identifying un-cancelled cust_main records.
4383 sub uncancelled_sql { uncancel_sql(@_); }
4384 sub uncancel_sql { "
4385 ( 0 < ( $select_count_pkgs
4386 AND ( cust_pkg.cancel IS NULL
4387 OR cust_pkg.cancel = 0
4390 OR 0 = ( $select_count_pkgs )
4396 Returns an SQL fragment to retreive the balance.
4401 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4402 WHERE cust_bill.custnum = cust_main.custnum )
4403 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4404 WHERE cust_pay.custnum = cust_main.custnum )
4405 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4406 WHERE cust_credit.custnum = cust_main.custnum )
4407 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4408 WHERE cust_refund.custnum = cust_main.custnum )
4411 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4413 Returns an SQL fragment to retreive the balance for this customer, optionally
4414 considering invoices with date earlier than START_TIME, and not
4415 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4416 total_unapplied_payments).
4418 Times are specified as SQL fragments or numeric
4419 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4420 L<Date::Parse> for conversion functions. The empty string can be passed
4421 to disable that time constraint completely.
4423 Available options are:
4427 =item unapplied_date
4429 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)
4434 set to true to remove all customer comparison clauses, for totals
4439 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4444 JOIN clause (typically used with the total option)
4448 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4449 time will be ignored. Note that START_TIME and END_TIME only limit the date
4450 range for invoices and I<unapplied> payments, credits, and refunds.
4456 sub balance_date_sql {
4457 my( $class, $start, $end, %opt ) = @_;
4459 my $cutoff = $opt{'cutoff'};
4461 my $owed = FS::cust_bill->owed_sql($cutoff);
4462 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4463 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4464 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4466 my $j = $opt{'join'} || '';
4468 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4469 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4470 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4471 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4473 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4474 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4475 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4476 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4481 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4483 Returns an SQL fragment to retreive the total unapplied payments for this
4484 customer, only considering payments with date earlier than START_TIME, and
4485 optionally not later than END_TIME.
4487 Times are specified as SQL fragments or numeric
4488 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4489 L<Date::Parse> for conversion functions. The empty string can be passed
4490 to disable that time constraint completely.
4492 Available options are:
4496 sub unapplied_payments_date_sql {
4497 my( $class, $start, $end, %opt ) = @_;
4499 my $cutoff = $opt{'cutoff'};
4501 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4503 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4504 'unapplied_date'=>1 );
4506 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4509 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4511 Helper method for balance_date_sql; name (and usage) subject to change
4512 (suggestions welcome).
4514 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4515 cust_refund, cust_credit or cust_pay).
4517 If TABLE is "cust_bill" or the unapplied_date option is true, only
4518 considers records with date earlier than START_TIME, and optionally not
4519 later than END_TIME .
4523 sub _money_table_where {
4524 my( $class, $table, $start, $end, %opt ) = @_;
4527 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4528 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4529 push @where, "$table._date <= $start" if defined($start) && length($start);
4530 push @where, "$table._date > $end" if defined($end) && length($end);
4532 push @where, @{$opt{'where'}} if $opt{'where'};
4533 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4539 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4540 use FS::cust_main::Search;
4543 FS::cust_main::Search->search(@_);
4558 #warn join('-',keys %$param);
4559 my $fh = $param->{filehandle};
4560 my $agentnum = $param->{agentnum};
4561 my $format = $param->{format};
4563 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4566 if ( $format eq 'simple' ) {
4567 @fields = qw( custnum agent_custid amount pkg );
4569 die "unknown format $format";
4572 eval "use Text::CSV_XS;";
4575 my $csv = new Text::CSV_XS;
4582 local $SIG{HUP} = 'IGNORE';
4583 local $SIG{INT} = 'IGNORE';
4584 local $SIG{QUIT} = 'IGNORE';
4585 local $SIG{TERM} = 'IGNORE';
4586 local $SIG{TSTP} = 'IGNORE';
4587 local $SIG{PIPE} = 'IGNORE';
4589 my $oldAutoCommit = $FS::UID::AutoCommit;
4590 local $FS::UID::AutoCommit = 0;
4593 #while ( $columns = $csv->getline($fh) ) {
4595 while ( defined($line=<$fh>) ) {
4597 $csv->parse($line) or do {
4598 $dbh->rollback if $oldAutoCommit;
4599 return "can't parse: ". $csv->error_input();
4602 my @columns = $csv->fields();
4603 #warn join('-',@columns);
4606 foreach my $field ( @fields ) {
4607 $row{$field} = shift @columns;
4610 if ( $row{custnum} && $row{agent_custid} ) {
4611 dbh->rollback if $oldAutoCommit;
4612 return "can't specify custnum with agent_custid $row{agent_custid}";
4616 if ( $row{agent_custid} && $agentnum ) {
4617 %hash = ( 'agent_custid' => $row{agent_custid},
4618 'agentnum' => $agentnum,
4622 if ( $row{custnum} ) {
4623 %hash = ( 'custnum' => $row{custnum} );
4626 unless ( scalar(keys %hash) ) {
4627 $dbh->rollback if $oldAutoCommit;
4628 return "can't find customer without custnum or agent_custid and agentnum";
4631 my $cust_main = qsearchs('cust_main', { %hash } );
4632 unless ( $cust_main ) {
4633 $dbh->rollback if $oldAutoCommit;
4634 my $custnum = $row{custnum} || $row{agent_custid};
4635 return "unknown custnum $custnum";
4638 if ( $row{'amount'} > 0 ) {
4639 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4641 $dbh->rollback if $oldAutoCommit;
4645 } elsif ( $row{'amount'} < 0 ) {
4646 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4649 $dbh->rollback if $oldAutoCommit;
4659 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4661 return "Empty file!" unless $imported;
4667 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4669 Deprecated. Use event notification and message templates
4670 (L<FS::msg_template>) instead.
4672 Sends a templated email notification to the customer (see L<Text::Template>).
4674 OPTIONS is a hash and may include
4676 I<from> - the email sender (default is invoice_from)
4678 I<to> - comma-separated scalar or arrayref of recipients
4679 (default is invoicing_list)
4681 I<subject> - The subject line of the sent email notification
4682 (default is "Notice from company_name")
4684 I<extra_fields> - a hashref of name/value pairs which will be substituted
4687 The following variables are vavailable in the template.
4689 I<$first> - the customer first name
4690 I<$last> - the customer last name
4691 I<$company> - the customer company
4692 I<$payby> - a description of the method of payment for the customer
4693 # would be nice to use FS::payby::shortname
4694 I<$payinfo> - the account information used to collect for this customer
4695 I<$expdate> - the expiration of the customer payment in seconds from epoch
4700 my ($self, $template, %options) = @_;
4702 return unless $conf->exists($template);
4704 my $from = $conf->config('invoice_from', $self->agentnum)
4705 if $conf->exists('invoice_from', $self->agentnum);
4706 $from = $options{from} if exists($options{from});
4708 my $to = join(',', $self->invoicing_list_emailonly);
4709 $to = $options{to} if exists($options{to});
4711 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4712 if $conf->exists('company_name', $self->agentnum);
4713 $subject = $options{subject} if exists($options{subject});
4715 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4716 SOURCE => [ map "$_\n",
4717 $conf->config($template)]
4719 or die "can't create new Text::Template object: Text::Template::ERROR";
4720 $notify_template->compile()
4721 or die "can't compile template: Text::Template::ERROR";
4723 $FS::notify_template::_template::company_name =
4724 $conf->config('company_name', $self->agentnum);
4725 $FS::notify_template::_template::company_address =
4726 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4728 my $paydate = $self->paydate || '2037-12-31';
4729 $FS::notify_template::_template::first = $self->first;
4730 $FS::notify_template::_template::last = $self->last;
4731 $FS::notify_template::_template::company = $self->company;
4732 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4733 my $payby = $self->payby;
4734 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4735 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4737 #credit cards expire at the end of the month/year of their exp date
4738 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4739 $FS::notify_template::_template::payby = 'credit card';
4740 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4741 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4743 }elsif ($payby eq 'COMP') {
4744 $FS::notify_template::_template::payby = 'complimentary account';
4746 $FS::notify_template::_template::payby = 'current method';
4748 $FS::notify_template::_template::expdate = $expire_time;
4750 for (keys %{$options{extra_fields}}){
4752 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4755 send_email(from => $from,
4757 subject => $subject,
4758 body => $notify_template->fill_in( PACKAGE =>
4759 'FS::notify_template::_template' ),
4764 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4766 Generates a templated notification to the customer (see L<Text::Template>).
4768 OPTIONS is a hash and may include
4770 I<extra_fields> - a hashref of name/value pairs which will be substituted
4771 into the template. These values may override values mentioned below
4772 and those from the customer record.
4774 The following variables are available in the template instead of or in addition
4775 to the fields of the customer record.
4777 I<$payby> - a description of the method of payment for the customer
4778 # would be nice to use FS::payby::shortname
4779 I<$payinfo> - the masked account information used to collect for this customer
4780 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4781 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4785 # a lot like cust_bill::print_latex
4786 sub generate_letter {
4787 my ($self, $template, %options) = @_;
4789 return unless $conf->exists($template);
4791 my $letter_template = new Text::Template
4793 SOURCE => [ map "$_\n", $conf->config($template)],
4794 DELIMITERS => [ '[@--', '--@]' ],
4796 or die "can't create new Text::Template object: Text::Template::ERROR";
4798 $letter_template->compile()
4799 or die "can't compile template: Text::Template::ERROR";
4801 my %letter_data = map { $_ => $self->$_ } $self->fields;
4802 $letter_data{payinfo} = $self->mask_payinfo;
4804 #my $paydate = $self->paydate || '2037-12-31';
4805 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4807 my $payby = $self->payby;
4808 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4809 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4811 #credit cards expire at the end of the month/year of their exp date
4812 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4813 $letter_data{payby} = 'credit card';
4814 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4815 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4817 }elsif ($payby eq 'COMP') {
4818 $letter_data{payby} = 'complimentary account';
4820 $letter_data{payby} = 'current method';
4822 $letter_data{expdate} = $expire_time;
4824 for (keys %{$options{extra_fields}}){
4825 $letter_data{$_} = $options{extra_fields}->{$_};
4828 unless(exists($letter_data{returnaddress})){
4829 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4830 $self->agent_template)
4832 if ( length($retadd) ) {
4833 $letter_data{returnaddress} = $retadd;
4834 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4835 $letter_data{returnaddress} =
4836 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4840 ( $conf->config('company_name', $self->agentnum),
4841 $conf->config('company_address', $self->agentnum),
4845 $letter_data{returnaddress} = '~';
4849 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4851 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4853 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4855 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4859 ) or die "can't open temp file: $!\n";
4860 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4861 or die "can't write temp file: $!\n";
4863 $letter_data{'logo_file'} = $lh->filename;
4865 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4869 ) or die "can't open temp file: $!\n";
4871 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4873 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4874 return ($1, $letter_data{'logo_file'});
4878 =item print_ps TEMPLATE
4880 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4886 my($file, $lfile) = $self->generate_letter(@_);
4887 my $ps = FS::Misc::generate_ps($file);
4888 unlink($file.'.tex');
4894 =item print TEMPLATE
4896 Prints the filled in template.
4898 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4902 sub queueable_print {
4905 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4906 or die "invalid customer number: " . $opt{custvnum};
4908 my $error = $self->print( $opt{template} );
4909 die $error if $error;
4913 my ($self, $template) = (shift, shift);
4914 do_print [ $self->print_ps($template) ];
4917 #these three subs should just go away once agent stuff is all config overrides
4919 sub agent_template {
4921 $self->_agent_plandata('agent_templatename');
4924 sub agent_invoice_from {
4926 $self->_agent_plandata('agent_invoice_from');
4929 sub _agent_plandata {
4930 my( $self, $option ) = @_;
4932 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4933 #agent-specific Conf
4935 use FS::part_event::Condition;
4937 my $agentnum = $self->agentnum;
4939 my $regexp = regexp_sql();
4941 my $part_event_option =
4943 'select' => 'part_event_option.*',
4944 'table' => 'part_event_option',
4946 LEFT JOIN part_event USING ( eventpart )
4947 LEFT JOIN part_event_option AS peo_agentnum
4948 ON ( part_event.eventpart = peo_agentnum.eventpart
4949 AND peo_agentnum.optionname = 'agentnum'
4950 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4952 LEFT JOIN part_event_condition
4953 ON ( part_event.eventpart = part_event_condition.eventpart
4954 AND part_event_condition.conditionname = 'cust_bill_age'
4956 LEFT JOIN part_event_condition_option
4957 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4958 AND part_event_condition_option.optionname = 'age'
4961 #'hashref' => { 'optionname' => $option },
4962 #'hashref' => { 'part_event_option.optionname' => $option },
4964 " WHERE part_event_option.optionname = ". dbh->quote($option).
4965 " AND action = 'cust_bill_send_agent' ".
4966 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4967 " AND peo_agentnum.optionname = 'agentnum' ".
4968 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4970 CASE WHEN part_event_condition_option.optionname IS NULL
4972 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4974 , part_event.weight".
4978 unless ( $part_event_option ) {
4979 return $self->agent->invoice_template || ''
4980 if $option eq 'agent_templatename';
4984 $part_event_option->optionvalue;
4988 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4990 Subroutine (not a method), designed to be called from the queue.
4992 Takes a list of options and values.
4994 Pulls up the customer record via the custnum option and calls bill_and_collect.
4999 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5001 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5002 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5004 $cust_main->bill_and_collect( %args );
5007 sub process_bill_and_collect {
5009 my $param = thaw(decode_base64(shift));
5010 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5011 or die "custnum '$param->{custnum}' not found!\n";
5012 $param->{'job'} = $job;
5013 $param->{'fatal'} = 1; # runs from job queue, will be caught
5014 $param->{'retry'} = 1;
5016 $cust_main->bill_and_collect( %$param );
5019 =item process_censustract_update CUSTNUM
5021 Queueable function to update the census tract to the current year (as set in
5022 the 'census_year' configuration variable) and retrieve the new tract code.
5026 sub process_censustract_update {
5027 eval "use FS::Misc::Geo qw(get_censustract)";
5029 my $custnum = shift;
5030 my $cust_main = qsearchs( 'cust_main', { custnum => $custnum })
5031 or die "custnum '$custnum' not found!\n";
5033 my $new_year = $conf->config('census_year') or return;
5034 my $new_tract = get_censustract({ $cust_main->location_hash }, $new_year);
5035 if ( $new_tract =~ /^\d/ ) {
5036 # then it's a tract code
5037 $cust_main->set('censustract', $new_tract);
5038 $cust_main->set('censusyear', $new_year);
5040 local($ignore_expired_card) = 1;
5041 local($ignore_illegal_zip) = 1;
5042 local($ignore_banned_card) = 1;
5043 local($skip_fuzzyfiles) = 1;
5044 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5045 my $error = $cust_main->replace;
5046 die $error if $error;
5049 # it's an error message
5055 sub _upgrade_data { #class method
5056 my ($class, %opts) = @_;
5059 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5060 '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',
5062 # fix yyyy-m-dd formatted paydates
5063 if ( driver_name =~ /^mysql/i ) {
5065 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5067 else { # the SQL standard
5069 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5072 push @statements, #fix the weird BILL with a cc# in payinfo problem
5074 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5076 foreach my $sql ( @statements ) {
5077 my $sth = dbh->prepare($sql) or die dbh->errstr;
5078 $sth->execute or die $sth->errstr;
5081 local($ignore_expired_card) = 1;
5082 local($ignore_illegal_zip) = 1;
5083 local($ignore_banned_card) = 1;
5084 local($skip_fuzzyfiles) = 1;
5085 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5086 $class->_upgrade_otaker(%opts);
5096 The delete method should possibly take an FS::cust_main object reference
5097 instead of a scalar customer number.
5099 Bill and collect options should probably be passed as references instead of a
5102 There should probably be a configuration file with a list of allowed credit
5105 No multiple currency support (probably a larger project than just this module).
5107 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5109 Birthdates rely on negative epoch values.
5111 The payby for card/check batches is broken. With mixed batching, bad
5114 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5118 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5119 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5120 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.