5 use base qw( FS::cust_main::Packages FS::cust_main::Status
6 FS::cust_main::NationalID
7 FS::cust_main::Billing FS::cust_main::Billing_Realtime
8 FS::cust_main::Billing_Discount
9 FS::cust_main::Billing_ThirdParty
10 FS::cust_main::Location
11 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
12 FS::geocode_Mixin FS::Quotable_Mixin
16 use vars qw( $DEBUG $me $conf
19 $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
24 use Scalar::Util qw( blessed );
25 use Time::Local qw(timelocal);
26 use Storable qw(thaw);
30 use Digest::MD5 qw(md5_base64);
33 use File::Temp; #qw( tempfile );
34 use Business::CreditCard 0.28;
36 use FS::UID qw( dbh driver_name );
37 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
38 use FS::Misc qw( generate_email send_email generate_ps do_print );
39 use FS::Msgcat qw(gettext);
46 use FS::cust_bill_void;
47 use FS::legacy_cust_bill;
49 use FS::cust_pay_pending;
50 use FS::cust_pay_void;
51 use FS::cust_pay_batch;
54 use FS::part_referral;
55 use FS::cust_main_county;
56 use FS::cust_location;
58 use FS::cust_main_exemption;
59 use FS::cust_tax_adjustment;
60 use FS::cust_tax_location;
62 use FS::agent_currency;
63 use FS::cust_main_invoice;
65 use FS::prepay_credit;
71 use FS::payment_gateway;
72 use FS::agent_payment_gateway;
74 use FS::cust_main_note;
75 use FS::cust_attachment;
78 use FS::upgrade_journal;
81 # 1 is mostly method/subroutine entry and options
82 # 2 traces progress of some operations
83 # 3 is even more information including possibly sensitive data
85 $me = '[FS::cust_main]';
88 $ignore_expired_card = 0;
89 $ignore_banned_card = 0;
93 @encrypted_fields = ('payinfo', 'paycvv');
94 sub nohistory_fields { ('payinfo', 'paycvv'); }
96 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
98 #ask FS::UID to run this stuff for us later
99 #$FS::UID::callback{'FS::cust_main'} = sub {
100 install_callback FS::UID sub {
101 $conf = new FS::Conf;
102 #yes, need it for stuff below (prolly should be cached)
107 my ( $hashref, $cache ) = @_;
108 if ( exists $hashref->{'pkgnum'} ) {
109 #@{ $self->{'_pkgnum'} } = ();
110 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
111 $self->{'_pkgnum'} = $subcache;
112 #push @{ $self->{'_pkgnum'} },
113 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
119 FS::cust_main - Object methods for cust_main records
125 $record = new FS::cust_main \%hash;
126 $record = new FS::cust_main { 'column' => 'value' };
128 $error = $record->insert;
130 $error = $new_record->replace($old_record);
132 $error = $record->delete;
134 $error = $record->check;
136 @cust_pkg = $record->all_pkgs;
138 @cust_pkg = $record->ncancelled_pkgs;
140 @cust_pkg = $record->suspended_pkgs;
142 $error = $record->bill;
143 $error = $record->bill %options;
144 $error = $record->bill 'time' => $time;
146 $error = $record->collect;
147 $error = $record->collect %options;
148 $error = $record->collect 'invoice_time' => $time,
153 An FS::cust_main object represents a customer. FS::cust_main inherits from
154 FS::Record. The following fields are currently supported:
160 Primary key (assigned automatically for new customers)
164 Agent (see L<FS::agent>)
168 Advertising source (see L<FS::part_referral>)
180 Cocial security number (optional)
204 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
208 Payment Information (See L<FS::payinfo_Mixin> for data format)
212 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
216 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
220 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
224 Start date month (maestro/solo cards only)
228 Start date year (maestro/solo cards only)
232 Issue number (maestro/solo cards only)
236 Name on card or billing name
240 IP address from which payment information was received
244 Tax exempt, empty or `Y'
248 Order taker (see L<FS::access_user>)
254 =item referral_custnum
256 Referring customer number
260 Enable individual CDR spooling, empty or `Y'
264 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
268 Discourage individual CDR printing, empty or `Y'
272 Allow self-service editing of ticket subjects, empty or 'Y'
274 =item calling_list_exempt
276 Do not call, empty or 'Y'
286 Creates a new customer. To add the customer to the database, see L<"insert">.
288 Note that this stores the hash reference, not a distinct copy of the hash it
289 points to. You can ask the object for a copy with the I<hash> method.
293 sub table { 'cust_main'; }
295 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
297 Adds this customer to the database. If there is an error, returns the error,
298 otherwise returns false.
300 Usually the customer's location will not yet exist in the database, and
301 the C<bill_location> and C<ship_location> pseudo-fields must be set to
302 uninserted L<FS::cust_location> objects. These will be inserted and linked
303 (in both directions) to the new customer record. If they're references
304 to the same object, they will become the same location.
306 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
307 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
308 are inserted atomicly, or the transaction is rolled back. Passing an empty
309 hash reference is equivalent to not supplying this parameter. There should be
310 a better explanation of this, but until then, here's an example:
313 tie %hash, 'Tie::RefHash'; #this part is important
315 $cust_pkg => [ $svc_acct ],
318 $cust_main->insert( \%hash );
320 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
321 be set as the invoicing list (see L<"invoicing_list">). Errors return as
322 expected and rollback the entire transaction; it is not necessary to call
323 check_invoicing_list first. The invoicing_list is set after the records in the
324 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
325 invoicing_list destination to the newly-created svc_acct. Here's an example:
327 $cust_main->insert( {}, [ $email, 'POST' ] );
329 Currently available options are: I<depend_jobnum>, I<noexport>,
330 I<tax_exemption> and I<prospectnum>.
332 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
333 on the supplied jobnum (they will not run until the specific job completes).
334 This can be used to defer provisioning until some action completes (such
335 as running the customer's credit card successfully).
337 The I<noexport> option is deprecated. If I<noexport> is set true, no
338 provisioning jobs (exports) are scheduled. (You can schedule them later with
339 the B<reexport> method.)
341 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
342 of tax names and exemption numbers. FS::cust_main_exemption records will be
343 created and inserted.
345 If I<prospectnum> is set, moves contacts and locations from that prospect.
351 my $cust_pkgs = @_ ? shift : {};
352 my $invoicing_list = @_ ? shift : '';
354 warn "$me insert called with options ".
355 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
358 local $SIG{HUP} = 'IGNORE';
359 local $SIG{INT} = 'IGNORE';
360 local $SIG{QUIT} = 'IGNORE';
361 local $SIG{TERM} = 'IGNORE';
362 local $SIG{TSTP} = 'IGNORE';
363 local $SIG{PIPE} = 'IGNORE';
365 my $oldAutoCommit = $FS::UID::AutoCommit;
366 local $FS::UID::AutoCommit = 0;
369 my $prepay_identifier = '';
370 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
372 if ( $self->payby eq 'PREPAY' ) {
374 $self->payby('BILL');
375 $prepay_identifier = $self->payinfo;
378 warn " looking up prepaid card $prepay_identifier\n"
381 my $error = $self->get_prepay( $prepay_identifier,
382 'amount_ref' => \$amount,
383 'seconds_ref' => \$seconds,
384 'upbytes_ref' => \$upbytes,
385 'downbytes_ref' => \$downbytes,
386 'totalbytes_ref' => \$totalbytes,
389 $dbh->rollback if $oldAutoCommit;
390 #return "error applying prepaid card (transaction rolled back): $error";
394 $payby = 'PREP' if $amount;
396 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|PPAL)$/ ) {
399 $self->payby('BILL');
400 $amount = $self->paid;
405 foreach my $l (qw(bill_location ship_location)) {
406 my $loc = delete $self->hashref->{$l};
407 # XXX if we're moving a prospect's locations, do that here
412 if ( !$loc->locationnum ) {
413 # warn the location that we're going to insert it with no custnum
414 $loc->set(custnum_pending => 1);
415 warn " inserting $l\n"
417 my $error = $loc->insert;
419 $dbh->rollback if $oldAutoCommit;
420 my $label = $l eq 'ship_location' ? 'service' : 'billing';
421 return "$error (in $label location)";
424 elsif ( ($loc->custnum || 0) > 0 or $loc->prospectnum ) {
425 # then it somehow belongs to another customer--shouldn't happen
426 $dbh->rollback if $oldAutoCommit;
427 return "$l belongs to customer ".$loc->custnum;
429 # else it already belongs to this customer
430 # (happens when ship_location is identical to bill_location)
432 $self->set($l.'num', $loc->locationnum);
434 if ( $self->get($l.'num') eq '' ) {
435 $dbh->rollback if $oldAutoCommit;
440 warn " inserting $self\n"
443 $self->signupdate(time) unless $self->signupdate;
445 $self->auto_agent_custid()
446 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
448 my $error = $self->SUPER::insert;
450 $dbh->rollback if $oldAutoCommit;
451 #return "inserting cust_main record (transaction rolled back): $error";
455 # now set cust_location.custnum
456 foreach my $l (qw(bill_location ship_location)) {
457 warn " setting $l.custnum\n"
460 unless ( $loc->custnum ) {
461 $loc->set(custnum => $self->custnum);
462 $error ||= $loc->replace;
466 $dbh->rollback if $oldAutoCommit;
467 return "error setting $l custnum: $error";
471 warn " setting invoicing list\n"
474 if ( $invoicing_list ) {
475 $error = $self->check_invoicing_list( $invoicing_list );
477 $dbh->rollback if $oldAutoCommit;
478 #return "checking invoicing_list (transaction rolled back): $error";
481 $self->invoicing_list( $invoicing_list );
484 warn " setting customer tags\n"
487 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
488 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
489 'custnum' => $self->custnum };
490 my $error = $cust_tag->insert;
492 $dbh->rollback if $oldAutoCommit;
497 my $prospectnum = delete $options{'prospectnum'};
498 if ( $prospectnum ) {
500 warn " moving contacts and locations from prospect $prospectnum\n"
504 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
505 unless ( $prospect_main ) {
506 $dbh->rollback if $oldAutoCommit;
507 return "Unknown prospectnum $prospectnum";
509 $prospect_main->custnum($self->custnum);
510 $prospect_main->disabled('Y');
511 my $error = $prospect_main->replace;
513 $dbh->rollback if $oldAutoCommit;
517 my @contact = $prospect_main->contact;
518 my @cust_location = $prospect_main->cust_location;
519 my @qual = $prospect_main->qual;
521 foreach my $r ( @contact, @cust_location, @qual ) {
523 $r->custnum($self->custnum);
524 my $error = $r->replace;
526 $dbh->rollback if $oldAutoCommit;
533 warn " setting cust_main_exemption\n"
536 my $tax_exemption = delete $options{'tax_exemption'};
537 if ( $tax_exemption ) {
539 $tax_exemption = { map { $_ => '' } @$tax_exemption }
540 if ref($tax_exemption) eq 'ARRAY';
542 foreach my $taxname ( keys %$tax_exemption ) {
543 my $cust_main_exemption = new FS::cust_main_exemption {
544 'custnum' => $self->custnum,
545 'taxname' => $taxname,
546 'exempt_number' => $tax_exemption->{$taxname},
548 my $error = $cust_main_exemption->insert;
550 $dbh->rollback if $oldAutoCommit;
551 return "inserting cust_main_exemption (transaction rolled back): $error";
556 warn " ordering packages\n"
559 $error = $self->order_pkgs( $cust_pkgs,
561 'seconds_ref' => \$seconds,
562 'upbytes_ref' => \$upbytes,
563 'downbytes_ref' => \$downbytes,
564 'totalbytes_ref' => \$totalbytes,
567 $dbh->rollback if $oldAutoCommit;
572 $dbh->rollback if $oldAutoCommit;
573 return "No svc_acct record to apply pre-paid time";
575 if ( $upbytes || $downbytes || $totalbytes ) {
576 $dbh->rollback if $oldAutoCommit;
577 return "No svc_acct record to apply pre-paid data";
581 warn " inserting initial $payby payment of $amount\n"
583 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
585 $dbh->rollback if $oldAutoCommit;
586 return "inserting payment (transaction rolled back): $error";
590 unless ( $import || $skip_fuzzyfiles ) {
591 warn " queueing fuzzyfiles update\n"
593 $error = $self->queue_fuzzyfiles_update;
595 $dbh->rollback if $oldAutoCommit;
596 return "updating fuzzy search cache: $error";
600 # FS::geocode_Mixin::after_insert or something?
601 if ( $conf->config('tax_district_method') and !$import ) {
602 # if anything non-empty, try to look it up
603 my $queue = new FS::queue {
604 'job' => 'FS::geocode_Mixin::process_district_update',
605 'custnum' => $self->custnum,
607 my $error = $queue->insert( ref($self), $self->custnum );
609 $dbh->rollback if $oldAutoCommit;
610 return "queueing tax district update: $error";
615 warn " exporting\n" if $DEBUG > 1;
617 my $export_args = $options{'export_args'} || [];
620 map qsearch( 'part_export', {exportnum=>$_} ),
621 $conf->config('cust_main-exports'); #, $agentnum
623 foreach my $part_export ( @part_export ) {
624 my $error = $part_export->export_insert($self, @$export_args);
626 $dbh->rollback if $oldAutoCommit;
627 return "exporting to ". $part_export->exporttype.
628 " (transaction rolled back): $error";
632 #foreach my $depend_jobnum ( @$depend_jobnums ) {
633 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
635 # foreach my $jobnum ( @jobnums ) {
636 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
637 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
639 # my $error = $queue->depend_insert($depend_jobnum);
641 # $dbh->rollback if $oldAutoCommit;
642 # return "error queuing job dependancy: $error";
649 #if ( exists $options{'jobnums'} ) {
650 # push @{ $options{'jobnums'} }, @jobnums;
653 warn " insert complete; committing transaction\n"
656 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
661 use File::CounterFile;
662 sub auto_agent_custid {
665 my $format = $conf->config('cust_main-auto_agent_custid');
667 if ( $format eq '1YMMXXXXXXXX' ) {
669 my $counter = new File::CounterFile 'cust_main.agent_custid';
672 my $ym = 100000000000 + time2str('%y%m00000000', time);
673 if ( $ym > $counter->value ) {
674 $counter->{'value'} = $agent_custid = $ym;
675 $counter->{'updated'} = 1;
677 $agent_custid = $counter->inc;
683 die "Unknown cust_main-auto_agent_custid format: $format";
686 $self->agent_custid($agent_custid);
690 =item PACKAGE METHODS
692 Documentation on customer package methods has been moved to
693 L<FS::cust_main::Packages>.
695 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
697 Recharges this (existing) customer with the specified prepaid card (see
698 L<FS::prepay_credit>), specified either by I<identifier> or as an
699 FS::prepay_credit object. If there is an error, returns the error, otherwise
702 Optionally, five scalar references can be passed as well. They will have their
703 values filled in with the amount, number of seconds, and number of upload,
704 download, and total bytes applied by this prepaid card.
708 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
709 #the only place that uses these args
710 sub recharge_prepay {
711 my( $self, $prepay_credit, $amountref, $secondsref,
712 $upbytesref, $downbytesref, $totalbytesref ) = @_;
714 local $SIG{HUP} = 'IGNORE';
715 local $SIG{INT} = 'IGNORE';
716 local $SIG{QUIT} = 'IGNORE';
717 local $SIG{TERM} = 'IGNORE';
718 local $SIG{TSTP} = 'IGNORE';
719 local $SIG{PIPE} = 'IGNORE';
721 my $oldAutoCommit = $FS::UID::AutoCommit;
722 local $FS::UID::AutoCommit = 0;
725 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
727 my $error = $self->get_prepay( $prepay_credit,
728 'amount_ref' => \$amount,
729 'seconds_ref' => \$seconds,
730 'upbytes_ref' => \$upbytes,
731 'downbytes_ref' => \$downbytes,
732 'totalbytes_ref' => \$totalbytes,
734 || $self->increment_seconds($seconds)
735 || $self->increment_upbytes($upbytes)
736 || $self->increment_downbytes($downbytes)
737 || $self->increment_totalbytes($totalbytes)
738 || $self->insert_cust_pay_prepay( $amount,
740 ? $prepay_credit->identifier
745 $dbh->rollback if $oldAutoCommit;
749 if ( defined($amountref) ) { $$amountref = $amount; }
750 if ( defined($secondsref) ) { $$secondsref = $seconds; }
751 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
752 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
753 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
755 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
760 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
762 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
763 specified either by I<identifier> or as an FS::prepay_credit object.
765 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
766 incremented by the values of the prepaid card.
768 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
769 check or set this customer's I<agentnum>.
771 If there is an error, returns the error, otherwise returns false.
777 my( $self, $prepay_credit, %opt ) = @_;
779 local $SIG{HUP} = 'IGNORE';
780 local $SIG{INT} = 'IGNORE';
781 local $SIG{QUIT} = 'IGNORE';
782 local $SIG{TERM} = 'IGNORE';
783 local $SIG{TSTP} = 'IGNORE';
784 local $SIG{PIPE} = 'IGNORE';
786 my $oldAutoCommit = $FS::UID::AutoCommit;
787 local $FS::UID::AutoCommit = 0;
790 unless ( ref($prepay_credit) ) {
792 my $identifier = $prepay_credit;
794 $prepay_credit = qsearchs(
796 { 'identifier' => $identifier },
801 unless ( $prepay_credit ) {
802 $dbh->rollback if $oldAutoCommit;
803 return "Invalid prepaid card: ". $identifier;
808 if ( $prepay_credit->agentnum ) {
809 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
810 $dbh->rollback if $oldAutoCommit;
811 return "prepaid card not valid for agent ". $self->agentnum;
813 $self->agentnum($prepay_credit->agentnum);
816 my $error = $prepay_credit->delete;
818 $dbh->rollback if $oldAutoCommit;
819 return "removing prepay_credit (transaction rolled back): $error";
822 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
823 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
825 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
830 =item increment_upbytes SECONDS
832 Updates this customer's single or primary account (see L<FS::svc_acct>) by
833 the specified number of upbytes. If there is an error, returns the error,
834 otherwise returns false.
838 sub increment_upbytes {
839 _increment_column( shift, 'upbytes', @_);
842 =item increment_downbytes SECONDS
844 Updates this customer's single or primary account (see L<FS::svc_acct>) by
845 the specified number of downbytes. If there is an error, returns the error,
846 otherwise returns false.
850 sub increment_downbytes {
851 _increment_column( shift, 'downbytes', @_);
854 =item increment_totalbytes SECONDS
856 Updates this customer's single or primary account (see L<FS::svc_acct>) by
857 the specified number of totalbytes. If there is an error, returns the error,
858 otherwise returns false.
862 sub increment_totalbytes {
863 _increment_column( shift, 'totalbytes', @_);
866 =item increment_seconds SECONDS
868 Updates this customer's single or primary account (see L<FS::svc_acct>) by
869 the specified number of seconds. If there is an error, returns the error,
870 otherwise returns false.
874 sub increment_seconds {
875 _increment_column( shift, 'seconds', @_);
878 =item _increment_column AMOUNT
880 Updates this customer's single or primary account (see L<FS::svc_acct>) by
881 the specified number of seconds or bytes. If there is an error, returns
882 the error, otherwise returns false.
886 sub _increment_column {
887 my( $self, $column, $amount ) = @_;
888 warn "$me increment_column called: $column, $amount\n"
891 return '' unless $amount;
893 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
894 $self->ncancelled_pkgs;
897 return 'No packages with primary or single services found'.
898 ' to apply pre-paid time';
899 } elsif ( scalar(@cust_pkg) > 1 ) {
900 #maybe have a way to specify the package/account?
901 return 'Multiple packages found to apply pre-paid time';
904 my $cust_pkg = $cust_pkg[0];
905 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
909 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
912 return 'No account found to apply pre-paid time';
913 } elsif ( scalar(@cust_svc) > 1 ) {
914 return 'Multiple accounts found to apply pre-paid time';
917 my $svc_acct = $cust_svc[0]->svc_x;
918 warn " found service svcnum ". $svc_acct->pkgnum.
919 ' ('. $svc_acct->email. ")\n"
922 $column = "increment_$column";
923 $svc_acct->$column($amount);
927 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
929 Inserts a prepayment in the specified amount for this customer. An optional
930 second argument can specify the prepayment identifier for tracking purposes.
931 If there is an error, returns the error, otherwise returns false.
935 sub insert_cust_pay_prepay {
936 shift->insert_cust_pay('PREP', @_);
939 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
941 Inserts a cash payment in the specified amount for this customer. An optional
942 second argument can specify the payment identifier for tracking purposes.
943 If there is an error, returns the error, otherwise returns false.
947 sub insert_cust_pay_cash {
948 shift->insert_cust_pay('CASH', @_);
951 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
953 Inserts a Western Union payment in the specified amount for this customer. An
954 optional second argument can specify the prepayment identifier for tracking
955 purposes. If there is an error, returns the error, otherwise returns false.
959 sub insert_cust_pay_west {
960 shift->insert_cust_pay('WEST', @_);
963 sub insert_cust_pay {
964 my( $self, $payby, $amount ) = splice(@_, 0, 3);
965 my $payinfo = scalar(@_) ? shift : '';
967 my $cust_pay = new FS::cust_pay {
968 'custnum' => $self->custnum,
969 'paid' => sprintf('%.2f', $amount),
970 #'_date' => #date the prepaid card was purchased???
972 'payinfo' => $payinfo,
978 =item delete [ OPTION => VALUE ... ]
980 This deletes the customer. If there is an error, returns the error, otherwise
983 This will completely remove all traces of the customer record. This is not
984 what you want when a customer cancels service; for that, cancel all of the
985 customer's packages (see L</cancel>).
987 If the customer has any uncancelled packages, you need to pass a new (valid)
988 customer number for those packages to be transferred to, as the "new_customer"
989 option. Cancelled packages will be deleted. Did I mention that this is NOT
990 what you want when a customer cancels service and that you really should be
991 looking at L<FS::cust_pkg/cancel>?
993 You can't delete a customer with invoices (see L<FS::cust_bill>),
994 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
995 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
996 set the "delete_financials" option to a true value.
1001 my( $self, %opt ) = @_;
1003 local $SIG{HUP} = 'IGNORE';
1004 local $SIG{INT} = 'IGNORE';
1005 local $SIG{QUIT} = 'IGNORE';
1006 local $SIG{TERM} = 'IGNORE';
1007 local $SIG{TSTP} = 'IGNORE';
1008 local $SIG{PIPE} = 'IGNORE';
1010 my $oldAutoCommit = $FS::UID::AutoCommit;
1011 local $FS::UID::AutoCommit = 0;
1014 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1015 $dbh->rollback if $oldAutoCommit;
1016 return "Can't delete a master agent customer";
1019 #use FS::access_user
1020 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1021 $dbh->rollback if $oldAutoCommit;
1022 return "Can't delete a master employee customer";
1025 tie my %financial_tables, 'Tie::IxHash',
1026 'cust_bill' => 'invoices',
1027 'cust_statement' => 'statements',
1028 'cust_credit' => 'credits',
1029 'cust_pay' => 'payments',
1030 'cust_refund' => 'refunds',
1033 foreach my $table ( keys %financial_tables ) {
1035 my @records = $self->$table();
1037 if ( @records && ! $opt{'delete_financials'} ) {
1038 $dbh->rollback if $oldAutoCommit;
1039 return "Can't delete a customer with ". $financial_tables{$table};
1042 foreach my $record ( @records ) {
1043 my $error = $record->delete;
1045 $dbh->rollback if $oldAutoCommit;
1046 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1052 my @cust_pkg = $self->ncancelled_pkgs;
1054 my $new_custnum = $opt{'new_custnum'};
1055 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1056 $dbh->rollback if $oldAutoCommit;
1057 return "Invalid new customer number: $new_custnum";
1059 foreach my $cust_pkg ( @cust_pkg ) {
1060 my %hash = $cust_pkg->hash;
1061 $hash{'custnum'} = $new_custnum;
1062 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1063 my $error = $new_cust_pkg->replace($cust_pkg,
1064 options => { $cust_pkg->options },
1067 $dbh->rollback if $oldAutoCommit;
1072 my @cancelled_cust_pkg = $self->all_pkgs;
1073 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1074 my $error = $cust_pkg->delete;
1076 $dbh->rollback if $oldAutoCommit;
1081 #cust_tax_adjustment in financials?
1082 #cust_pay_pending? ouch
1084 foreach my $table (qw(
1085 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1086 cust_location cust_main_note cust_tax_adjustment
1087 cust_pay_void cust_pay_batch queue cust_tax_exempt
1089 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1090 my $error = $record->delete;
1092 $dbh->rollback if $oldAutoCommit;
1098 my $sth = $dbh->prepare(
1099 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1101 my $errstr = $dbh->errstr;
1102 $dbh->rollback if $oldAutoCommit;
1105 $sth->execute($self->custnum) or do {
1106 my $errstr = $sth->errstr;
1107 $dbh->rollback if $oldAutoCommit;
1113 my $ticket_dbh = '';
1114 if ($conf->config('ticket_system') eq 'RT_Internal') {
1116 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1117 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1118 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1119 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1122 if ( $ticket_dbh ) {
1124 my $ticket_sth = $ticket_dbh->prepare(
1125 'DELETE FROM Links WHERE Target = ?'
1127 my $errstr = $ticket_dbh->errstr;
1128 $dbh->rollback if $oldAutoCommit;
1131 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1133 my $errstr = $ticket_sth->errstr;
1134 $dbh->rollback if $oldAutoCommit;
1138 #check and see if the customer is the only link on the ticket, and
1139 #if so, set the ticket to deleted status in RT?
1140 #maybe someday, for now this will at least fix tickets not displaying
1144 #delete the customer record
1146 my $error = $self->SUPER::delete;
1148 $dbh->rollback if $oldAutoCommit;
1152 # cust_main exports!
1154 #my $export_args = $options{'export_args'} || [];
1157 map qsearch( 'part_export', {exportnum=>$_} ),
1158 $conf->config('cust_main-exports'); #, $agentnum
1160 foreach my $part_export ( @part_export ) {
1161 my $error = $part_export->export_delete( $self ); #, @$export_args);
1163 $dbh->rollback if $oldAutoCommit;
1164 return "exporting to ". $part_export->exporttype.
1165 " (transaction rolled back): $error";
1169 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1174 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1176 This merges this customer into the provided new custnum, and then deletes the
1177 customer. If there is an error, returns the error, otherwise returns false.
1179 The source customer's name, company name, phone numbers, agent,
1180 referring customer, customer class, advertising source, order taker, and
1181 billing information (except balance) are discarded.
1183 All packages are moved to the target customer. Packages with package locations
1184 are preserved. Packages without package locations are moved to a new package
1185 location with the source customer's service/shipping address.
1187 All invoices, statements, payments, credits and refunds are moved to the target
1188 customer. The source customer's balance is added to the target customer.
1190 All notes, attachments, tickets and customer tags are moved to the target
1193 Change history is not currently moved.
1198 my( $self, $new_custnum, %opt ) = @_;
1200 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1202 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
1203 or return "Invalid new customer number: $new_custnum";
1205 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
1206 if $self->agentnum != $new_cust_main->agentnum
1207 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
1209 local $SIG{HUP} = 'IGNORE';
1210 local $SIG{INT} = 'IGNORE';
1211 local $SIG{QUIT} = 'IGNORE';
1212 local $SIG{TERM} = 'IGNORE';
1213 local $SIG{TSTP} = 'IGNORE';
1214 local $SIG{PIPE} = 'IGNORE';
1216 my $oldAutoCommit = $FS::UID::AutoCommit;
1217 local $FS::UID::AutoCommit = 0;
1220 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1221 $dbh->rollback if $oldAutoCommit;
1222 return "Can't merge a master agent customer";
1225 #use FS::access_user
1226 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1227 $dbh->rollback if $oldAutoCommit;
1228 return "Can't merge a master employee customer";
1231 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1232 'status' => { op=>'!=', value=>'done' },
1236 $dbh->rollback if $oldAutoCommit;
1237 return "Can't merge a customer with pending payments";
1240 tie my %financial_tables, 'Tie::IxHash',
1241 'cust_bill' => 'invoices',
1242 'cust_bill_void' => 'voided invoices',
1243 'cust_statement' => 'statements',
1244 'cust_credit' => 'credits',
1245 'cust_pay' => 'payments',
1246 'cust_pay_void' => 'voided payments',
1247 'cust_refund' => 'refunds',
1250 foreach my $table ( keys %financial_tables ) {
1252 my @records = $self->$table();
1254 foreach my $record ( @records ) {
1255 $record->custnum($new_custnum);
1256 my $error = $record->replace;
1258 $dbh->rollback if $oldAutoCommit;
1259 return "Error merging ". $financial_tables{$table}. ": $error\n";
1265 my $name = $self->ship_name; #?
1267 my $locationnum = '';
1268 foreach my $cust_pkg ( $self->all_pkgs ) {
1269 $cust_pkg->custnum($new_custnum);
1271 unless ( $cust_pkg->locationnum ) {
1272 unless ( $locationnum ) {
1273 my $cust_location = new FS::cust_location {
1274 $self->location_hash,
1275 'custnum' => $new_custnum,
1277 my $error = $cust_location->insert;
1279 $dbh->rollback if $oldAutoCommit;
1282 $locationnum = $cust_location->locationnum;
1284 $cust_pkg->locationnum($locationnum);
1287 my $error = $cust_pkg->replace;
1289 $dbh->rollback if $oldAutoCommit;
1293 # add customer (ship) name to svc_phone.phone_name if blank
1294 my @cust_svc = $cust_pkg->cust_svc;
1295 foreach my $cust_svc (@cust_svc) {
1296 my($label, $value, $svcdb) = $cust_svc->label;
1297 next unless $svcdb eq 'svc_phone';
1298 my $svc_phone = $cust_svc->svc_x;
1299 next if $svc_phone->phone_name;
1300 $svc_phone->phone_name($name);
1301 my $error = $svc_phone->replace;
1303 $dbh->rollback if $oldAutoCommit;
1311 # cust_tax_exempt (texas tax exemptions)
1312 # cust_recon (some sort of not-well understood thing for OnPac)
1314 #these are moved over
1315 foreach my $table (qw(
1316 cust_tag cust_location contact cust_attachment cust_main_note
1317 cust_tax_adjustment cust_pay_batch queue
1319 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1320 $record->custnum($new_custnum);
1321 my $error = $record->replace;
1323 $dbh->rollback if $oldAutoCommit;
1329 #these aren't preserved
1330 foreach my $table (qw(
1331 cust_main_exemption cust_main_invoice
1333 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1334 my $error = $record->delete;
1336 $dbh->rollback if $oldAutoCommit;
1343 my $sth = $dbh->prepare(
1344 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1346 my $errstr = $dbh->errstr;
1347 $dbh->rollback if $oldAutoCommit;
1350 $sth->execute($new_custnum, $self->custnum) or do {
1351 my $errstr = $sth->errstr;
1352 $dbh->rollback if $oldAutoCommit;
1358 my $ticket_dbh = '';
1359 if ($conf->config('ticket_system') eq 'RT_Internal') {
1361 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1362 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1363 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1364 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1367 if ( $ticket_dbh ) {
1369 my $ticket_sth = $ticket_dbh->prepare(
1370 'UPDATE Links SET Target = ? WHERE Target = ?'
1372 my $errstr = $ticket_dbh->errstr;
1373 $dbh->rollback if $oldAutoCommit;
1376 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1377 'freeside://freeside/cust_main/'.$self->custnum)
1379 my $errstr = $ticket_sth->errstr;
1380 $dbh->rollback if $oldAutoCommit;
1386 #delete the customer record
1388 my $error = $self->delete;
1390 $dbh->rollback if $oldAutoCommit;
1394 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1399 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1401 Replaces the OLD_RECORD with this one in the database. If there is an error,
1402 returns the error, otherwise returns false.
1404 To change the customer's address, set the pseudo-fields C<bill_location> and
1405 C<ship_location>. The address will still only change if at least one of the
1406 address fields differs from the existing values.
1408 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1409 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1410 expected and rollback the entire transaction; it is not necessary to call
1411 check_invoicing_list first. Here's an example:
1413 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1415 Currently available options are: I<tax_exemption>.
1417 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1418 of tax names and exemption numbers. FS::cust_main_exemption records will be
1419 deleted and inserted as appropriate.
1426 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1428 : $self->replace_old;
1432 warn "$me replace called\n"
1435 my $curuser = $FS::CurrentUser::CurrentUser;
1436 if ( $self->payby eq 'COMP'
1437 && $self->payby ne $old->payby
1438 && ! $curuser->access_right('Complimentary customer')
1441 return "You are not permitted to create complimentary accounts.";
1444 local($ignore_expired_card) = 1
1445 if $old->payby =~ /^(CARD|DCRD)$/
1446 && $self->payby =~ /^(CARD|DCRD)$/
1447 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1449 local($ignore_banned_card) = 1
1450 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1451 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1452 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1454 return "Invoicing locale is required"
1457 && $conf->exists('cust_main-require_locale');
1459 local $SIG{HUP} = 'IGNORE';
1460 local $SIG{INT} = 'IGNORE';
1461 local $SIG{QUIT} = 'IGNORE';
1462 local $SIG{TERM} = 'IGNORE';
1463 local $SIG{TSTP} = 'IGNORE';
1464 local $SIG{PIPE} = 'IGNORE';
1466 my $oldAutoCommit = $FS::UID::AutoCommit;
1467 local $FS::UID::AutoCommit = 0;
1470 for my $l (qw(bill_location ship_location)) {
1471 my $old_loc = $old->$l;
1472 my $new_loc = $self->$l;
1474 # find the existing location if there is one
1475 $new_loc->set('custnum' => $self->custnum);
1476 my $error = $new_loc->find_or_insert;
1478 $dbh->rollback if $oldAutoCommit;
1481 $self->set($l.'num', $new_loc->locationnum);
1484 # replace the customer record
1485 my $error = $self->SUPER::replace($old);
1488 $dbh->rollback if $oldAutoCommit;
1492 # now move packages to the new service location
1493 $self->set('ship_location', ''); #flush cache
1494 if ( $old->ship_locationnum and # should only be null during upgrade...
1495 $old->ship_locationnum != $self->ship_locationnum ) {
1496 $error = $old->ship_location->move_to($self->ship_location);
1498 $dbh->rollback if $oldAutoCommit;
1502 # don't move packages based on the billing location, but
1503 # disable it if it's no longer in use
1504 if ( $old->bill_locationnum and
1505 $old->bill_locationnum != $self->bill_locationnum ) {
1506 $error = $old->bill_location->disable_if_unused;
1508 $dbh->rollback if $oldAutoCommit;
1513 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1514 my $invoicing_list = shift @param;
1515 $error = $self->check_invoicing_list( $invoicing_list );
1517 $dbh->rollback if $oldAutoCommit;
1520 $self->invoicing_list( $invoicing_list );
1523 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1525 #this could be more efficient than deleting and re-inserting, if it matters
1526 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1527 my $error = $cust_tag->delete;
1529 $dbh->rollback if $oldAutoCommit;
1533 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1534 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1535 'custnum' => $self->custnum };
1536 my $error = $cust_tag->insert;
1538 $dbh->rollback if $oldAutoCommit;
1545 my %options = @param;
1547 my $tax_exemption = delete $options{'tax_exemption'};
1548 if ( $tax_exemption ) {
1550 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1551 if ref($tax_exemption) eq 'ARRAY';
1553 my %cust_main_exemption =
1554 map { $_->taxname => $_ }
1555 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1557 foreach my $taxname ( keys %$tax_exemption ) {
1559 if ( $cust_main_exemption{$taxname} &&
1560 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1563 delete $cust_main_exemption{$taxname};
1567 my $cust_main_exemption = new FS::cust_main_exemption {
1568 'custnum' => $self->custnum,
1569 'taxname' => $taxname,
1570 'exempt_number' => $tax_exemption->{$taxname},
1572 my $error = $cust_main_exemption->insert;
1574 $dbh->rollback if $oldAutoCommit;
1575 return "inserting cust_main_exemption (transaction rolled back): $error";
1579 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1580 my $error = $cust_main_exemption->delete;
1582 $dbh->rollback if $oldAutoCommit;
1583 return "deleting cust_main_exemption (transaction rolled back): $error";
1589 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1590 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1591 && $self->get('payinfo') !~ /^99\d{14}$/
1593 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1598 # card/check/lec info has changed, want to retry realtime_ invoice events
1599 my $error = $self->retry_realtime;
1601 $dbh->rollback if $oldAutoCommit;
1606 unless ( $import || $skip_fuzzyfiles ) {
1607 $error = $self->queue_fuzzyfiles_update;
1609 $dbh->rollback if $oldAutoCommit;
1610 return "updating fuzzy search cache: $error";
1614 # tax district update in cust_location
1616 # cust_main exports!
1618 my $export_args = $options{'export_args'} || [];
1621 map qsearch( 'part_export', {exportnum=>$_} ),
1622 $conf->config('cust_main-exports'); #, $agentnum
1624 foreach my $part_export ( @part_export ) {
1625 my $error = $part_export->export_replace( $self, $old, @$export_args);
1627 $dbh->rollback if $oldAutoCommit;
1628 return "exporting to ". $part_export->exporttype.
1629 " (transaction rolled back): $error";
1633 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1638 =item queue_fuzzyfiles_update
1640 Used by insert & replace to update the fuzzy search cache
1644 use FS::cust_main::Search;
1645 sub queue_fuzzyfiles_update {
1648 local $SIG{HUP} = 'IGNORE';
1649 local $SIG{INT} = 'IGNORE';
1650 local $SIG{QUIT} = 'IGNORE';
1651 local $SIG{TERM} = 'IGNORE';
1652 local $SIG{TSTP} = 'IGNORE';
1653 local $SIG{PIPE} = 'IGNORE';
1655 my $oldAutoCommit = $FS::UID::AutoCommit;
1656 local $FS::UID::AutoCommit = 0;
1659 my @locations = $self->bill_location;
1660 push @locations, $self->ship_location if $self->has_ship_address;
1661 foreach my $location (@locations) {
1662 my $queue = new FS::queue {
1663 'job' => 'FS::cust_main::Search::append_fuzzyfiles'
1665 my @args = map $location->get($_), @FS::cust_main::Search::fuzzyfields;
1666 my $error = $queue->insert( @args );
1668 $dbh->rollback if $oldAutoCommit;
1669 return "queueing job (transaction rolled back): $error";
1673 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1680 Checks all fields to make sure this is a valid customer record. If there is
1681 an error, returns the error, otherwise returns false. Called by the insert
1682 and replace methods.
1689 warn "$me check BEFORE: \n". $self->_dump
1693 $self->ut_numbern('custnum')
1694 || $self->ut_number('agentnum')
1695 || $self->ut_textn('agent_custid')
1696 || $self->ut_number('refnum')
1697 || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
1698 || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
1699 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1700 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1701 || $self->ut_textn('custbatch')
1702 || $self->ut_name('last')
1703 || $self->ut_name('first')
1704 || $self->ut_snumbern('signupdate')
1705 || $self->ut_snumbern('birthdate')
1706 || $self->ut_snumbern('spouse_birthdate')
1707 || $self->ut_snumbern('anniversary_date')
1708 || $self->ut_textn('company')
1709 || $self->ut_anything('comments')
1710 || $self->ut_numbern('referral_custnum')
1711 || $self->ut_textn('stateid')
1712 || $self->ut_textn('stateid_state')
1713 || $self->ut_textn('invoice_terms')
1714 || $self->ut_floatn('cdr_termination_percentage')
1715 || $self->ut_floatn('credit_limit')
1716 || $self->ut_numbern('billday')
1717 || $self->ut_numbern('prorate_day')
1718 || $self->ut_flag('edit_subject')
1719 || $self->ut_flag('calling_list_exempt')
1720 || $self->ut_flag('invoice_noemail')
1721 || $self->ut_flag('message_noemail')
1722 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1723 || $self->ut_currencyn('currency')
1726 my $company = $self->company;
1727 $company =~ s/^\s+//;
1728 $company =~ s/\s+$//;
1729 $company =~ s/\s+/ /g;
1730 $self->company($company);
1732 #barf. need message catalogs. i18n. etc.
1733 $error .= "Please select an advertising source."
1734 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1735 return $error if $error;
1737 my $agent = qsearchs( 'agent', { 'agentnum' => $self->agentnum } )
1738 or return "Unknown agent";
1740 if ( $self->currency ) {
1741 my $agent_currency = qsearchs( 'agent_currency', {
1742 'agentnum' => $agent->agentnum,
1743 'currency' => $self->currency,
1745 or return "Agent ". $agent->agent.
1746 " not permitted to offer ". $self->currency. " invoicing";
1749 return "Unknown refnum"
1750 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1752 return "Unknown referring custnum: ". $self->referral_custnum
1753 unless ! $self->referral_custnum
1754 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1756 if ( $self->ss eq '' ) {
1761 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1762 or return "Illegal social security number: ". $self->ss;
1763 $self->ss("$1-$2-$3");
1766 # cust_main_county verification now handled by cust_location check
1769 $self->ut_phonen('daytime', $self->country)
1770 || $self->ut_phonen('night', $self->country)
1771 || $self->ut_phonen('fax', $self->country)
1772 || $self->ut_phonen('mobile', $self->country)
1774 return $error if $error;
1776 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1778 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1781 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1783 : FS::Msgcat::_gettext('daytime');
1784 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1786 : FS::Msgcat::_gettext('night');
1788 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1790 : FS::Msgcat::_gettext('mobile');
1792 return "$daytime_label, $night_label or $mobile_label is required"
1796 ### start of stuff moved to cust_payby
1798 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1799 # or return "Illegal payby: ". $self->payby;
1801 FS::payby->can_payby($self->table, $self->payby)
1802 or return "Illegal payby: ". $self->payby;
1804 $error = $self->ut_numbern('paystart_month')
1805 || $self->ut_numbern('paystart_year')
1806 || $self->ut_numbern('payissue')
1807 || $self->ut_textn('paytype')
1809 return $error if $error;
1811 if ( $self->payip eq '' ) {
1814 $error = $self->ut_ip('payip');
1815 return $error if $error;
1818 # If it is encrypted and the private key is not availaible then we can't
1819 # check the credit card.
1820 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1822 # Need some kind of global flag to accept invalid cards, for testing
1824 if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1826 my $payinfo = $self->payinfo;
1827 $payinfo =~ s/\D//g;
1828 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1829 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1831 $self->payinfo($payinfo);
1833 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1835 return gettext('unknown_card_type')
1836 if $self->payinfo !~ /^99\d{14}$/ #token
1837 && cardtype($self->payinfo) eq "Unknown";
1839 unless ( $ignore_banned_card ) {
1840 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1842 if ( $ban->bantype eq 'warn' ) {
1843 #or others depending on value of $ban->reason ?
1844 return '_duplicate_card'.
1845 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1846 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1847 ' (ban# '. $ban->bannum. ')'
1848 unless $self->override_ban_warn;
1850 return 'Banned credit card: banned on '.
1851 time2str('%a %h %o at %r', $ban->_date).
1852 ' by '. $ban->otaker.
1853 ' (ban# '. $ban->bannum. ')';
1858 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1859 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1860 $self->paycvv =~ /^(\d{4})$/
1861 or return "CVV2 (CID) for American Express cards is four digits.";
1864 $self->paycvv =~ /^(\d{3})$/
1865 or return "CVV2 (CVC2/CID) is three digits.";
1872 my $cardtype = cardtype($payinfo);
1873 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1875 return "Start date or issue number is required for $cardtype cards"
1876 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1878 return "Start month must be between 1 and 12"
1879 if $self->paystart_month
1880 and $self->paystart_month < 1 || $self->paystart_month > 12;
1882 return "Start year must be 1990 or later"
1883 if $self->paystart_year
1884 and $self->paystart_year < 1990;
1886 return "Issue number must be beween 1 and 99"
1888 and $self->payissue < 1 || $self->payissue > 99;
1891 $self->paystart_month('');
1892 $self->paystart_year('');
1893 $self->payissue('');
1896 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1898 my $payinfo = $self->payinfo;
1899 $payinfo =~ s/[^\d\@\.]//g;
1900 if ( $conf->config('echeck-country') eq 'CA' ) {
1901 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1902 or return 'invalid echeck account@branch.bank';
1903 $payinfo = "$1\@$2.$3";
1904 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1905 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1906 $payinfo = "$1\@$2";
1908 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1909 $payinfo = "$1\@$2";
1911 $self->payinfo($payinfo);
1914 unless ( $ignore_banned_card ) {
1915 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1917 if ( $ban->bantype eq 'warn' ) {
1918 #or others depending on value of $ban->reason ?
1919 return '_duplicate_ach' unless $self->override_ban_warn;
1921 return 'Banned ACH account: banned on '.
1922 time2str('%a %h %o at %r', $ban->_date).
1923 ' by '. $ban->otaker.
1924 ' (ban# '. $ban->bannum. ')';
1929 } elsif ( $self->payby eq 'LECB' ) {
1931 my $payinfo = $self->payinfo;
1932 $payinfo =~ s/\D//g;
1933 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1935 $self->payinfo($payinfo);
1938 } elsif ( $self->payby eq 'BILL' ) {
1940 $error = $self->ut_textn('payinfo');
1941 return "Illegal P.O. number: ". $self->payinfo if $error;
1944 } elsif ( $self->payby eq 'COMP' ) {
1946 my $curuser = $FS::CurrentUser::CurrentUser;
1947 if ( ! $self->custnum
1948 && ! $curuser->access_right('Complimentary customer')
1951 return "You are not permitted to create complimentary accounts."
1954 $error = $self->ut_textn('payinfo');
1955 return "Illegal comp account issuer: ". $self->payinfo if $error;
1958 } elsif ( $self->payby eq 'PREPAY' ) {
1960 my $payinfo = $self->payinfo;
1961 $payinfo =~ s/\W//g; #anything else would just confuse things
1962 $self->payinfo($payinfo);
1963 $error = $self->ut_alpha('payinfo');
1964 return "Illegal prepayment identifier: ". $self->payinfo if $error;
1965 return "Unknown prepayment identifier"
1966 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1971 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1972 return "Expiration date required"
1973 # shouldn't payinfo_check do this?
1974 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
1978 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1979 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1980 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1981 ( $m, $y ) = ( $2, "19$1" );
1982 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1983 ( $m, $y ) = ( $3, "20$2" );
1985 return "Illegal expiration date: ". $self->paydate;
1987 $m = sprintf('%02d',$m);
1988 $self->paydate("$y-$m-01");
1989 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1990 return gettext('expired_card')
1992 && !$ignore_expired_card
1993 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1996 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1997 ( ! $conf->exists('require_cardname')
1998 || $self->payby !~ /^(CARD|DCRD)$/ )
2000 $self->payname( $self->first. " ". $self->getfield('last') );
2002 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2003 or return gettext('illegal_name'). " payname: ". $self->payname;
2007 ### end of stuff moved to cust_payby
2009 return "Please select an invoicing locale"
2012 && $conf->exists('cust_main-require_locale');
2014 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2015 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2019 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2021 warn "$me check AFTER: \n". $self->_dump
2024 $self->SUPER::check;
2029 Returns a list of fields which have ship_ duplicates.
2034 qw( last first company
2035 address1 address2 city county state zip country
2037 daytime night fax mobile
2041 =item has_ship_address
2043 Returns true if this customer record has a separate shipping address.
2047 sub has_ship_address {
2049 $self->bill_locationnum != $self->ship_locationnum;
2054 Returns a list of key/value pairs, with the following keys: address1,
2055 adddress2, city, county, state, zip, country, district, and geocode. The
2056 shipping address is used if present.
2062 $self->ship_location->location_hash;
2067 Returns all locations (see L<FS::cust_location>) for this customer.
2073 qsearch('cust_location', { 'custnum' => $self->custnum,
2074 'prospectnum' => '' } );
2079 Returns all contacts (see L<FS::contact>) for this customer.
2083 #already used :/ sub contact {
2086 qsearch('contact', { 'custnum' => $self->custnum } );
2091 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2092 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2093 on success or a list of errors.
2099 grep { $_->unsuspend } $self->suspended_pkgs;
2104 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2106 Returns a list: an empty list on success or a list of errors.
2112 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2115 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2117 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2118 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2119 of a list of pkgparts; the hashref has the following keys:
2123 =item pkgparts - listref of pkgparts
2125 =item (other options are passed to the suspend method)
2130 Returns a list: an empty list on success or a list of errors.
2134 sub suspend_if_pkgpart {
2136 my (@pkgparts, %opt);
2137 if (ref($_[0]) eq 'HASH'){
2138 @pkgparts = @{$_[0]{pkgparts}};
2143 grep { $_->suspend(%opt) }
2144 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2145 $self->unsuspended_pkgs;
2148 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2150 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2151 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2152 instead of a list of pkgparts; the hashref has the following keys:
2156 =item pkgparts - listref of pkgparts
2158 =item (other options are passed to the suspend method)
2162 Returns a list: an empty list on success or a list of errors.
2166 sub suspend_unless_pkgpart {
2168 my (@pkgparts, %opt);
2169 if (ref($_[0]) eq 'HASH'){
2170 @pkgparts = @{$_[0]{pkgparts}};
2175 grep { $_->suspend(%opt) }
2176 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2177 $self->unsuspended_pkgs;
2180 =item cancel [ OPTION => VALUE ... ]
2182 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2184 Available options are:
2188 =item quiet - can be set true to supress email cancellation notices.
2190 =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.
2192 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2194 =item nobill - can be set true to skip billing if it might otherwise be done.
2198 Always returns a list: an empty list on success or a list of errors.
2202 # nb that dates are not specified as valid options to this method
2205 my( $self, %opt ) = @_;
2207 warn "$me cancel called on customer ". $self->custnum. " with options ".
2208 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2211 return ( 'access denied' )
2212 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2214 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2216 #should try decryption (we might have the private key)
2217 # and if not maybe queue a job for the server that does?
2218 return ( "Can't (yet) ban encrypted credit cards" )
2219 if $self->is_encrypted($self->payinfo);
2221 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2222 my $error = $ban->insert;
2223 return ( $error ) if $error;
2227 my @pkgs = $self->ncancelled_pkgs;
2229 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2231 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2232 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2236 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2237 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2240 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2243 sub _banned_pay_hashref {
2254 'payby' => $payby2ban{$self->payby},
2255 'payinfo' => $self->payinfo,
2256 #don't ever *search* on reason! #'reason' =>
2260 sub _new_banned_pay_hashref {
2262 my $hr = $self->_banned_pay_hashref;
2263 $hr->{payinfo} = md5_base64($hr->{payinfo});
2269 Returns all notes (see L<FS::cust_main_note>) for this customer.
2274 my($self,$orderby_classnum) = (shift,shift);
2275 my $orderby = "_DATE DESC";
2276 $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
2277 qsearch( 'cust_main_note',
2278 { 'custnum' => $self->custnum },
2280 "ORDER BY $orderby",
2286 Returns the agent (see L<FS::agent>) for this customer.
2292 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2297 Returns the agent name (see L<FS::agent>) for this customer.
2303 $self->agent->agent;
2308 Returns any tags associated with this customer, as FS::cust_tag objects,
2309 or an empty list if there are no tags.
2315 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2320 Returns any tags associated with this customer, as FS::part_tag objects,
2321 or an empty list if there are no tags.
2327 map $_->part_tag, $self->cust_tag;
2333 Returns the customer class, as an FS::cust_class object, or the empty string
2334 if there is no customer class.
2340 if ( $self->classnum ) {
2341 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2349 Returns the customer category name, or the empty string if there is no customer
2356 my $cust_class = $self->cust_class;
2358 ? $cust_class->categoryname
2364 Returns the customer class name, or the empty string if there is no customer
2371 my $cust_class = $self->cust_class;
2373 ? $cust_class->classname
2377 =item BILLING METHODS
2379 Documentation on billing methods has been moved to
2380 L<FS::cust_main::Billing>.
2382 =item REALTIME BILLING METHODS
2384 Documentation on realtime billing methods has been moved to
2385 L<FS::cust_main::Billing_Realtime>.
2389 Removes the I<paycvv> field from the database directly.
2391 If there is an error, returns the error, otherwise returns false.
2397 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2398 or return dbh->errstr;
2399 $sth->execute($self->custnum)
2400 or return $sth->errstr;
2405 =item batch_card OPTION => VALUE...
2407 Adds a payment for this invoice to the pending credit card batch (see
2408 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2409 runs the payment using a realtime gateway.
2411 Options may include:
2413 B<amount>: the amount to be paid; defaults to the customer's balance minus
2414 any payments in transit.
2416 B<payby>: the payment method; defaults to cust_main.payby
2418 B<realtime>: runs this as a realtime payment instead of adding it to a
2421 B<invnum>: sets cust_pay_batch.invnum.
2423 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2424 the billing address for the payment; defaults to the customer's billing
2427 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2428 date, and name; defaults to those fields in cust_main.
2433 my ($self, %options) = @_;
2436 if (exists($options{amount})) {
2437 $amount = $options{amount};
2439 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2441 return '' unless $amount > 0;
2443 my $invnum = delete $options{invnum};
2444 my $payby = $options{payby} || $self->payby; #still dubious
2446 if ($options{'realtime'}) {
2447 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2453 my $oldAutoCommit = $FS::UID::AutoCommit;
2454 local $FS::UID::AutoCommit = 0;
2457 #this needs to handle mysql as well as Pg, like svc_acct.pm
2458 #(make it into a common function if folks need to do batching with mysql)
2459 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2460 or return "Cannot lock pay_batch: " . $dbh->errstr;
2464 'payby' => FS::payby->payby2payment($payby),
2466 $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2468 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2470 unless ( $pay_batch ) {
2471 $pay_batch = new FS::pay_batch \%pay_batch;
2472 my $error = $pay_batch->insert;
2474 $dbh->rollback if $oldAutoCommit;
2475 die "error creating new batch: $error\n";
2479 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2480 'batchnum' => $pay_batch->batchnum,
2481 'custnum' => $self->custnum,
2484 foreach (qw( address1 address2 city state zip country latitude longitude
2485 payby payinfo paydate payname ))
2487 $options{$_} = '' unless exists($options{$_});
2490 my $loc = $self->bill_location;
2492 my $cust_pay_batch = new FS::cust_pay_batch ( {
2493 'batchnum' => $pay_batch->batchnum,
2494 'invnum' => $invnum || 0, # is there a better value?
2495 # this field should be
2497 # cust_bill_pay_batch now
2498 'custnum' => $self->custnum,
2499 'last' => $self->getfield('last'),
2500 'first' => $self->getfield('first'),
2501 'address1' => $options{address1} || $loc->address1,
2502 'address2' => $options{address2} || $loc->address2,
2503 'city' => $options{city} || $loc->city,
2504 'state' => $options{state} || $loc->state,
2505 'zip' => $options{zip} || $loc->zip,
2506 'country' => $options{country} || $loc->country,
2507 'payby' => $options{payby} || $self->payby,
2508 'payinfo' => $options{payinfo} || $self->payinfo,
2509 'exp' => $options{paydate} || $self->paydate,
2510 'payname' => $options{payname} || $self->payname,
2511 'amount' => $amount, # consolidating
2514 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2515 if $old_cust_pay_batch;
2518 if ($old_cust_pay_batch) {
2519 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2521 $error = $cust_pay_batch->insert;
2525 $dbh->rollback if $oldAutoCommit;
2529 my $unapplied = $self->total_unapplied_credits
2530 + $self->total_unapplied_payments
2531 + $self->in_transit_payments;
2532 foreach my $cust_bill ($self->open_cust_bill) {
2533 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2534 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2535 'invnum' => $cust_bill->invnum,
2536 'paybatchnum' => $cust_pay_batch->paybatchnum,
2537 'amount' => $cust_bill->owed,
2540 if ($unapplied >= $cust_bill_pay_batch->amount){
2541 $unapplied -= $cust_bill_pay_batch->amount;
2544 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2545 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2547 $error = $cust_bill_pay_batch->insert;
2549 $dbh->rollback if $oldAutoCommit;
2554 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2560 Returns the total owed for this customer on all invoices
2561 (see L<FS::cust_bill/owed>).
2567 $self->total_owed_date(2145859200); #12/31/2037
2570 =item total_owed_date TIME
2572 Returns the total owed for this customer on all invoices with date earlier than
2573 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2574 see L<Time::Local> and L<Date::Parse> for conversion functions.
2578 sub total_owed_date {
2582 my $custnum = $self->custnum;
2584 my $owed_sql = FS::cust_bill->owed_sql;
2587 SELECT SUM($owed_sql) FROM cust_bill
2588 WHERE custnum = $custnum
2592 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2596 =item total_owed_pkgnum PKGNUM
2598 Returns the total owed on all invoices for this customer's specific package
2599 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2603 sub total_owed_pkgnum {
2604 my( $self, $pkgnum ) = @_;
2605 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2608 =item total_owed_date_pkgnum TIME PKGNUM
2610 Returns the total owed for this customer's specific package when using
2611 experimental package balances on all invoices with date earlier than
2612 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2613 see L<Time::Local> and L<Date::Parse> for conversion functions.
2617 sub total_owed_date_pkgnum {
2618 my( $self, $time, $pkgnum ) = @_;
2621 foreach my $cust_bill (
2622 grep { $_->_date <= $time }
2623 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2625 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2627 sprintf( "%.2f", $total_bill );
2633 Returns the total amount of all payments.
2640 $total += $_->paid foreach $self->cust_pay;
2641 sprintf( "%.2f", $total );
2644 =item total_unapplied_credits
2646 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2647 customer. See L<FS::cust_credit/credited>.
2649 =item total_credited
2651 Old name for total_unapplied_credits. Don't use.
2655 sub total_credited {
2656 #carp "total_credited deprecated, use total_unapplied_credits";
2657 shift->total_unapplied_credits(@_);
2660 sub total_unapplied_credits {
2663 my $custnum = $self->custnum;
2665 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2668 SELECT SUM($unapplied_sql) FROM cust_credit
2669 WHERE custnum = $custnum
2672 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2676 =item total_unapplied_credits_pkgnum PKGNUM
2678 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2679 customer. See L<FS::cust_credit/credited>.
2683 sub total_unapplied_credits_pkgnum {
2684 my( $self, $pkgnum ) = @_;
2685 my $total_credit = 0;
2686 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2687 sprintf( "%.2f", $total_credit );
2691 =item total_unapplied_payments
2693 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2694 See L<FS::cust_pay/unapplied>.
2698 sub total_unapplied_payments {
2701 my $custnum = $self->custnum;
2703 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2706 SELECT SUM($unapplied_sql) FROM cust_pay
2707 WHERE custnum = $custnum
2710 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2714 =item total_unapplied_payments_pkgnum PKGNUM
2716 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2717 specific package when using experimental package balances. See
2718 L<FS::cust_pay/unapplied>.
2722 sub total_unapplied_payments_pkgnum {
2723 my( $self, $pkgnum ) = @_;
2724 my $total_unapplied = 0;
2725 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2726 sprintf( "%.2f", $total_unapplied );
2730 =item total_unapplied_refunds
2732 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2733 customer. See L<FS::cust_refund/unapplied>.
2737 sub total_unapplied_refunds {
2739 my $custnum = $self->custnum;
2741 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2744 SELECT SUM($unapplied_sql) FROM cust_refund
2745 WHERE custnum = $custnum
2748 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2754 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2755 total_unapplied_credits minus total_unapplied_payments).
2761 $self->balance_date_range;
2764 =item balance_date TIME
2766 Returns the balance for this customer, only considering invoices with date
2767 earlier than TIME (total_owed_date minus total_credited minus
2768 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2769 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2776 $self->balance_date_range(shift);
2779 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2781 Returns the balance for this customer, optionally considering invoices with
2782 date earlier than START_TIME, and not later than END_TIME
2783 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2785 Times are specified as SQL fragments or numeric
2786 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2787 L<Date::Parse> for conversion functions. The empty string can be passed
2788 to disable that time constraint completely.
2790 Available options are:
2794 =item unapplied_date
2796 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)
2802 sub balance_date_range {
2804 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2805 ') FROM cust_main WHERE custnum='. $self->custnum;
2806 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2809 =item balance_pkgnum PKGNUM
2811 Returns the balance for this customer's specific package when using
2812 experimental package balances (total_owed plus total_unrefunded, minus
2813 total_unapplied_credits minus total_unapplied_payments)
2817 sub balance_pkgnum {
2818 my( $self, $pkgnum ) = @_;
2821 $self->total_owed_pkgnum($pkgnum)
2822 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2823 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2824 - $self->total_unapplied_credits_pkgnum($pkgnum)
2825 - $self->total_unapplied_payments_pkgnum($pkgnum)
2829 =item in_transit_payments
2831 Returns the total of requests for payments for this customer pending in
2832 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
2836 sub in_transit_payments {
2838 my $in_transit_payments = 0;
2839 foreach my $pay_batch ( qsearch('pay_batch', {
2842 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2843 'batchnum' => $pay_batch->batchnum,
2844 'custnum' => $self->custnum,
2846 $in_transit_payments += $cust_pay_batch->amount;
2849 sprintf( "%.2f", $in_transit_payments );
2854 Returns a hash of useful information for making a payment.
2864 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2865 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2866 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2870 For credit card transactions:
2882 For electronic check transactions:
2897 $return{balance} = $self->balance;
2899 $return{payname} = $self->payname
2900 || ( $self->first. ' '. $self->get('last') );
2902 $return{$_} = $self->bill_location->$_
2903 for qw(address1 address2 city state zip);
2905 $return{payby} = $self->payby;
2906 $return{stateid_state} = $self->stateid_state;
2908 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2909 $return{card_type} = cardtype($self->payinfo);
2910 $return{payinfo} = $self->paymask;
2912 @return{'month', 'year'} = $self->paydate_monthyear;
2916 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2917 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2918 $return{payinfo1} = $payinfo1;
2919 $return{payinfo2} = $payinfo2;
2920 $return{paytype} = $self->paytype;
2921 $return{paystate} = $self->paystate;
2925 #doubleclick protection
2927 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2933 =item paydate_monthyear
2935 Returns a two-element list consisting of the month and year of this customer's
2936 paydate (credit card expiration date for CARD customers)
2940 sub paydate_monthyear {
2942 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2944 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2953 Returns the exact time in seconds corresponding to the payment method
2954 expiration date. For CARD/DCRD customers this is the end of the month;
2955 for others (COMP is the only other payby that uses paydate) it's the start.
2956 Returns 0 if the paydate is empty or set to the far future.
2962 my ($month, $year) = $self->paydate_monthyear;
2963 return 0 if !$year or $year >= 2037;
2964 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2966 if ( $month == 13 ) {
2970 return timelocal(0,0,0,1,$month-1,$year) - 1;
2973 return timelocal(0,0,0,1,$month-1,$year);
2977 =item paydate_epoch_sql
2979 Class method. Returns an SQL expression to obtain the payment expiration date
2980 as a number of seconds.
2984 # Special expiration date behavior for non-CARD/DCRD customers has been
2985 # carefully preserved. Do we really use that?
2986 sub paydate_epoch_sql {
2988 my $table = shift || 'cust_main';
2989 my ($case1, $case2);
2990 if ( driver_name eq 'Pg' ) {
2991 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
2992 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
2994 elsif ( lc(driver_name) eq 'mysql' ) {
2995 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
2996 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
2999 return "CASE WHEN $table.payby IN('CARD','DCRD')
3005 =item tax_exemption TAXNAME
3010 my( $self, $taxname ) = @_;
3012 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3013 'taxname' => $taxname,
3018 =item cust_main_exemption
3022 sub cust_main_exemption {
3024 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3027 =item invoicing_list [ ARRAYREF ]
3029 If an arguement is given, sets these email addresses as invoice recipients
3030 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3031 (except as warnings), so use check_invoicing_list first.
3033 Returns a list of email addresses (with svcnum entries expanded).
3035 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3036 check it without disturbing anything by passing nothing.
3038 This interface may change in the future.
3042 sub invoicing_list {
3043 my( $self, $arrayref ) = @_;
3046 my @cust_main_invoice;
3047 if ( $self->custnum ) {
3048 @cust_main_invoice =
3049 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3051 @cust_main_invoice = ();
3053 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3054 #warn $cust_main_invoice->destnum;
3055 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3056 #warn $cust_main_invoice->destnum;
3057 my $error = $cust_main_invoice->delete;
3058 warn $error if $error;
3061 if ( $self->custnum ) {
3062 @cust_main_invoice =
3063 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3065 @cust_main_invoice = ();
3067 my %seen = map { $_->address => 1 } @cust_main_invoice;
3068 foreach my $address ( @{$arrayref} ) {
3069 next if exists $seen{$address} && $seen{$address};
3070 $seen{$address} = 1;
3071 my $cust_main_invoice = new FS::cust_main_invoice ( {
3072 'custnum' => $self->custnum,
3075 my $error = $cust_main_invoice->insert;
3076 warn $error if $error;
3080 if ( $self->custnum ) {
3082 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3089 =item check_invoicing_list ARRAYREF
3091 Checks these arguements as valid input for the invoicing_list method. If there
3092 is an error, returns the error, otherwise returns false.
3096 sub check_invoicing_list {
3097 my( $self, $arrayref ) = @_;
3099 foreach my $address ( @$arrayref ) {
3101 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3102 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3105 my $cust_main_invoice = new FS::cust_main_invoice ( {
3106 'custnum' => $self->custnum,
3109 my $error = $self->custnum
3110 ? $cust_main_invoice->check
3111 : $cust_main_invoice->checkdest
3113 return $error if $error;
3117 return "Email address required"
3118 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3119 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3124 =item set_default_invoicing_list
3126 Sets the invoicing list to all accounts associated with this customer,
3127 overwriting any previous invoicing list.
3131 sub set_default_invoicing_list {
3133 $self->invoicing_list($self->all_emails);
3138 Returns the email addresses of all accounts provisioned for this customer.
3145 foreach my $cust_pkg ( $self->all_pkgs ) {
3146 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3148 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3149 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3151 $list{$_}=1 foreach map { $_->email } @svc_acct;
3156 =item invoicing_list_addpost
3158 Adds postal invoicing to this customer. If this customer is already configured
3159 to receive postal invoices, does nothing.
3163 sub invoicing_list_addpost {
3165 return if grep { $_ eq 'POST' } $self->invoicing_list;
3166 my @invoicing_list = $self->invoicing_list;
3167 push @invoicing_list, 'POST';
3168 $self->invoicing_list(\@invoicing_list);
3171 =item invoicing_list_emailonly
3173 Returns the list of email invoice recipients (invoicing_list without non-email
3174 destinations such as POST and FAX).
3178 sub invoicing_list_emailonly {
3180 warn "$me invoicing_list_emailonly called"
3182 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3185 =item invoicing_list_emailonly_scalar
3187 Returns the list of email invoice recipients (invoicing_list without non-email
3188 destinations such as POST and FAX) as a comma-separated scalar.
3192 sub invoicing_list_emailonly_scalar {
3194 warn "$me invoicing_list_emailonly_scalar called"
3196 join(', ', $self->invoicing_list_emailonly);
3199 =item referral_custnum_cust_main
3201 Returns the customer who referred this customer (or the empty string, if
3202 this customer was not referred).
3204 Note the difference with referral_cust_main method: This method,
3205 referral_custnum_cust_main returns the single customer (if any) who referred
3206 this customer, while referral_cust_main returns an array of customers referred
3211 sub referral_custnum_cust_main {
3213 return '' unless $self->referral_custnum;
3214 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3217 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3219 Returns an array of customers referred by this customer (referral_custnum set
3220 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3221 customers referred by customers referred by this customer and so on, inclusive.
3222 The default behavior is DEPTH 1 (no recursion).
3224 Note the difference with referral_custnum_cust_main method: This method,
3225 referral_cust_main, returns an array of customers referred BY this customer,
3226 while referral_custnum_cust_main returns the single customer (if any) who
3227 referred this customer.
3231 sub referral_cust_main {
3233 my $depth = @_ ? shift : 1;
3234 my $exclude = @_ ? shift : {};
3237 map { $exclude->{$_->custnum}++; $_; }
3238 grep { ! $exclude->{ $_->custnum } }
3239 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3243 map { $_->referral_cust_main($depth-1, $exclude) }
3250 =item referral_cust_main_ncancelled
3252 Same as referral_cust_main, except only returns customers with uncancelled
3257 sub referral_cust_main_ncancelled {
3259 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3262 =item referral_cust_pkg [ DEPTH ]
3264 Like referral_cust_main, except returns a flat list of all unsuspended (and
3265 uncancelled) packages for each customer. The number of items in this list may
3266 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3270 sub referral_cust_pkg {
3272 my $depth = @_ ? shift : 1;
3274 map { $_->unsuspended_pkgs }
3275 grep { $_->unsuspended_pkgs }
3276 $self->referral_cust_main($depth);
3279 =item referring_cust_main
3281 Returns the single cust_main record for the customer who referred this customer
3282 (referral_custnum), or false.
3286 sub referring_cust_main {
3288 return '' unless $self->referral_custnum;
3289 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3292 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3294 Applies a credit to this customer. If there is an error, returns the error,
3295 otherwise returns false.
3297 REASON can be a text string, an FS::reason object, or a scalar reference to
3298 a reasonnum. If a text string, it will be automatically inserted as a new
3299 reason, and a 'reason_type' option must be passed to indicate the
3300 FS::reason_type for the new reason.
3302 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3304 Any other options are passed to FS::cust_credit::insert.
3309 my( $self, $amount, $reason, %options ) = @_;
3311 my $cust_credit = new FS::cust_credit {
3312 'custnum' => $self->custnum,
3313 'amount' => $amount,
3316 if ( ref($reason) ) {
3318 if ( ref($reason) eq 'SCALAR' ) {
3319 $cust_credit->reasonnum( $$reason );
3321 $cust_credit->reasonnum( $reason->reasonnum );
3325 $cust_credit->set('reason', $reason)
3328 for (qw( addlinfo eventnum )) {
3329 $cust_credit->$_( delete $options{$_} )
3330 if exists($options{$_});
3333 $cust_credit->insert(%options);
3337 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3339 Creates a one-time charge for this customer. If there is an error, returns
3340 the error, otherwise returns false.
3342 New-style, with a hashref of options:
3344 my $error = $cust_main->charge(
3348 'start_date' => str2time('7/4/2009'),
3349 'pkg' => 'Description',
3350 'comment' => 'Comment',
3351 'additional' => [], #extra invoice detail
3352 'classnum' => 1, #pkg_class
3354 'setuptax' => '', # or 'Y' for tax exempt
3356 'locationnum'=> 1234, # optional
3359 'taxclass' => 'Tax class',
3362 'taxproduct' => 2, #part_pkg_taxproduct
3363 'override' => {}, #XXX describe
3365 #will be filled in with the new object
3366 'cust_pkg_ref' => \$cust_pkg,
3368 #generate an invoice immediately
3370 'invoice_terms' => '', #with these terms
3376 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3382 my ( $amount, $quantity, $start_date, $classnum );
3383 my ( $pkg, $comment, $additional );
3384 my ( $setuptax, $taxclass ); #internal taxes
3385 my ( $taxproduct, $override ); #vendor (CCH) taxes
3387 my $cust_pkg_ref = '';
3388 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3390 if ( ref( $_[0] ) ) {
3391 $amount = $_[0]->{amount};
3392 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3393 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3394 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3395 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3396 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3397 : '$'. sprintf("%.2f",$amount);
3398 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3399 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3400 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3401 $additional = $_[0]->{additional} || [];
3402 $taxproduct = $_[0]->{taxproductnum};
3403 $override = { '' => $_[0]->{tax_override} };
3404 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3405 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3406 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3407 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3412 $pkg = @_ ? shift : 'One-time charge';
3413 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3415 $taxclass = @_ ? shift : '';
3419 local $SIG{HUP} = 'IGNORE';
3420 local $SIG{INT} = 'IGNORE';
3421 local $SIG{QUIT} = 'IGNORE';
3422 local $SIG{TERM} = 'IGNORE';
3423 local $SIG{TSTP} = 'IGNORE';
3424 local $SIG{PIPE} = 'IGNORE';
3426 my $oldAutoCommit = $FS::UID::AutoCommit;
3427 local $FS::UID::AutoCommit = 0;
3430 my $part_pkg = new FS::part_pkg ( {
3432 'comment' => $comment,
3436 'classnum' => ( $classnum ? $classnum : '' ),
3437 'setuptax' => $setuptax,
3438 'taxclass' => $taxclass,
3439 'taxproductnum' => $taxproduct,
3442 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3443 ( 0 .. @$additional - 1 )
3445 'additional_count' => scalar(@$additional),
3446 'setup_fee' => $amount,
3449 my $error = $part_pkg->insert( options => \%options,
3450 tax_overrides => $override,
3453 $dbh->rollback if $oldAutoCommit;
3457 my $pkgpart = $part_pkg->pkgpart;
3458 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3459 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3460 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3461 $error = $type_pkgs->insert;
3463 $dbh->rollback if $oldAutoCommit;
3468 my $cust_pkg = new FS::cust_pkg ( {
3469 'custnum' => $self->custnum,
3470 'pkgpart' => $pkgpart,
3471 'quantity' => $quantity,
3472 'start_date' => $start_date,
3473 'no_auto' => $no_auto,
3474 'locationnum'=> $locationnum,
3477 $error = $cust_pkg->insert;
3479 $dbh->rollback if $oldAutoCommit;
3481 } elsif ( $cust_pkg_ref ) {
3482 ${$cust_pkg_ref} = $cust_pkg;
3486 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3487 'pkg_list' => [ $cust_pkg ],
3490 $dbh->rollback if $oldAutoCommit;
3495 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3500 #=item charge_postal_fee
3502 #Applies a one time charge this customer. If there is an error,
3503 #returns the error, returns the cust_pkg charge object or false
3504 #if there was no charge.
3508 # This should be a customer event. For that to work requires that bill
3509 # also be a customer event.
3511 sub charge_postal_fee {
3514 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3515 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3517 my $cust_pkg = new FS::cust_pkg ( {
3518 'custnum' => $self->custnum,
3519 'pkgpart' => $pkgpart,
3523 my $error = $cust_pkg->insert;
3524 $error ? $error : $cust_pkg;
3527 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3529 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3531 Optionally, a list or hashref of additional arguments to the qsearch call can
3538 my $opt = ref($_[0]) ? shift : { @_ };
3540 #return $self->num_cust_bill unless wantarray || keys %$opt;
3542 $opt->{'table'} = 'cust_bill';
3543 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3544 $opt->{'hashref'}{'custnum'} = $self->custnum;
3545 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3547 map { $_ } #behavior of sort undefined in scalar context
3548 sort { $a->_date <=> $b->_date }
3552 =item open_cust_bill
3554 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3559 sub open_cust_bill {
3563 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3569 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3571 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3575 sub legacy_cust_bill {
3578 #return $self->num_legacy_cust_bill unless wantarray;
3580 map { $_ } #behavior of sort undefined in scalar context
3581 sort { $a->_date <=> $b->_date }
3582 qsearch({ 'table' => 'legacy_cust_bill',
3583 'hashref' => { 'custnum' => $self->custnum, },
3584 'order_by' => 'ORDER BY _date ASC',
3588 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3590 Returns all the statements (see L<FS::cust_statement>) for this customer.
3592 Optionally, a list or hashref of additional arguments to the qsearch call can
3597 =item cust_bill_void
3599 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3603 sub cust_bill_void {
3606 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3607 sort { $a->_date <=> $b->_date }
3608 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3611 sub cust_statement {
3613 my $opt = ref($_[0]) ? shift : { @_ };
3615 #return $self->num_cust_statement unless wantarray || keys %$opt;
3617 $opt->{'table'} = 'cust_statement';
3618 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3619 $opt->{'hashref'}{'custnum'} = $self->custnum;
3620 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3622 map { $_ } #behavior of sort undefined in scalar context
3623 sort { $a->_date <=> $b->_date }
3627 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3629 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3631 Optionally, a list or hashref of additional arguments to the qsearch call can
3632 be passed following the SVCDB.
3639 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3640 warn "$me svc_x requires a svcdb";
3643 my $opt = ref($_[0]) ? shift : { @_ };
3645 $opt->{'table'} = $svcdb;
3646 $opt->{'addl_from'} =
3647 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3648 ($opt->{'addl_from'} || '');
3650 my $custnum = $self->custnum;
3651 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3652 my $where = "cust_pkg.custnum = $custnum";
3654 my $extra_sql = $opt->{'extra_sql'} || '';
3655 if ( keys %{ $opt->{'hashref'} } ) {
3656 $extra_sql = " AND $where $extra_sql";
3659 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3660 $extra_sql = "WHERE $where AND $1";
3663 $extra_sql = "WHERE $where $extra_sql";
3666 $opt->{'extra_sql'} = $extra_sql;
3671 # required for use as an eventtable;
3674 $self->svc_x('svc_acct', @_);
3679 Returns all the credits (see L<FS::cust_credit>) for this customer.
3685 map { $_ } #return $self->num_cust_credit unless wantarray;
3686 sort { $a->_date <=> $b->_date }
3687 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3690 =item cust_credit_pkgnum
3692 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3693 package when using experimental package balances.
3697 sub cust_credit_pkgnum {
3698 my( $self, $pkgnum ) = @_;
3699 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3700 sort { $a->_date <=> $b->_date }
3701 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3702 'pkgnum' => $pkgnum,
3709 Returns all the payments (see L<FS::cust_pay>) for this customer.
3715 return $self->num_cust_pay unless wantarray;
3716 sort { $a->_date <=> $b->_date }
3717 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3722 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3723 called automatically when the cust_pay method is used in a scalar context.
3729 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3730 my $sth = dbh->prepare($sql) or die dbh->errstr;
3731 $sth->execute($self->custnum) or die $sth->errstr;
3732 $sth->fetchrow_arrayref->[0];
3735 =item cust_pay_pkgnum
3737 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3738 package when using experimental package balances.
3742 sub cust_pay_pkgnum {
3743 my( $self, $pkgnum ) = @_;
3744 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3745 sort { $a->_date <=> $b->_date }
3746 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3747 'pkgnum' => $pkgnum,
3754 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3760 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3761 sort { $a->_date <=> $b->_date }
3762 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3765 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3767 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3769 Optionally, a list or hashref of additional arguments to the qsearch call can
3774 sub cust_pay_batch {
3776 my $opt = ref($_[0]) ? shift : { @_ };
3778 #return $self->num_cust_statement unless wantarray || keys %$opt;
3780 $opt->{'table'} = 'cust_pay_batch';
3781 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3782 $opt->{'hashref'}{'custnum'} = $self->custnum;
3783 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3785 map { $_ } #behavior of sort undefined in scalar context
3786 sort { $a->paybatchnum <=> $b->paybatchnum }
3790 =item cust_pay_pending
3792 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3793 (without status "done").
3797 sub cust_pay_pending {
3799 return $self->num_cust_pay_pending unless wantarray;
3800 sort { $a->_date <=> $b->_date }
3801 qsearch( 'cust_pay_pending', {
3802 'custnum' => $self->custnum,
3803 'status' => { op=>'!=', value=>'done' },
3808 =item cust_pay_pending_attempt
3810 Returns all payment attempts / declined payments for this customer, as pending
3811 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3812 a corresponding payment (see L<FS::cust_pay>).
3816 sub cust_pay_pending_attempt {
3818 return $self->num_cust_pay_pending_attempt unless wantarray;
3819 sort { $a->_date <=> $b->_date }
3820 qsearch( 'cust_pay_pending', {
3821 'custnum' => $self->custnum,
3828 =item num_cust_pay_pending
3830 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3831 customer (without status "done"). Also called automatically when the
3832 cust_pay_pending method is used in a scalar context.
3836 sub num_cust_pay_pending {
3839 " SELECT COUNT(*) FROM cust_pay_pending ".
3840 " WHERE custnum = ? AND status != 'done' ",
3845 =item num_cust_pay_pending_attempt
3847 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3848 customer, with status "done" but without a corresp. Also called automatically when the
3849 cust_pay_pending method is used in a scalar context.
3853 sub num_cust_pay_pending_attempt {
3856 " SELECT COUNT(*) FROM cust_pay_pending ".
3857 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3864 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3870 map { $_ } #return $self->num_cust_refund unless wantarray;
3871 sort { $a->_date <=> $b->_date }
3872 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3875 =item display_custnum
3877 Returns the displayed customer number for this customer: agent_custid if
3878 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3882 sub display_custnum {
3885 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3886 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3887 if ( $special eq 'CoStAg' ) {
3888 $prefix = uc( join('',
3890 ($self->state =~ /^(..)/),
3891 $prefix || ($self->agent->agent =~ /^(..)/)
3894 elsif ( $special eq 'CoStCl' ) {
3895 $prefix = uc( join('',
3897 ($self->state =~ /^(..)/),
3898 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3901 # add any others here if needed
3904 my $length = $conf->config('cust_main-custnum-display_length');
3905 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3906 return $self->agent_custid;
3907 } elsif ( $prefix ) {
3908 $length = 8 if !defined($length);
3910 sprintf('%0'.$length.'d', $self->custnum)
3911 } elsif ( $length ) {
3912 return sprintf('%0'.$length.'d', $self->custnum);
3914 return $self->custnum;
3920 Returns a name string for this customer, either "Company (Last, First)" or
3927 my $name = $self->contact;
3928 $name = $self->company. " ($name)" if $self->company;
3932 =item service_contact
3934 Returns the L<FS::contact> object for this customer that has the 'Service'
3935 contact class, or undef if there is no such contact. Deprecated; don't use
3940 sub service_contact {
3942 if ( !exists($self->{service_contact}) ) {
3943 my $classnum = $self->scalar_sql(
3944 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3945 ) || 0; #if it's zero, qsearchs will return nothing
3946 $self->{service_contact} = qsearchs('contact', {
3947 'classnum' => $classnum, 'custnum' => $self->custnum
3950 $self->{service_contact};
3955 Returns a name string for this (service/shipping) contact, either
3956 "Company (Last, First)" or "Last, First".
3963 my $name = $self->ship_contact;
3964 $name = $self->company. " ($name)" if $self->company;
3970 Returns a name string for this customer, either "Company" or "First Last".
3976 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3979 =item ship_name_short
3981 Returns a name string for this (service/shipping) contact, either "Company"
3986 sub ship_name_short {
3988 $self->service_contact
3989 ? $self->ship_contact_firstlast
3995 Returns this customer's full (billing) contact name only, "Last, First"
4001 $self->get('last'). ', '. $self->first;
4006 Returns this customer's full (shipping) contact name only, "Last, First"
4012 my $contact = $self->service_contact || $self;
4013 $contact->get('last') . ', ' . $contact->get('first');
4016 =item contact_firstlast
4018 Returns this customers full (billing) contact name only, "First Last".
4022 sub contact_firstlast {
4024 $self->first. ' '. $self->get('last');
4027 =item ship_contact_firstlast
4029 Returns this customer's full (shipping) contact name only, "First Last".
4033 sub ship_contact_firstlast {
4035 my $contact = $self->service_contact || $self;
4036 $contact->get('first') . ' '. $contact->get('last');
4039 #XXX this doesn't work in 3.x+
4042 #Returns this customer's full country name
4048 # code2country($self->country);
4051 =item county_state_county [ PREFIX ]
4053 Returns a string consisting of just the county, state and country.
4057 sub county_state_country {
4060 if ( @_ && $_[0] && $self->has_ship_address ) {
4061 $locationnum = $self->ship_locationnum;
4063 $locationnum = $self->bill_locationnum;
4065 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4066 $cust_location->county_state_country;
4069 =item geocode DATA_VENDOR
4071 Returns a value for the customer location as encoded by DATA_VENDOR.
4072 Currently this only makes sense for "CCH" as DATA_VENDOR.
4080 Returns a status string for this customer, currently:
4084 =item prospect - No packages have ever been ordered
4086 =item ordered - Recurring packages all are new (not yet billed).
4088 =item active - One or more recurring packages is active
4090 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4092 =item suspended - All non-cancelled recurring packages are suspended
4094 =item cancelled - All recurring packages are cancelled
4098 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4099 cust_main-status_module configuration option.
4103 sub status { shift->cust_status(@_); }
4107 for my $status ( FS::cust_main->statuses() ) {
4108 my $method = $status.'_sql';
4109 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4110 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4111 $sth->execute( ($self->custnum) x $numnum )
4112 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4113 return $status if $sth->fetchrow_arrayref->[0];
4117 =item ucfirst_cust_status
4119 =item ucfirst_status
4121 Returns the status with the first character capitalized.
4125 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4127 sub ucfirst_cust_status {
4129 ucfirst($self->cust_status);
4134 Returns a hex triplet color string for this customer's status.
4138 sub statuscolor { shift->cust_statuscolor(@_); }
4140 sub cust_statuscolor {
4142 __PACKAGE__->statuscolors->{$self->cust_status};
4145 =item tickets [ STATUS ]
4147 Returns an array of hashes representing the customer's RT tickets.
4149 An optional status (or arrayref or hashref of statuses) may be specified.
4155 my $status = ( @_ && $_[0] ) ? shift : '';
4157 my $num = $conf->config('cust_main-max_tickets') || 10;
4160 if ( $conf->config('ticket_system') ) {
4161 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4163 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4172 foreach my $priority (
4173 $conf->config('ticket_system-custom_priority_field-values'), ''
4175 last if scalar(@tickets) >= $num;
4177 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4178 $num - scalar(@tickets),
4189 # Return services representing svc_accts in customer support packages
4190 sub support_services {
4192 my %packages = map { $_ => 1 } $conf->config('support_packages');
4194 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4195 grep { $_->part_svc->svcdb eq 'svc_acct' }
4196 map { $_->cust_svc }
4197 grep { exists $packages{ $_->pkgpart } }
4198 $self->ncancelled_pkgs;
4202 # Return a list of latitude/longitude for one of the services (if any)
4203 sub service_coordinates {
4207 grep { $_->latitude && $_->longitude }
4209 map { $_->cust_svc }
4210 $self->ncancelled_pkgs;
4212 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4217 Returns a masked version of the named field
4222 my ($self,$field) = @_;
4226 'x'x(length($self->getfield($field))-4).
4227 substr($self->getfield($field), (length($self->getfield($field))-4));
4233 =head1 CLASS METHODS
4239 Class method that returns the list of possible status strings for customers
4240 (see L<the status method|/status>). For example:
4242 @statuses = FS::cust_main->statuses();
4248 keys %{ $self->statuscolors };
4251 =item cust_status_sql
4253 Returns an SQL fragment to determine the status of a cust_main record, as a
4258 sub cust_status_sql {
4260 for my $status ( FS::cust_main->statuses() ) {
4261 my $method = $status.'_sql';
4262 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4271 Returns an SQL expression identifying prospective cust_main records (customers
4272 with no packages ever ordered)
4276 use vars qw($select_count_pkgs);
4277 $select_count_pkgs =
4278 "SELECT COUNT(*) FROM cust_pkg
4279 WHERE cust_pkg.custnum = cust_main.custnum";
4281 sub select_count_pkgs_sql {
4286 " 0 = ( $select_count_pkgs ) ";
4291 Returns an SQL expression identifying ordered cust_main records (customers with
4292 no active packages, but recurring packages not yet setup or one time charges
4298 FS::cust_main->none_active_sql.
4299 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4304 Returns an SQL expression identifying active cust_main records (customers with
4305 active recurring packages).
4310 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4313 =item none_active_sql
4315 Returns an SQL expression identifying cust_main records with no active
4316 recurring packages. This includes customers of status prospect, ordered,
4317 inactive, and suspended.
4321 sub none_active_sql {
4322 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4327 Returns an SQL expression identifying inactive cust_main records (customers with
4328 no active recurring packages, but otherwise unsuspended/uncancelled).
4333 FS::cust_main->none_active_sql.
4334 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4340 Returns an SQL expression identifying suspended cust_main records.
4345 sub suspended_sql { susp_sql(@_); }
4347 FS::cust_main->none_active_sql.
4348 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4354 Returns an SQL expression identifying cancelled cust_main records.
4358 sub cancel_sql { shift->cancelled_sql(@_); }
4361 =item uncancelled_sql
4363 Returns an SQL expression identifying un-cancelled cust_main records.
4367 sub uncancelled_sql { uncancel_sql(@_); }
4368 sub uncancel_sql { "
4369 ( 0 < ( $select_count_pkgs
4370 AND ( cust_pkg.cancel IS NULL
4371 OR cust_pkg.cancel = 0
4374 OR 0 = ( $select_count_pkgs )
4380 Returns an SQL fragment to retreive the balance.
4385 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4386 WHERE cust_bill.custnum = cust_main.custnum )
4387 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4388 WHERE cust_pay.custnum = cust_main.custnum )
4389 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4390 WHERE cust_credit.custnum = cust_main.custnum )
4391 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4392 WHERE cust_refund.custnum = cust_main.custnum )
4395 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4397 Returns an SQL fragment to retreive the balance for this customer, optionally
4398 considering invoices with date earlier than START_TIME, and not
4399 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4400 total_unapplied_payments).
4402 Times are specified as SQL fragments or numeric
4403 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4404 L<Date::Parse> for conversion functions. The empty string can be passed
4405 to disable that time constraint completely.
4407 Available options are:
4411 =item unapplied_date
4413 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)
4418 set to true to remove all customer comparison clauses, for totals
4423 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4428 JOIN clause (typically used with the total option)
4432 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4433 time will be ignored. Note that START_TIME and END_TIME only limit the date
4434 range for invoices and I<unapplied> payments, credits, and refunds.
4440 sub balance_date_sql {
4441 my( $class, $start, $end, %opt ) = @_;
4443 my $cutoff = $opt{'cutoff'};
4445 my $owed = FS::cust_bill->owed_sql($cutoff);
4446 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4447 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4448 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4450 my $j = $opt{'join'} || '';
4452 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4453 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4454 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4455 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4457 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4458 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4459 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4460 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4465 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4467 Returns an SQL fragment to retreive the total unapplied payments for this
4468 customer, only considering payments with date earlier than START_TIME, and
4469 optionally not later than END_TIME.
4471 Times are specified as SQL fragments or numeric
4472 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4473 L<Date::Parse> for conversion functions. The empty string can be passed
4474 to disable that time constraint completely.
4476 Available options are:
4480 sub unapplied_payments_date_sql {
4481 my( $class, $start, $end, %opt ) = @_;
4483 my $cutoff = $opt{'cutoff'};
4485 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4487 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4488 'unapplied_date'=>1 );
4490 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4493 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4495 Helper method for balance_date_sql; name (and usage) subject to change
4496 (suggestions welcome).
4498 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4499 cust_refund, cust_credit or cust_pay).
4501 If TABLE is "cust_bill" or the unapplied_date option is true, only
4502 considers records with date earlier than START_TIME, and optionally not
4503 later than END_TIME .
4507 sub _money_table_where {
4508 my( $class, $table, $start, $end, %opt ) = @_;
4511 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4512 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4513 push @where, "$table._date <= $start" if defined($start) && length($start);
4514 push @where, "$table._date > $end" if defined($end) && length($end);
4516 push @where, @{$opt{'where'}} if $opt{'where'};
4517 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4523 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4524 use FS::cust_main::Search;
4527 FS::cust_main::Search->search(@_);
4542 #warn join('-',keys %$param);
4543 my $fh = $param->{filehandle};
4544 my $agentnum = $param->{agentnum};
4545 my $format = $param->{format};
4547 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4550 if ( $format eq 'simple' ) {
4551 @fields = qw( custnum agent_custid amount pkg );
4553 die "unknown format $format";
4556 eval "use Text::CSV_XS;";
4559 my $csv = new Text::CSV_XS;
4566 local $SIG{HUP} = 'IGNORE';
4567 local $SIG{INT} = 'IGNORE';
4568 local $SIG{QUIT} = 'IGNORE';
4569 local $SIG{TERM} = 'IGNORE';
4570 local $SIG{TSTP} = 'IGNORE';
4571 local $SIG{PIPE} = 'IGNORE';
4573 my $oldAutoCommit = $FS::UID::AutoCommit;
4574 local $FS::UID::AutoCommit = 0;
4577 #while ( $columns = $csv->getline($fh) ) {
4579 while ( defined($line=<$fh>) ) {
4581 $csv->parse($line) or do {
4582 $dbh->rollback if $oldAutoCommit;
4583 return "can't parse: ". $csv->error_input();
4586 my @columns = $csv->fields();
4587 #warn join('-',@columns);
4590 foreach my $field ( @fields ) {
4591 $row{$field} = shift @columns;
4594 if ( $row{custnum} && $row{agent_custid} ) {
4595 dbh->rollback if $oldAutoCommit;
4596 return "can't specify custnum with agent_custid $row{agent_custid}";
4600 if ( $row{agent_custid} && $agentnum ) {
4601 %hash = ( 'agent_custid' => $row{agent_custid},
4602 'agentnum' => $agentnum,
4606 if ( $row{custnum} ) {
4607 %hash = ( 'custnum' => $row{custnum} );
4610 unless ( scalar(keys %hash) ) {
4611 $dbh->rollback if $oldAutoCommit;
4612 return "can't find customer without custnum or agent_custid and agentnum";
4615 my $cust_main = qsearchs('cust_main', { %hash } );
4616 unless ( $cust_main ) {
4617 $dbh->rollback if $oldAutoCommit;
4618 my $custnum = $row{custnum} || $row{agent_custid};
4619 return "unknown custnum $custnum";
4622 if ( $row{'amount'} > 0 ) {
4623 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4625 $dbh->rollback if $oldAutoCommit;
4629 } elsif ( $row{'amount'} < 0 ) {
4630 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4633 $dbh->rollback if $oldAutoCommit;
4643 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4645 return "Empty file!" unless $imported;
4651 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4653 Deprecated. Use event notification and message templates
4654 (L<FS::msg_template>) instead.
4656 Sends a templated email notification to the customer (see L<Text::Template>).
4658 OPTIONS is a hash and may include
4660 I<from> - the email sender (default is invoice_from)
4662 I<to> - comma-separated scalar or arrayref of recipients
4663 (default is invoicing_list)
4665 I<subject> - The subject line of the sent email notification
4666 (default is "Notice from company_name")
4668 I<extra_fields> - a hashref of name/value pairs which will be substituted
4671 The following variables are vavailable in the template.
4673 I<$first> - the customer first name
4674 I<$last> - the customer last name
4675 I<$company> - the customer company
4676 I<$payby> - a description of the method of payment for the customer
4677 # would be nice to use FS::payby::shortname
4678 I<$payinfo> - the account information used to collect for this customer
4679 I<$expdate> - the expiration of the customer payment in seconds from epoch
4684 my ($self, $template, %options) = @_;
4686 return unless $conf->exists($template);
4688 my $from = $conf->config('invoice_from', $self->agentnum)
4689 if $conf->exists('invoice_from', $self->agentnum);
4690 $from = $options{from} if exists($options{from});
4692 my $to = join(',', $self->invoicing_list_emailonly);
4693 $to = $options{to} if exists($options{to});
4695 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4696 if $conf->exists('company_name', $self->agentnum);
4697 $subject = $options{subject} if exists($options{subject});
4699 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4700 SOURCE => [ map "$_\n",
4701 $conf->config($template)]
4703 or die "can't create new Text::Template object: Text::Template::ERROR";
4704 $notify_template->compile()
4705 or die "can't compile template: Text::Template::ERROR";
4707 $FS::notify_template::_template::company_name =
4708 $conf->config('company_name', $self->agentnum);
4709 $FS::notify_template::_template::company_address =
4710 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4712 my $paydate = $self->paydate || '2037-12-31';
4713 $FS::notify_template::_template::first = $self->first;
4714 $FS::notify_template::_template::last = $self->last;
4715 $FS::notify_template::_template::company = $self->company;
4716 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4717 my $payby = $self->payby;
4718 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4719 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4721 #credit cards expire at the end of the month/year of their exp date
4722 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4723 $FS::notify_template::_template::payby = 'credit card';
4724 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4725 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4727 }elsif ($payby eq 'COMP') {
4728 $FS::notify_template::_template::payby = 'complimentary account';
4730 $FS::notify_template::_template::payby = 'current method';
4732 $FS::notify_template::_template::expdate = $expire_time;
4734 for (keys %{$options{extra_fields}}){
4736 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4739 send_email(from => $from,
4741 subject => $subject,
4742 body => $notify_template->fill_in( PACKAGE =>
4743 'FS::notify_template::_template' ),
4748 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4750 Generates a templated notification to the customer (see L<Text::Template>).
4752 OPTIONS is a hash and may include
4754 I<extra_fields> - a hashref of name/value pairs which will be substituted
4755 into the template. These values may override values mentioned below
4756 and those from the customer record.
4758 The following variables are available in the template instead of or in addition
4759 to the fields of the customer record.
4761 I<$payby> - a description of the method of payment for the customer
4762 # would be nice to use FS::payby::shortname
4763 I<$payinfo> - the masked account information used to collect for this customer
4764 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4765 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4769 # a lot like cust_bill::print_latex
4770 sub generate_letter {
4771 my ($self, $template, %options) = @_;
4773 return unless $conf->exists($template);
4775 my $letter_template = new Text::Template
4777 SOURCE => [ map "$_\n", $conf->config($template)],
4778 DELIMITERS => [ '[@--', '--@]' ],
4780 or die "can't create new Text::Template object: Text::Template::ERROR";
4782 $letter_template->compile()
4783 or die "can't compile template: Text::Template::ERROR";
4785 my %letter_data = map { $_ => $self->$_ } $self->fields;
4786 $letter_data{payinfo} = $self->mask_payinfo;
4788 #my $paydate = $self->paydate || '2037-12-31';
4789 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4791 my $payby = $self->payby;
4792 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4793 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4795 #credit cards expire at the end of the month/year of their exp date
4796 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4797 $letter_data{payby} = 'credit card';
4798 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4799 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4801 }elsif ($payby eq 'COMP') {
4802 $letter_data{payby} = 'complimentary account';
4804 $letter_data{payby} = 'current method';
4806 $letter_data{expdate} = $expire_time;
4808 for (keys %{$options{extra_fields}}){
4809 $letter_data{$_} = $options{extra_fields}->{$_};
4812 unless(exists($letter_data{returnaddress})){
4813 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4814 $self->agent_template)
4816 if ( length($retadd) ) {
4817 $letter_data{returnaddress} = $retadd;
4818 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4819 $letter_data{returnaddress} =
4820 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4824 ( $conf->config('company_name', $self->agentnum),
4825 $conf->config('company_address', $self->agentnum),
4829 $letter_data{returnaddress} = '~';
4833 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4835 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4837 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4839 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4843 ) or die "can't open temp file: $!\n";
4844 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4845 or die "can't write temp file: $!\n";
4847 $letter_data{'logo_file'} = $lh->filename;
4849 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4853 ) or die "can't open temp file: $!\n";
4855 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4857 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4858 return ($1, $letter_data{'logo_file'});
4862 =item print_ps TEMPLATE
4864 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4870 my($file, $lfile) = $self->generate_letter(@_);
4871 my $ps = FS::Misc::generate_ps($file);
4872 unlink($file.'.tex');
4878 =item print TEMPLATE
4880 Prints the filled in template.
4882 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4886 sub queueable_print {
4889 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4890 or die "invalid customer number: " . $opt{custvnum};
4892 my $error = $self->print( $opt{template} );
4893 die $error if $error;
4897 my ($self, $template) = (shift, shift);
4899 [ $self->print_ps($template) ],
4900 'agentnum' => $self->agentnum,
4904 #these three subs should just go away once agent stuff is all config overrides
4906 sub agent_template {
4908 $self->_agent_plandata('agent_templatename');
4911 sub agent_invoice_from {
4913 $self->_agent_plandata('agent_invoice_from');
4916 sub _agent_plandata {
4917 my( $self, $option ) = @_;
4919 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4920 #agent-specific Conf
4922 use FS::part_event::Condition;
4924 my $agentnum = $self->agentnum;
4926 my $regexp = regexp_sql();
4928 my $part_event_option =
4930 'select' => 'part_event_option.*',
4931 'table' => 'part_event_option',
4933 LEFT JOIN part_event USING ( eventpart )
4934 LEFT JOIN part_event_option AS peo_agentnum
4935 ON ( part_event.eventpart = peo_agentnum.eventpart
4936 AND peo_agentnum.optionname = 'agentnum'
4937 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4939 LEFT JOIN part_event_condition
4940 ON ( part_event.eventpart = part_event_condition.eventpart
4941 AND part_event_condition.conditionname = 'cust_bill_age'
4943 LEFT JOIN part_event_condition_option
4944 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4945 AND part_event_condition_option.optionname = 'age'
4948 #'hashref' => { 'optionname' => $option },
4949 #'hashref' => { 'part_event_option.optionname' => $option },
4951 " WHERE part_event_option.optionname = ". dbh->quote($option).
4952 " AND action = 'cust_bill_send_agent' ".
4953 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4954 " AND peo_agentnum.optionname = 'agentnum' ".
4955 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4957 CASE WHEN part_event_condition_option.optionname IS NULL
4959 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4961 , part_event.weight".
4965 unless ( $part_event_option ) {
4966 return $self->agent->invoice_template || ''
4967 if $option eq 'agent_templatename';
4971 $part_event_option->optionvalue;
4975 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4977 Subroutine (not a method), designed to be called from the queue.
4979 Takes a list of options and values.
4981 Pulls up the customer record via the custnum option and calls bill_and_collect.
4986 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4988 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4989 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4991 $cust_main->bill_and_collect( %args );
4994 sub process_bill_and_collect {
4996 my $param = thaw(decode_base64(shift));
4997 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4998 or die "custnum '$param->{custnum}' not found!\n";
4999 $param->{'job'} = $job;
5000 $param->{'fatal'} = 1; # runs from job queue, will be caught
5001 $param->{'retry'} = 1;
5003 $cust_main->bill_and_collect( %$param );
5006 #starting to take quite a while for big dbs
5007 # (JRNL: journaled so it only happens once per database)
5008 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5009 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5010 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5011 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5012 # JRNL leading/trailing spaces in first, last, company
5013 # - otaker upgrade? journal and call it good? (double check to make sure
5014 # we're not still setting otaker here)
5016 #only going to get worse with new location stuff...
5018 sub _upgrade_data { #class method
5019 my ($class, %opts) = @_;
5022 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5025 #this seems to be the only expensive one.. why does it take so long?
5026 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5028 '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';
5029 FS::upgrade_journal->set_done('cust_main__signupdate');
5032 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5034 # fix yyyy-m-dd formatted paydates
5035 if ( driver_name =~ /^mysql/i ) {
5037 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5038 } else { # the SQL standard
5040 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5042 FS::upgrade_journal->set_done('cust_main__paydate');
5045 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5047 push @statements, #fix the weird BILL with a cc# in payinfo problem
5049 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5051 FS::upgrade_journal->set_done('cust_main__payinfo');
5056 foreach my $sql ( @statements ) {
5057 my $sth = dbh->prepare($sql) or die dbh->errstr;
5058 $sth->execute or die $sth->errstr;
5059 #warn ( (time - $t). " seconds\n" );
5063 local($ignore_expired_card) = 1;
5064 local($ignore_banned_card) = 1;
5065 local($skip_fuzzyfiles) = 1;
5066 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5068 FS::cust_main::Location->_upgrade_data(%opts);
5070 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5072 foreach my $cust_main ( qsearch({
5073 'table' => 'cust_main',
5075 'extra_sql' => 'WHERE '.
5077 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5078 qw( first last company )
5081 my $error = $cust_main->replace;
5082 die $error if $error;
5085 FS::upgrade_journal->set_done('cust_main__trimspaces');
5089 $class->_upgrade_otaker(%opts);
5099 The delete method should possibly take an FS::cust_main object reference
5100 instead of a scalar customer number.
5102 Bill and collect options should probably be passed as references instead of a
5105 There should probably be a configuration file with a list of allowed credit
5108 No multiple currency support (probably a larger project than just this module).
5110 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5112 Birthdates rely on negative epoch values.
5114 The payby for card/check batches is broken. With mixed batching, bad
5117 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5121 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5122 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5123 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.