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::cust_main::Credit_Limit
12 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
13 FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
17 use vars qw( $DEBUG $me $conf
20 $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
25 use Scalar::Util qw( blessed );
26 use Time::Local qw(timelocal);
27 use Storable qw(thaw);
31 use Digest::MD5 qw(md5_base64);
34 use File::Temp; #qw( tempfile );
35 use Business::CreditCard 0.28;
37 use FS::UID qw( getotaker dbh driver_name );
38 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
39 use FS::Misc qw( generate_email send_email generate_ps do_print );
40 use FS::Msgcat qw(gettext);
47 use FS::cust_bill_void;
48 use FS::legacy_cust_bill;
50 use FS::cust_pay_pending;
51 use FS::cust_pay_void;
52 use FS::cust_pay_batch;
55 use FS::part_referral;
56 use FS::cust_main_county;
57 use FS::cust_location;
59 use FS::cust_main_exemption;
60 use FS::cust_tax_adjustment;
61 use FS::cust_tax_location;
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;
80 # 1 is mostly method/subroutine entry and options
81 # 2 traces progress of some operations
82 # 3 is even more information including possibly sensitive data
84 $me = '[FS::cust_main]';
87 $ignore_expired_card = 0;
88 $ignore_banned_card = 0;
92 @encrypted_fields = ('payinfo', 'paycvv');
93 sub nohistory_fields { ('payinfo', 'paycvv'); }
95 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
97 #ask FS::UID to run this stuff for us later
98 #$FS::UID::callback{'FS::cust_main'} = sub {
99 install_callback FS::UID sub {
100 $conf = new FS::Conf;
101 #yes, need it for stuff below (prolly should be cached)
106 my ( $hashref, $cache ) = @_;
107 if ( exists $hashref->{'pkgnum'} ) {
108 #@{ $self->{'_pkgnum'} } = ();
109 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
110 $self->{'_pkgnum'} = $subcache;
111 #push @{ $self->{'_pkgnum'} },
112 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
118 FS::cust_main - Object methods for cust_main records
124 $record = new FS::cust_main \%hash;
125 $record = new FS::cust_main { 'column' => 'value' };
127 $error = $record->insert;
129 $error = $new_record->replace($old_record);
131 $error = $record->delete;
133 $error = $record->check;
135 @cust_pkg = $record->all_pkgs;
137 @cust_pkg = $record->ncancelled_pkgs;
139 @cust_pkg = $record->suspended_pkgs;
141 $error = $record->bill;
142 $error = $record->bill %options;
143 $error = $record->bill 'time' => $time;
145 $error = $record->collect;
146 $error = $record->collect %options;
147 $error = $record->collect 'invoice_time' => $time,
152 An FS::cust_main object represents a customer. FS::cust_main inherits from
153 FS::Record. The following fields are currently supported:
159 Primary key (assigned automatically for new customers)
163 Agent (see L<FS::agent>)
167 Advertising source (see L<FS::part_referral>)
179 Cocial security number (optional)
203 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
207 Payment Information (See L<FS::payinfo_Mixin> for data format)
211 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
215 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
219 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
223 Start date month (maestro/solo cards only)
227 Start date year (maestro/solo cards only)
231 Issue number (maestro/solo cards only)
235 Name on card or billing name
239 IP address from which payment information was received
243 Tax exempt, empty or `Y'
247 Order taker (see L<FS::access_user>)
253 =item referral_custnum
255 Referring customer number
259 Enable individual CDR spooling, empty or `Y'
263 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
267 Discourage individual CDR printing, empty or `Y'
271 Allow self-service editing of ticket subjects, empty or 'Y'
273 =item calling_list_exempt
275 Do not call, empty or 'Y'
277 =item invoice_ship_address
279 Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
289 Creates a new customer. To add the customer to the database, see L<"insert">.
291 Note that this stores the hash reference, not a distinct copy of the hash it
292 points to. You can ask the object for a copy with the I<hash> method.
296 sub table { 'cust_main'; }
298 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
300 Adds this customer to the database. If there is an error, returns the error,
301 otherwise returns false.
303 Usually the customer's location will not yet exist in the database, and
304 the C<bill_location> and C<ship_location> pseudo-fields must be set to
305 uninserted L<FS::cust_location> objects. These will be inserted and linked
306 (in both directions) to the new customer record. If they're references
307 to the same object, they will become the same location.
309 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
310 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
311 are inserted atomicly, or the transaction is rolled back. Passing an empty
312 hash reference is equivalent to not supplying this parameter. There should be
313 a better explanation of this, but until then, here's an example:
316 tie %hash, 'Tie::RefHash'; #this part is important
318 $cust_pkg => [ $svc_acct ],
321 $cust_main->insert( \%hash );
323 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
324 be set as the invoicing list (see L<"invoicing_list">). Errors return as
325 expected and rollback the entire transaction; it is not necessary to call
326 check_invoicing_list first. The invoicing_list is set after the records in the
327 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
328 invoicing_list destination to the newly-created svc_acct. Here's an example:
330 $cust_main->insert( {}, [ $email, 'POST' ] );
332 Currently available options are: I<depend_jobnum>, I<noexport>,
333 I<tax_exemption> and I<prospectnum>.
335 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
336 on the supplied jobnum (they will not run until the specific job completes).
337 This can be used to defer provisioning until some action completes (such
338 as running the customer's credit card successfully).
340 The I<noexport> option is deprecated. If I<noexport> is set true, no
341 provisioning jobs (exports) are scheduled. (You can schedule them later with
342 the B<reexport> method.)
344 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
345 of tax names and exemption numbers. FS::cust_main_exemption records will be
346 created and inserted.
348 If I<prospectnum> is set, moves contacts and locations from that prospect.
354 my $cust_pkgs = @_ ? shift : {};
355 my $invoicing_list = @_ ? shift : '';
357 warn "$me insert called with options ".
358 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
361 local $SIG{HUP} = 'IGNORE';
362 local $SIG{INT} = 'IGNORE';
363 local $SIG{QUIT} = 'IGNORE';
364 local $SIG{TERM} = 'IGNORE';
365 local $SIG{TSTP} = 'IGNORE';
366 local $SIG{PIPE} = 'IGNORE';
368 my $oldAutoCommit = $FS::UID::AutoCommit;
369 local $FS::UID::AutoCommit = 0;
372 my $prepay_identifier = '';
373 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
375 if ( $self->payby eq 'PREPAY' ) {
377 $self->payby('BILL');
378 $prepay_identifier = $self->payinfo;
381 warn " looking up prepaid card $prepay_identifier\n"
384 my $error = $self->get_prepay( $prepay_identifier,
385 'amount_ref' => \$amount,
386 'seconds_ref' => \$seconds,
387 'upbytes_ref' => \$upbytes,
388 'downbytes_ref' => \$downbytes,
389 'totalbytes_ref' => \$totalbytes,
392 $dbh->rollback if $oldAutoCommit;
393 #return "error applying prepaid card (transaction rolled back): $error";
397 $payby = 'PREP' if $amount;
399 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
402 $self->payby('BILL');
403 $amount = $self->paid;
408 foreach my $l (qw(bill_location ship_location)) {
410 my $loc = delete $self->hashref->{$l} or return "$l not set";
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->prospectnum ) {
426 $loc->prospectnum('');
427 $loc->set(custnum_pending => 1);
428 my $error = $loc->replace;
430 $dbh->rollback if $oldAutoCommit;
431 my $label = $l eq 'ship_location' ? 'service' : 'billing';
432 return "$error (moving $label location)";
435 } elsif ( ($loc->custnum || 0) > 0 ) {
436 # then it somehow belongs to another customer--shouldn't happen
437 $dbh->rollback if $oldAutoCommit;
438 return "$l belongs to customer ".$loc->custnum;
440 # else it already belongs to this customer
441 # (happens when ship_location is identical to bill_location)
443 $self->set($l.'num', $loc->locationnum);
445 if ( $self->get($l.'num') eq '' ) {
446 $dbh->rollback if $oldAutoCommit;
451 warn " inserting $self\n"
454 $self->signupdate(time) unless $self->signupdate;
456 $self->auto_agent_custid()
457 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
459 my $error = $self->SUPER::insert;
461 $dbh->rollback if $oldAutoCommit;
462 #return "inserting cust_main record (transaction rolled back): $error";
466 # now set cust_location.custnum
467 foreach my $l (qw(bill_location ship_location)) {
468 warn " setting $l.custnum\n"
471 unless ( $loc->custnum ) {
472 $loc->set(custnum => $self->custnum);
473 $error ||= $loc->replace;
477 $dbh->rollback if $oldAutoCommit;
478 return "error setting $l custnum: $error";
482 warn " setting invoicing list\n"
485 if ( $invoicing_list ) {
486 $error = $self->check_invoicing_list( $invoicing_list );
488 $dbh->rollback if $oldAutoCommit;
489 #return "checking invoicing_list (transaction rolled back): $error";
492 $self->invoicing_list( $invoicing_list );
495 warn " setting customer tags\n"
498 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
499 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
500 'custnum' => $self->custnum };
501 my $error = $cust_tag->insert;
503 $dbh->rollback if $oldAutoCommit;
508 my $prospectnum = delete $options{'prospectnum'};
509 if ( $prospectnum ) {
511 warn " moving contacts and locations from prospect $prospectnum\n"
515 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
516 unless ( $prospect_main ) {
517 $dbh->rollback if $oldAutoCommit;
518 return "Unknown prospectnum $prospectnum";
520 $prospect_main->custnum($self->custnum);
521 $prospect_main->disabled('Y');
522 my $error = $prospect_main->replace;
524 $dbh->rollback if $oldAutoCommit;
528 my @contact = $prospect_main->contact;
529 my @cust_location = $prospect_main->cust_location;
530 my @qual = $prospect_main->qual;
532 foreach my $r ( @contact, @cust_location, @qual ) {
534 $r->custnum($self->custnum);
535 my $error = $r->replace;
537 $dbh->rollback if $oldAutoCommit;
544 warn " setting cust_main_exemption\n"
547 my $tax_exemption = delete $options{'tax_exemption'};
548 if ( $tax_exemption ) {
550 $tax_exemption = { map { $_ => '' } @$tax_exemption }
551 if ref($tax_exemption) eq 'ARRAY';
553 foreach my $taxname ( keys %$tax_exemption ) {
554 my $cust_main_exemption = new FS::cust_main_exemption {
555 'custnum' => $self->custnum,
556 'taxname' => $taxname,
557 'exempt_number' => $tax_exemption->{$taxname},
559 my $error = $cust_main_exemption->insert;
561 $dbh->rollback if $oldAutoCommit;
562 return "inserting cust_main_exemption (transaction rolled back): $error";
567 warn " ordering packages\n"
570 $error = $self->order_pkgs( $cust_pkgs,
572 'seconds_ref' => \$seconds,
573 'upbytes_ref' => \$upbytes,
574 'downbytes_ref' => \$downbytes,
575 'totalbytes_ref' => \$totalbytes,
578 $dbh->rollback if $oldAutoCommit;
583 $dbh->rollback if $oldAutoCommit;
584 return "No svc_acct record to apply pre-paid time";
586 if ( $upbytes || $downbytes || $totalbytes ) {
587 $dbh->rollback if $oldAutoCommit;
588 return "No svc_acct record to apply pre-paid data";
592 warn " inserting initial $payby payment of $amount\n"
594 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
596 $dbh->rollback if $oldAutoCommit;
597 return "inserting payment (transaction rolled back): $error";
601 unless ( $import || $skip_fuzzyfiles ) {
602 warn " queueing fuzzyfiles update\n"
604 $error = $self->queue_fuzzyfiles_update;
606 $dbh->rollback if $oldAutoCommit;
607 return "updating fuzzy search cache: $error";
611 # FS::geocode_Mixin::after_insert or something?
612 if ( $conf->config('tax_district_method') and !$import ) {
613 # if anything non-empty, try to look it up
614 my $queue = new FS::queue {
615 'job' => 'FS::geocode_Mixin::process_district_update',
616 'custnum' => $self->custnum,
618 my $error = $queue->insert( ref($self), $self->custnum );
620 $dbh->rollback if $oldAutoCommit;
621 return "queueing tax district update: $error";
626 warn " exporting\n" if $DEBUG > 1;
628 my $export_args = $options{'export_args'} || [];
631 map qsearch( 'part_export', {exportnum=>$_} ),
632 $conf->config('cust_main-exports'); #, $agentnum
634 foreach my $part_export ( @part_export ) {
635 my $error = $part_export->export_insert($self, @$export_args);
637 $dbh->rollback if $oldAutoCommit;
638 return "exporting to ". $part_export->exporttype.
639 " (transaction rolled back): $error";
643 #foreach my $depend_jobnum ( @$depend_jobnums ) {
644 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
646 # foreach my $jobnum ( @jobnums ) {
647 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
648 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
650 # my $error = $queue->depend_insert($depend_jobnum);
652 # $dbh->rollback if $oldAutoCommit;
653 # return "error queuing job dependancy: $error";
660 #if ( exists $options{'jobnums'} ) {
661 # push @{ $options{'jobnums'} }, @jobnums;
664 warn " insert complete; committing transaction\n"
667 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
672 use File::CounterFile;
673 sub auto_agent_custid {
676 my $format = $conf->config('cust_main-auto_agent_custid');
678 if ( $format eq '1YMMXXXXXXXX' ) {
680 my $counter = new File::CounterFile 'cust_main.agent_custid';
683 my $ym = 100000000000 + time2str('%y%m00000000', time);
684 if ( $ym > $counter->value ) {
685 $counter->{'value'} = $agent_custid = $ym;
686 $counter->{'updated'} = 1;
688 $agent_custid = $counter->inc;
694 die "Unknown cust_main-auto_agent_custid format: $format";
697 $self->agent_custid($agent_custid);
701 =item PACKAGE METHODS
703 Documentation on customer package methods has been moved to
704 L<FS::cust_main::Packages>.
706 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
708 Recharges this (existing) customer with the specified prepaid card (see
709 L<FS::prepay_credit>), specified either by I<identifier> or as an
710 FS::prepay_credit object. If there is an error, returns the error, otherwise
713 Optionally, five scalar references can be passed as well. They will have their
714 values filled in with the amount, number of seconds, and number of upload,
715 download, and total bytes applied by this prepaid card.
719 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
720 #the only place that uses these args
721 sub recharge_prepay {
722 my( $self, $prepay_credit, $amountref, $secondsref,
723 $upbytesref, $downbytesref, $totalbytesref ) = @_;
725 local $SIG{HUP} = 'IGNORE';
726 local $SIG{INT} = 'IGNORE';
727 local $SIG{QUIT} = 'IGNORE';
728 local $SIG{TERM} = 'IGNORE';
729 local $SIG{TSTP} = 'IGNORE';
730 local $SIG{PIPE} = 'IGNORE';
732 my $oldAutoCommit = $FS::UID::AutoCommit;
733 local $FS::UID::AutoCommit = 0;
736 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
738 my $error = $self->get_prepay( $prepay_credit,
739 'amount_ref' => \$amount,
740 'seconds_ref' => \$seconds,
741 'upbytes_ref' => \$upbytes,
742 'downbytes_ref' => \$downbytes,
743 'totalbytes_ref' => \$totalbytes,
745 || $self->increment_seconds($seconds)
746 || $self->increment_upbytes($upbytes)
747 || $self->increment_downbytes($downbytes)
748 || $self->increment_totalbytes($totalbytes)
749 || $self->insert_cust_pay_prepay( $amount,
751 ? $prepay_credit->identifier
756 $dbh->rollback if $oldAutoCommit;
760 if ( defined($amountref) ) { $$amountref = $amount; }
761 if ( defined($secondsref) ) { $$secondsref = $seconds; }
762 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
763 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
764 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
766 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
771 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
773 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
774 specified either by I<identifier> or as an FS::prepay_credit object.
776 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
777 incremented by the values of the prepaid card.
779 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
780 check or set this customer's I<agentnum>.
782 If there is an error, returns the error, otherwise returns false.
788 my( $self, $prepay_credit, %opt ) = @_;
790 local $SIG{HUP} = 'IGNORE';
791 local $SIG{INT} = 'IGNORE';
792 local $SIG{QUIT} = 'IGNORE';
793 local $SIG{TERM} = 'IGNORE';
794 local $SIG{TSTP} = 'IGNORE';
795 local $SIG{PIPE} = 'IGNORE';
797 my $oldAutoCommit = $FS::UID::AutoCommit;
798 local $FS::UID::AutoCommit = 0;
801 unless ( ref($prepay_credit) ) {
803 my $identifier = $prepay_credit;
805 $prepay_credit = qsearchs(
807 { 'identifier' => $identifier },
812 unless ( $prepay_credit ) {
813 $dbh->rollback if $oldAutoCommit;
814 return "Invalid prepaid card: ". $identifier;
819 if ( $prepay_credit->agentnum ) {
820 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
821 $dbh->rollback if $oldAutoCommit;
822 return "prepaid card not valid for agent ". $self->agentnum;
824 $self->agentnum($prepay_credit->agentnum);
827 my $error = $prepay_credit->delete;
829 $dbh->rollback if $oldAutoCommit;
830 return "removing prepay_credit (transaction rolled back): $error";
833 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
834 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
836 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
841 =item increment_upbytes SECONDS
843 Updates this customer's single or primary account (see L<FS::svc_acct>) by
844 the specified number of upbytes. If there is an error, returns the error,
845 otherwise returns false.
849 sub increment_upbytes {
850 _increment_column( shift, 'upbytes', @_);
853 =item increment_downbytes SECONDS
855 Updates this customer's single or primary account (see L<FS::svc_acct>) by
856 the specified number of downbytes. If there is an error, returns the error,
857 otherwise returns false.
861 sub increment_downbytes {
862 _increment_column( shift, 'downbytes', @_);
865 =item increment_totalbytes SECONDS
867 Updates this customer's single or primary account (see L<FS::svc_acct>) by
868 the specified number of totalbytes. If there is an error, returns the error,
869 otherwise returns false.
873 sub increment_totalbytes {
874 _increment_column( shift, 'totalbytes', @_);
877 =item increment_seconds SECONDS
879 Updates this customer's single or primary account (see L<FS::svc_acct>) by
880 the specified number of seconds. If there is an error, returns the error,
881 otherwise returns false.
885 sub increment_seconds {
886 _increment_column( shift, 'seconds', @_);
889 =item _increment_column AMOUNT
891 Updates this customer's single or primary account (see L<FS::svc_acct>) by
892 the specified number of seconds or bytes. If there is an error, returns
893 the error, otherwise returns false.
897 sub _increment_column {
898 my( $self, $column, $amount ) = @_;
899 warn "$me increment_column called: $column, $amount\n"
902 return '' unless $amount;
904 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
905 $self->ncancelled_pkgs;
908 return 'No packages with primary or single services found'.
909 ' to apply pre-paid time';
910 } elsif ( scalar(@cust_pkg) > 1 ) {
911 #maybe have a way to specify the package/account?
912 return 'Multiple packages found to apply pre-paid time';
915 my $cust_pkg = $cust_pkg[0];
916 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
920 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
923 return 'No account found to apply pre-paid time';
924 } elsif ( scalar(@cust_svc) > 1 ) {
925 return 'Multiple accounts found to apply pre-paid time';
928 my $svc_acct = $cust_svc[0]->svc_x;
929 warn " found service svcnum ". $svc_acct->pkgnum.
930 ' ('. $svc_acct->email. ")\n"
933 $column = "increment_$column";
934 $svc_acct->$column($amount);
938 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
940 Inserts a prepayment in the specified amount for this customer. An optional
941 second argument can specify the prepayment identifier for tracking purposes.
942 If there is an error, returns the error, otherwise returns false.
946 sub insert_cust_pay_prepay {
947 shift->insert_cust_pay('PREP', @_);
950 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
952 Inserts a cash payment in the specified amount for this customer. An optional
953 second argument can specify the payment identifier for tracking purposes.
954 If there is an error, returns the error, otherwise returns false.
958 sub insert_cust_pay_cash {
959 shift->insert_cust_pay('CASH', @_);
962 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
964 Inserts a Western Union payment in the specified amount for this customer. An
965 optional second argument can specify the prepayment identifier for tracking
966 purposes. If there is an error, returns the error, otherwise returns false.
970 sub insert_cust_pay_west {
971 shift->insert_cust_pay('WEST', @_);
974 sub insert_cust_pay {
975 my( $self, $payby, $amount ) = splice(@_, 0, 3);
976 my $payinfo = scalar(@_) ? shift : '';
978 my $cust_pay = new FS::cust_pay {
979 'custnum' => $self->custnum,
980 'paid' => sprintf('%.2f', $amount),
981 #'_date' => #date the prepaid card was purchased???
983 'payinfo' => $payinfo,
991 This method is deprecated. See the I<depend_jobnum> option to the insert and
992 order_pkgs methods for a better way to defer provisioning.
994 Re-schedules all exports by calling the B<reexport> method of all associated
995 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
996 otherwise returns false.
1003 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1004 "use the depend_jobnum option to insert or order_pkgs to delay export";
1006 local $SIG{HUP} = 'IGNORE';
1007 local $SIG{INT} = 'IGNORE';
1008 local $SIG{QUIT} = 'IGNORE';
1009 local $SIG{TERM} = 'IGNORE';
1010 local $SIG{TSTP} = 'IGNORE';
1011 local $SIG{PIPE} = 'IGNORE';
1013 my $oldAutoCommit = $FS::UID::AutoCommit;
1014 local $FS::UID::AutoCommit = 0;
1017 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1018 my $error = $cust_pkg->reexport;
1020 $dbh->rollback if $oldAutoCommit;
1025 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1030 =item delete [ OPTION => VALUE ... ]
1032 This deletes the customer. If there is an error, returns the error, otherwise
1035 This will completely remove all traces of the customer record. This is not
1036 what you want when a customer cancels service; for that, cancel all of the
1037 customer's packages (see L</cancel>).
1039 If the customer has any uncancelled packages, you need to pass a new (valid)
1040 customer number for those packages to be transferred to, as the "new_customer"
1041 option. Cancelled packages will be deleted. Did I mention that this is NOT
1042 what you want when a customer cancels service and that you really should be
1043 looking at L<FS::cust_pkg/cancel>?
1045 You can't delete a customer with invoices (see L<FS::cust_bill>),
1046 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1047 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1048 set the "delete_financials" option to a true value.
1053 my( $self, %opt ) = @_;
1055 local $SIG{HUP} = 'IGNORE';
1056 local $SIG{INT} = 'IGNORE';
1057 local $SIG{QUIT} = 'IGNORE';
1058 local $SIG{TERM} = 'IGNORE';
1059 local $SIG{TSTP} = 'IGNORE';
1060 local $SIG{PIPE} = 'IGNORE';
1062 my $oldAutoCommit = $FS::UID::AutoCommit;
1063 local $FS::UID::AutoCommit = 0;
1066 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1067 $dbh->rollback if $oldAutoCommit;
1068 return "Can't delete a master agent customer";
1071 #use FS::access_user
1072 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1073 $dbh->rollback if $oldAutoCommit;
1074 return "Can't delete a master employee customer";
1077 tie my %financial_tables, 'Tie::IxHash',
1078 'cust_bill' => 'invoices',
1079 'cust_statement' => 'statements',
1080 'cust_credit' => 'credits',
1081 'cust_pay' => 'payments',
1082 'cust_refund' => 'refunds',
1085 foreach my $table ( keys %financial_tables ) {
1087 my @records = $self->$table();
1089 if ( @records && ! $opt{'delete_financials'} ) {
1090 $dbh->rollback if $oldAutoCommit;
1091 return "Can't delete a customer with ". $financial_tables{$table};
1094 foreach my $record ( @records ) {
1095 my $error = $record->delete;
1097 $dbh->rollback if $oldAutoCommit;
1098 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1104 my @cust_pkg = $self->ncancelled_pkgs;
1106 my $new_custnum = $opt{'new_custnum'};
1107 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1108 $dbh->rollback if $oldAutoCommit;
1109 return "Invalid new customer number: $new_custnum";
1111 foreach my $cust_pkg ( @cust_pkg ) {
1112 my %hash = $cust_pkg->hash;
1113 $hash{'custnum'} = $new_custnum;
1114 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1115 my $error = $new_cust_pkg->replace($cust_pkg,
1116 options => { $cust_pkg->options },
1119 $dbh->rollback if $oldAutoCommit;
1124 my @cancelled_cust_pkg = $self->all_pkgs;
1125 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1126 my $error = $cust_pkg->delete;
1128 $dbh->rollback if $oldAutoCommit;
1133 #cust_tax_adjustment in financials?
1134 #cust_pay_pending? ouch
1136 foreach my $table (qw(
1137 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1138 cust_location cust_main_note cust_tax_adjustment
1139 cust_pay_void cust_pay_batch queue cust_tax_exempt
1141 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1142 my $error = $record->delete;
1144 $dbh->rollback if $oldAutoCommit;
1150 my $sth = $dbh->prepare(
1151 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1153 my $errstr = $dbh->errstr;
1154 $dbh->rollback if $oldAutoCommit;
1157 $sth->execute($self->custnum) or do {
1158 my $errstr = $sth->errstr;
1159 $dbh->rollback if $oldAutoCommit;
1165 my $ticket_dbh = '';
1166 if ($conf->config('ticket_system') eq 'RT_Internal') {
1168 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1169 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1170 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1171 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1174 if ( $ticket_dbh ) {
1176 my $ticket_sth = $ticket_dbh->prepare(
1177 'DELETE FROM Links WHERE Target = ?'
1179 my $errstr = $ticket_dbh->errstr;
1180 $dbh->rollback if $oldAutoCommit;
1183 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1185 my $errstr = $ticket_sth->errstr;
1186 $dbh->rollback if $oldAutoCommit;
1190 #check and see if the customer is the only link on the ticket, and
1191 #if so, set the ticket to deleted status in RT?
1192 #maybe someday, for now this will at least fix tickets not displaying
1196 #delete the customer record
1198 my $error = $self->SUPER::delete;
1200 $dbh->rollback if $oldAutoCommit;
1204 # cust_main exports!
1206 #my $export_args = $options{'export_args'} || [];
1209 map qsearch( 'part_export', {exportnum=>$_} ),
1210 $conf->config('cust_main-exports'); #, $agentnum
1212 foreach my $part_export ( @part_export ) {
1213 my $error = $part_export->export_delete( $self ); #, @$export_args);
1215 $dbh->rollback if $oldAutoCommit;
1216 return "exporting to ". $part_export->exporttype.
1217 " (transaction rolled back): $error";
1221 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1226 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1228 This merges this customer into the provided new custnum, and then deletes the
1229 customer. If there is an error, returns the error, otherwise returns false.
1231 The source customer's name, company name, phone numbers, agent,
1232 referring customer, customer class, advertising source, order taker, and
1233 billing information (except balance) are discarded.
1235 All packages are moved to the target customer. Packages with package locations
1236 are preserved. Packages without package locations are moved to a new package
1237 location with the source customer's service/shipping address.
1239 All invoices, statements, payments, credits and refunds are moved to the target
1240 customer. The source customer's balance is added to the target customer.
1242 All notes, attachments, tickets and customer tags are moved to the target
1245 Change history is not currently moved.
1250 my( $self, $new_custnum, %opt ) = @_;
1252 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1254 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
1255 or return "Invalid new customer number: $new_custnum";
1257 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
1258 if $self->agentnum != $new_cust_main->agentnum
1259 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
1261 local $SIG{HUP} = 'IGNORE';
1262 local $SIG{INT} = 'IGNORE';
1263 local $SIG{QUIT} = 'IGNORE';
1264 local $SIG{TERM} = 'IGNORE';
1265 local $SIG{TSTP} = 'IGNORE';
1266 local $SIG{PIPE} = 'IGNORE';
1268 my $oldAutoCommit = $FS::UID::AutoCommit;
1269 local $FS::UID::AutoCommit = 0;
1272 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1273 $dbh->rollback if $oldAutoCommit;
1274 return "Can't merge a master agent customer";
1277 #use FS::access_user
1278 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1279 $dbh->rollback if $oldAutoCommit;
1280 return "Can't merge a master employee customer";
1283 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1284 'status' => { op=>'!=', value=>'done' },
1288 $dbh->rollback if $oldAutoCommit;
1289 return "Can't merge a customer with pending payments";
1292 tie my %financial_tables, 'Tie::IxHash',
1293 'cust_bill' => 'invoices',
1294 'cust_bill_void' => 'voided invoices',
1295 'cust_statement' => 'statements',
1296 'cust_credit' => 'credits',
1297 'cust_credit_void' => 'voided credits',
1298 'cust_pay' => 'payments',
1299 'cust_pay_void' => 'voided payments',
1300 'cust_refund' => 'refunds',
1303 foreach my $table ( keys %financial_tables ) {
1305 my @records = $self->$table();
1307 foreach my $record ( @records ) {
1308 $record->custnum($new_custnum);
1309 my $error = $record->replace;
1311 $dbh->rollback if $oldAutoCommit;
1312 return "Error merging ". $financial_tables{$table}. ": $error\n";
1318 my $name = $self->ship_name; #?
1320 my $locationnum = '';
1321 foreach my $cust_pkg ( $self->all_pkgs ) {
1322 $cust_pkg->custnum($new_custnum);
1324 unless ( $cust_pkg->locationnum ) {
1325 unless ( $locationnum ) {
1326 my $cust_location = new FS::cust_location {
1327 $self->location_hash,
1328 'custnum' => $new_custnum,
1330 my $error = $cust_location->insert;
1332 $dbh->rollback if $oldAutoCommit;
1335 $locationnum = $cust_location->locationnum;
1337 $cust_pkg->locationnum($locationnum);
1340 my $error = $cust_pkg->replace;
1342 $dbh->rollback if $oldAutoCommit;
1346 # add customer (ship) name to svc_phone.phone_name if blank
1347 my @cust_svc = $cust_pkg->cust_svc;
1348 foreach my $cust_svc (@cust_svc) {
1349 my($label, $value, $svcdb) = $cust_svc->label;
1350 next unless $svcdb eq 'svc_phone';
1351 my $svc_phone = $cust_svc->svc_x;
1352 next if $svc_phone->phone_name;
1353 $svc_phone->phone_name($name);
1354 my $error = $svc_phone->replace;
1356 $dbh->rollback if $oldAutoCommit;
1364 # cust_tax_exempt (texas tax exemptions)
1365 # cust_recon (some sort of not-well understood thing for OnPac)
1367 #these are moved over
1368 foreach my $table (qw(
1369 cust_tag cust_location contact cust_attachment cust_main_note
1370 cust_tax_adjustment cust_pay_batch queue
1372 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1373 $record->custnum($new_custnum);
1374 my $error = $record->replace;
1376 $dbh->rollback if $oldAutoCommit;
1382 #these aren't preserved
1383 foreach my $table (qw(
1384 cust_main_exemption cust_main_invoice
1386 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1387 my $error = $record->delete;
1389 $dbh->rollback if $oldAutoCommit;
1396 my $sth = $dbh->prepare(
1397 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1399 my $errstr = $dbh->errstr;
1400 $dbh->rollback if $oldAutoCommit;
1403 $sth->execute($new_custnum, $self->custnum) or do {
1404 my $errstr = $sth->errstr;
1405 $dbh->rollback if $oldAutoCommit;
1411 my $ticket_dbh = '';
1412 if ($conf->config('ticket_system') eq 'RT_Internal') {
1414 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1415 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1416 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1417 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1420 if ( $ticket_dbh ) {
1422 my $ticket_sth = $ticket_dbh->prepare(
1423 'UPDATE Links SET Target = ? WHERE Target = ?'
1425 my $errstr = $ticket_dbh->errstr;
1426 $dbh->rollback if $oldAutoCommit;
1429 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1430 'freeside://freeside/cust_main/'.$self->custnum)
1432 my $errstr = $ticket_sth->errstr;
1433 $dbh->rollback if $oldAutoCommit;
1439 #delete the customer record
1441 my $error = $self->delete;
1443 $dbh->rollback if $oldAutoCommit;
1447 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1452 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1454 Replaces the OLD_RECORD with this one in the database. If there is an error,
1455 returns the error, otherwise returns false.
1457 To change the customer's address, set the pseudo-fields C<bill_location> and
1458 C<ship_location>. The address will still only change if at least one of the
1459 address fields differs from the existing values.
1461 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1462 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1463 expected and rollback the entire transaction; it is not necessary to call
1464 check_invoicing_list first. Here's an example:
1466 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1468 Currently available options are: I<tax_exemption>.
1470 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1471 of tax names and exemption numbers. FS::cust_main_exemption records will be
1472 deleted and inserted as appropriate.
1479 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1481 : $self->replace_old;
1485 warn "$me replace called\n"
1488 my $curuser = $FS::CurrentUser::CurrentUser;
1489 if ( $self->payby eq 'COMP'
1490 && $self->payby ne $old->payby
1491 && ! $curuser->access_right('Complimentary customer')
1494 return "You are not permitted to create complimentary accounts.";
1497 local($ignore_expired_card) = 1
1498 if $old->payby =~ /^(CARD|DCRD)$/
1499 && $self->payby =~ /^(CARD|DCRD)$/
1500 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1502 local($ignore_banned_card) = 1
1503 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1504 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1505 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1507 return "Invoicing locale is required"
1510 && $conf->exists('cust_main-require_locale');
1512 local $SIG{HUP} = 'IGNORE';
1513 local $SIG{INT} = 'IGNORE';
1514 local $SIG{QUIT} = 'IGNORE';
1515 local $SIG{TERM} = 'IGNORE';
1516 local $SIG{TSTP} = 'IGNORE';
1517 local $SIG{PIPE} = 'IGNORE';
1519 my $oldAutoCommit = $FS::UID::AutoCommit;
1520 local $FS::UID::AutoCommit = 0;
1523 for my $l (qw(bill_location ship_location)) {
1524 my $old_loc = $old->$l;
1525 my $new_loc = $self->$l;
1527 # find the existing location if there is one
1528 $new_loc->set('custnum' => $self->custnum);
1529 my $error = $new_loc->find_or_insert;
1531 $dbh->rollback if $oldAutoCommit;
1534 $self->set($l.'num', $new_loc->locationnum);
1537 # replace the customer record
1538 my $error = $self->SUPER::replace($old);
1541 $dbh->rollback if $oldAutoCommit;
1545 # now move packages to the new service location
1546 $self->set('ship_location', ''); #flush cache
1547 if ( $old->ship_locationnum and # should only be null during upgrade...
1548 $old->ship_locationnum != $self->ship_locationnum ) {
1549 $error = $old->ship_location->move_to($self->ship_location);
1551 $dbh->rollback if $oldAutoCommit;
1555 # don't move packages based on the billing location, but
1556 # disable it if it's no longer in use
1557 if ( $old->bill_locationnum and
1558 $old->bill_locationnum != $self->bill_locationnum ) {
1559 $error = $old->bill_location->disable_if_unused;
1561 $dbh->rollback if $oldAutoCommit;
1566 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1567 my $invoicing_list = shift @param;
1568 $error = $self->check_invoicing_list( $invoicing_list );
1570 $dbh->rollback if $oldAutoCommit;
1573 $self->invoicing_list( $invoicing_list );
1576 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1578 #this could be more efficient than deleting and re-inserting, if it matters
1579 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1580 my $error = $cust_tag->delete;
1582 $dbh->rollback if $oldAutoCommit;
1586 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1587 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1588 'custnum' => $self->custnum };
1589 my $error = $cust_tag->insert;
1591 $dbh->rollback if $oldAutoCommit;
1598 my %options = @param;
1600 my $tax_exemption = delete $options{'tax_exemption'};
1601 if ( $tax_exemption ) {
1603 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1604 if ref($tax_exemption) eq 'ARRAY';
1606 my %cust_main_exemption =
1607 map { $_->taxname => $_ }
1608 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1610 foreach my $taxname ( keys %$tax_exemption ) {
1612 if ( $cust_main_exemption{$taxname} &&
1613 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1616 delete $cust_main_exemption{$taxname};
1620 my $cust_main_exemption = new FS::cust_main_exemption {
1621 'custnum' => $self->custnum,
1622 'taxname' => $taxname,
1623 'exempt_number' => $tax_exemption->{$taxname},
1625 my $error = $cust_main_exemption->insert;
1627 $dbh->rollback if $oldAutoCommit;
1628 return "inserting cust_main_exemption (transaction rolled back): $error";
1632 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1633 my $error = $cust_main_exemption->delete;
1635 $dbh->rollback if $oldAutoCommit;
1636 return "deleting cust_main_exemption (transaction rolled back): $error";
1642 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1643 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1644 && $self->get('payinfo') !~ /^99\d{14}$/
1646 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1651 # card/check/lec info has changed, want to retry realtime_ invoice events
1652 my $error = $self->retry_realtime;
1654 $dbh->rollback if $oldAutoCommit;
1659 unless ( $import || $skip_fuzzyfiles ) {
1660 $error = $self->queue_fuzzyfiles_update;
1662 $dbh->rollback if $oldAutoCommit;
1663 return "updating fuzzy search cache: $error";
1667 # tax district update in cust_location
1669 # cust_main exports!
1671 my $export_args = $options{'export_args'} || [];
1674 map qsearch( 'part_export', {exportnum=>$_} ),
1675 $conf->config('cust_main-exports'); #, $agentnum
1677 foreach my $part_export ( @part_export ) {
1678 my $error = $part_export->export_replace( $self, $old, @$export_args);
1680 $dbh->rollback if $oldAutoCommit;
1681 return "exporting to ". $part_export->exporttype.
1682 " (transaction rolled back): $error";
1686 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1691 =item queue_fuzzyfiles_update
1693 Used by insert & replace to update the fuzzy search cache
1697 use FS::cust_main::Search;
1698 sub queue_fuzzyfiles_update {
1701 local $SIG{HUP} = 'IGNORE';
1702 local $SIG{INT} = 'IGNORE';
1703 local $SIG{QUIT} = 'IGNORE';
1704 local $SIG{TERM} = 'IGNORE';
1705 local $SIG{TSTP} = 'IGNORE';
1706 local $SIG{PIPE} = 'IGNORE';
1708 my $oldAutoCommit = $FS::UID::AutoCommit;
1709 local $FS::UID::AutoCommit = 0;
1712 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1713 my $queue = new FS::queue {
1714 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1716 my @args = "cust_main.$field", $self->get($field);
1717 my $error = $queue->insert( @args );
1719 $dbh->rollback if $oldAutoCommit;
1720 return "queueing job (transaction rolled back): $error";
1724 my @locations = $self->bill_location;
1725 push @locations, $self->ship_location if $self->has_ship_address;
1726 foreach my $location (@locations) {
1727 my $queue = new FS::queue {
1728 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1730 my @args = 'cust_location.address1', $location->address1;
1731 my $error = $queue->insert( @args );
1733 $dbh->rollback if $oldAutoCommit;
1734 return "queueing job (transaction rolled back): $error";
1738 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1745 Checks all fields to make sure this is a valid customer record. If there is
1746 an error, returns the error, otherwise returns false. Called by the insert
1747 and replace methods.
1754 warn "$me check BEFORE: \n". $self->_dump
1758 $self->ut_numbern('custnum')
1759 || $self->ut_number('agentnum')
1760 || $self->ut_textn('agent_custid')
1761 || $self->ut_number('refnum')
1762 || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
1763 || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
1764 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1765 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1766 || $self->ut_textn('custbatch')
1767 || $self->ut_name('last')
1768 || $self->ut_name('first')
1769 || $self->ut_snumbern('signupdate')
1770 || $self->ut_snumbern('birthdate')
1771 || $self->ut_namen('spouse_last')
1772 || $self->ut_namen('spouse_first')
1773 || $self->ut_snumbern('spouse_birthdate')
1774 || $self->ut_snumbern('anniversary_date')
1775 || $self->ut_textn('company')
1776 || $self->ut_textn('ship_company')
1777 || $self->ut_anything('comments')
1778 || $self->ut_numbern('referral_custnum')
1779 || $self->ut_textn('stateid')
1780 || $self->ut_textn('stateid_state')
1781 || $self->ut_textn('invoice_terms')
1782 || $self->ut_floatn('cdr_termination_percentage')
1783 || $self->ut_floatn('credit_limit')
1784 || $self->ut_numbern('billday')
1785 || $self->ut_numbern('prorate_day')
1786 || $self->ut_flag('edit_subject')
1787 || $self->ut_flag('calling_list_exempt')
1788 || $self->ut_flag('invoice_noemail')
1789 || $self->ut_flag('message_noemail')
1790 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1791 || $self->ut_flag('invoice_ship_address')
1794 foreach (qw(company ship_company)) {
1795 my $company = $self->get($_);
1796 $company =~ s/^\s+//;
1797 $company =~ s/\s+$//;
1798 $company =~ s/\s+/ /g;
1799 $self->set($_, $company);
1802 #barf. need message catalogs. i18n. etc.
1803 $error .= "Please select an advertising source."
1804 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1805 return $error if $error;
1807 return "Unknown agent"
1808 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1810 return "Unknown refnum"
1811 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1813 return "Unknown referring custnum: ". $self->referral_custnum
1814 unless ! $self->referral_custnum
1815 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1817 if ( $self->ss eq '' ) {
1822 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1823 or return "Illegal social security number: ". $self->ss;
1824 $self->ss("$1-$2-$3");
1827 #turn off invoice_ship_address if ship & bill are the same
1828 if ($self->bill_locationnum eq $self->ship_locationnum) {
1829 $self->invoice_ship_address('');
1832 # cust_main_county verification now handled by cust_location check
1835 $self->ut_phonen('daytime', $self->country)
1836 || $self->ut_phonen('night', $self->country)
1837 || $self->ut_phonen('fax', $self->country)
1838 || $self->ut_phonen('mobile', $self->country)
1840 return $error if $error;
1842 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1844 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1847 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1849 : FS::Msgcat::_gettext('daytime');
1850 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1852 : FS::Msgcat::_gettext('night');
1854 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1856 : FS::Msgcat::_gettext('mobile');
1858 return "$daytime_label, $night_label or $mobile_label is required"
1862 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1863 # or return "Illegal payby: ". $self->payby;
1865 FS::payby->can_payby($self->table, $self->payby)
1866 or return "Illegal payby: ". $self->payby;
1868 $error = $self->ut_numbern('paystart_month')
1869 || $self->ut_numbern('paystart_year')
1870 || $self->ut_numbern('payissue')
1871 || $self->ut_textn('paytype')
1873 return $error if $error;
1875 if ( $self->payip eq '' ) {
1878 $error = $self->ut_ip('payip');
1879 return $error if $error;
1882 # If it is encrypted and the private key is not availaible then we can't
1883 # check the credit card.
1884 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1886 # Need some kind of global flag to accept invalid cards, for testing
1888 if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1890 my $payinfo = $self->payinfo;
1891 $payinfo =~ s/\D//g;
1892 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1893 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1895 $self->payinfo($payinfo);
1897 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1899 return gettext('unknown_card_type')
1900 if $self->payinfo !~ /^99\d{14}$/ #token
1901 && cardtype($self->payinfo) eq "Unknown";
1903 unless ( $ignore_banned_card ) {
1904 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1906 if ( $ban->bantype eq 'warn' ) {
1907 #or others depending on value of $ban->reason ?
1908 return '_duplicate_card'.
1909 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1910 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1911 ' (ban# '. $ban->bannum. ')'
1912 unless $self->override_ban_warn;
1914 return 'Banned credit card: banned on '.
1915 time2str('%a %h %o at %r', $ban->_date).
1916 ' by '. $ban->otaker.
1917 ' (ban# '. $ban->bannum. ')';
1922 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1923 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1924 $self->paycvv =~ /^(\d{4})$/
1925 or return "CVV2 (CID) for American Express cards is four digits.";
1928 $self->paycvv =~ /^(\d{3})$/
1929 or return "CVV2 (CVC2/CID) is three digits.";
1936 my $cardtype = cardtype($payinfo);
1937 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1939 return "Start date or issue number is required for $cardtype cards"
1940 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1942 return "Start month must be between 1 and 12"
1943 if $self->paystart_month
1944 and $self->paystart_month < 1 || $self->paystart_month > 12;
1946 return "Start year must be 1990 or later"
1947 if $self->paystart_year
1948 and $self->paystart_year < 1990;
1950 return "Issue number must be beween 1 and 99"
1952 and $self->payissue < 1 || $self->payissue > 99;
1955 $self->paystart_month('');
1956 $self->paystart_year('');
1957 $self->payissue('');
1960 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1962 my $payinfo = $self->payinfo;
1963 $payinfo =~ s/[^\d\@\.]//g;
1964 if ( $conf->config('echeck-country') eq 'CA' ) {
1965 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1966 or return 'invalid echeck account@branch.bank';
1967 $payinfo = "$1\@$2.$3";
1968 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1969 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1970 $payinfo = "$1\@$2";
1972 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1973 $payinfo = "$1\@$2";
1975 $self->payinfo($payinfo);
1978 unless ( $ignore_banned_card ) {
1979 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1981 if ( $ban->bantype eq 'warn' ) {
1982 #or others depending on value of $ban->reason ?
1983 return '_duplicate_ach' unless $self->override_ban_warn;
1985 return 'Banned ACH account: banned on '.
1986 time2str('%a %h %o at %r', $ban->_date).
1987 ' by '. $ban->otaker.
1988 ' (ban# '. $ban->bannum. ')';
1993 } elsif ( $self->payby eq 'LECB' ) {
1995 my $payinfo = $self->payinfo;
1996 $payinfo =~ s/\D//g;
1997 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1999 $self->payinfo($payinfo);
2002 } elsif ( $self->payby eq 'BILL' ) {
2004 $error = $self->ut_textn('payinfo');
2005 return "Illegal P.O. number: ". $self->payinfo if $error;
2008 } elsif ( $self->payby eq 'COMP' ) {
2010 my $curuser = $FS::CurrentUser::CurrentUser;
2011 if ( ! $self->custnum
2012 && ! $curuser->access_right('Complimentary customer')
2015 return "You are not permitted to create complimentary accounts."
2018 $error = $self->ut_textn('payinfo');
2019 return "Illegal comp account issuer: ". $self->payinfo if $error;
2022 } elsif ( $self->payby eq 'PREPAY' ) {
2024 my $payinfo = $self->payinfo;
2025 $payinfo =~ s/\W//g; #anything else would just confuse things
2026 $self->payinfo($payinfo);
2027 $error = $self->ut_alpha('payinfo');
2028 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2029 return "Unknown prepayment identifier"
2030 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2035 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2036 return "Expiration date required"
2037 # shouldn't payinfo_check do this?
2038 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
2042 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2043 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2044 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2045 ( $m, $y ) = ( $2, "19$1" );
2046 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2047 ( $m, $y ) = ( $3, "20$2" );
2049 return "Illegal expiration date: ". $self->paydate;
2051 $m = sprintf('%02d',$m);
2052 $self->paydate("$y-$m-01");
2053 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2054 return gettext('expired_card')
2056 && !$ignore_expired_card
2057 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2060 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2061 ( ! $conf->exists('require_cardname')
2062 || $self->payby !~ /^(CARD|DCRD)$/ )
2064 $self->payname( $self->first. " ". $self->getfield('last') );
2067 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2068 $self->payname =~ /^([\w \,\.\-\']*)$/
2069 or return gettext('illegal_name'). " payname: ". $self->payname;
2072 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
2073 or return gettext('illegal_name'). " payname: ". $self->payname;
2079 return "Please select an invoicing locale"
2082 && $conf->exists('cust_main-require_locale');
2084 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2085 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2089 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2091 warn "$me check AFTER: \n". $self->_dump
2094 $self->SUPER::check;
2099 Additional checks for replace only.
2104 my ($new,$old) = @_;
2105 #preserve old value if global config is set
2106 if ($old && $conf->exists('invoice-ship_address')) {
2107 $new->invoice_ship_address($old->invoice_ship_address);
2114 Returns a list of fields which have ship_ duplicates.
2119 qw( last first company
2121 address1 address2 city county state zip country
2123 daytime night fax mobile
2127 =item has_ship_address
2129 Returns true if this customer record has a separate shipping address.
2133 sub has_ship_address {
2135 $self->bill_locationnum != $self->ship_locationnum;
2140 Returns a list of key/value pairs, with the following keys: address1,
2141 adddress2, city, county, state, zip, country, district, and geocode. The
2142 shipping address is used if present.
2148 $self->ship_location->location_hash;
2153 Returns all locations (see L<FS::cust_location>) for this customer.
2159 qsearch('cust_location', { 'custnum' => $self->custnum,
2160 'prospectnum' => '' } );
2165 Returns all contacts (see L<FS::contact>) for this customer.
2169 #already used :/ sub contact {
2172 qsearch('contact', { 'custnum' => $self->custnum } );
2177 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2178 and L<FS::cust_pkg>) for this customer, except those on hold.
2180 Returns a list: an empty list on success or a list of errors.
2186 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2191 Unsuspends all suspended packages in the on-hold state (those without setup
2192 dates) for this customer.
2198 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2203 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2205 Returns a list: an empty list on success or a list of errors.
2211 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2214 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2216 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2217 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2218 of a list of pkgparts; the hashref has the following keys:
2222 =item pkgparts - listref of pkgparts
2224 =item (other options are passed to the suspend method)
2229 Returns a list: an empty list on success or a list of errors.
2233 sub suspend_if_pkgpart {
2235 my (@pkgparts, %opt);
2236 if (ref($_[0]) eq 'HASH'){
2237 @pkgparts = @{$_[0]{pkgparts}};
2242 grep { $_->suspend(%opt) }
2243 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2244 $self->unsuspended_pkgs;
2247 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2249 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2250 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2251 instead of a list of pkgparts; the hashref has the following keys:
2255 =item pkgparts - listref of pkgparts
2257 =item (other options are passed to the suspend method)
2261 Returns a list: an empty list on success or a list of errors.
2265 sub suspend_unless_pkgpart {
2267 my (@pkgparts, %opt);
2268 if (ref($_[0]) eq 'HASH'){
2269 @pkgparts = @{$_[0]{pkgparts}};
2274 grep { $_->suspend(%opt) }
2275 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2276 $self->unsuspended_pkgs;
2279 =item cancel [ OPTION => VALUE ... ]
2281 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2283 Available options are:
2287 =item quiet - can be set true to supress email cancellation notices.
2289 =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.
2291 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2293 =item nobill - can be set true to skip billing if it might otherwise be done.
2297 Always returns a list: an empty list on success or a list of errors.
2301 # nb that dates are not specified as valid options to this method
2304 my( $self, %opt ) = @_;
2306 warn "$me cancel called on customer ". $self->custnum. " with options ".
2307 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2310 return ( 'access denied' )
2311 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2313 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2315 #should try decryption (we might have the private key)
2316 # and if not maybe queue a job for the server that does?
2317 return ( "Can't (yet) ban encrypted credit cards" )
2318 if $self->is_encrypted($self->payinfo);
2320 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2321 my $error = $ban->insert;
2322 return ( $error ) if $error;
2326 my @pkgs = $self->ncancelled_pkgs;
2328 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2330 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2331 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2335 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2336 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2339 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2342 sub _banned_pay_hashref {
2353 'payby' => $payby2ban{$self->payby},
2354 'payinfo' => $self->payinfo,
2355 #don't ever *search* on reason! #'reason' =>
2359 sub _new_banned_pay_hashref {
2361 my $hr = $self->_banned_pay_hashref;
2362 $hr->{payinfo} = md5_base64($hr->{payinfo});
2368 Returns all notes (see L<FS::cust_main_note>) for this customer.
2373 my($self,$orderby_classnum) = (shift,shift);
2374 my $orderby = "sticky DESC, _date DESC";
2375 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2376 qsearch( 'cust_main_note',
2377 { 'custnum' => $self->custnum },
2379 "ORDER BY $orderby",
2385 Returns the agent (see L<FS::agent>) for this customer.
2391 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2396 Returns the agent name (see L<FS::agent>) for this customer.
2402 $self->agent->agent;
2407 Returns any tags associated with this customer, as FS::cust_tag objects,
2408 or an empty list if there are no tags.
2414 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2419 Returns any tags associated with this customer, as FS::part_tag objects,
2420 or an empty list if there are no tags.
2426 map $_->part_tag, $self->cust_tag;
2432 Returns the customer class, as an FS::cust_class object, or the empty string
2433 if there is no customer class.
2439 if ( $self->classnum ) {
2440 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2448 Returns the customer category name, or the empty string if there is no customer
2455 my $cust_class = $self->cust_class;
2457 ? $cust_class->categoryname
2463 Returns the customer class name, or the empty string if there is no customer
2470 my $cust_class = $self->cust_class;
2472 ? $cust_class->classname
2476 =item BILLING METHODS
2478 Documentation on billing methods has been moved to
2479 L<FS::cust_main::Billing>.
2481 =item REALTIME BILLING METHODS
2483 Documentation on realtime billing methods has been moved to
2484 L<FS::cust_main::Billing_Realtime>.
2488 Removes the I<paycvv> field from the database directly.
2490 If there is an error, returns the error, otherwise returns false.
2496 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2497 or return dbh->errstr;
2498 $sth->execute($self->custnum)
2499 or return $sth->errstr;
2504 =item batch_card OPTION => VALUE...
2506 Adds a payment for this invoice to the pending credit card batch (see
2507 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2508 runs the payment using a realtime gateway.
2510 Options may include:
2512 B<amount>: the amount to be paid; defaults to the customer's balance minus
2513 any payments in transit.
2515 B<payby>: the payment method; defaults to cust_main.payby
2517 B<realtime>: runs this as a realtime payment instead of adding it to a
2520 B<invnum>: sets cust_pay_batch.invnum.
2522 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2523 the billing address for the payment; defaults to the customer's billing
2526 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2527 date, and name; defaults to those fields in cust_main.
2532 my ($self, %options) = @_;
2535 if (exists($options{amount})) {
2536 $amount = $options{amount};
2538 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2540 return '' unless $amount > 0;
2542 my $invnum = delete $options{invnum};
2543 my $payby = $options{payby} || $self->payby; #still dubious
2545 if ($options{'realtime'}) {
2546 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2552 my $oldAutoCommit = $FS::UID::AutoCommit;
2553 local $FS::UID::AutoCommit = 0;
2556 #this needs to handle mysql as well as Pg, like svc_acct.pm
2557 #(make it into a common function if folks need to do batching with mysql)
2558 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2559 or return "Cannot lock pay_batch: " . $dbh->errstr;
2563 'payby' => FS::payby->payby2payment($payby),
2565 $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2567 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2569 unless ( $pay_batch ) {
2570 $pay_batch = new FS::pay_batch \%pay_batch;
2571 my $error = $pay_batch->insert;
2573 $dbh->rollback if $oldAutoCommit;
2574 die "error creating new batch: $error\n";
2578 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2579 'batchnum' => $pay_batch->batchnum,
2580 'custnum' => $self->custnum,
2583 foreach (qw( address1 address2 city state zip country latitude longitude
2584 payby payinfo paydate payname ))
2586 $options{$_} = '' unless exists($options{$_});
2589 my $loc = $self->bill_location;
2591 my $cust_pay_batch = new FS::cust_pay_batch ( {
2592 'batchnum' => $pay_batch->batchnum,
2593 'invnum' => $invnum || 0, # is there a better value?
2594 # this field should be
2596 # cust_bill_pay_batch now
2597 'custnum' => $self->custnum,
2598 'last' => $self->getfield('last'),
2599 'first' => $self->getfield('first'),
2600 'address1' => $options{address1} || $loc->address1,
2601 'address2' => $options{address2} || $loc->address2,
2602 'city' => $options{city} || $loc->city,
2603 'state' => $options{state} || $loc->state,
2604 'zip' => $options{zip} || $loc->zip,
2605 'country' => $options{country} || $loc->country,
2606 'payby' => $options{payby} || $self->payby,
2607 'payinfo' => $options{payinfo} || $self->payinfo,
2608 'exp' => $options{paydate} || $self->paydate,
2609 'payname' => $options{payname} || $self->payname,
2610 'amount' => $amount, # consolidating
2613 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2614 if $old_cust_pay_batch;
2617 if ($old_cust_pay_batch) {
2618 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2620 $error = $cust_pay_batch->insert;
2624 $dbh->rollback if $oldAutoCommit;
2628 my $unapplied = $self->total_unapplied_credits
2629 + $self->total_unapplied_payments
2630 + $self->in_transit_payments;
2631 foreach my $cust_bill ($self->open_cust_bill) {
2632 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2633 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2634 'invnum' => $cust_bill->invnum,
2635 'paybatchnum' => $cust_pay_batch->paybatchnum,
2636 'amount' => $cust_bill->owed,
2639 if ($unapplied >= $cust_bill_pay_batch->amount){
2640 $unapplied -= $cust_bill_pay_batch->amount;
2643 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2644 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2646 $error = $cust_bill_pay_batch->insert;
2648 $dbh->rollback if $oldAutoCommit;
2653 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2659 Returns the total owed for this customer on all invoices
2660 (see L<FS::cust_bill/owed>).
2666 $self->total_owed_date(2145859200); #12/31/2037
2669 =item total_owed_date TIME
2671 Returns the total owed for this customer on all invoices with date earlier than
2672 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2673 see L<Time::Local> and L<Date::Parse> for conversion functions.
2677 sub total_owed_date {
2681 my $custnum = $self->custnum;
2683 my $owed_sql = FS::cust_bill->owed_sql;
2686 SELECT SUM($owed_sql) FROM cust_bill
2687 WHERE custnum = $custnum
2691 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2695 =item total_owed_pkgnum PKGNUM
2697 Returns the total owed on all invoices for this customer's specific package
2698 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2702 sub total_owed_pkgnum {
2703 my( $self, $pkgnum ) = @_;
2704 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2707 =item total_owed_date_pkgnum TIME PKGNUM
2709 Returns the total owed for this customer's specific package when using
2710 experimental package balances on all invoices with date earlier than
2711 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2712 see L<Time::Local> and L<Date::Parse> for conversion functions.
2716 sub total_owed_date_pkgnum {
2717 my( $self, $time, $pkgnum ) = @_;
2720 foreach my $cust_bill (
2721 grep { $_->_date <= $time }
2722 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2724 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2726 sprintf( "%.2f", $total_bill );
2732 Returns the total amount of all payments.
2739 $total += $_->paid foreach $self->cust_pay;
2740 sprintf( "%.2f", $total );
2743 =item total_unapplied_credits
2745 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2746 customer. See L<FS::cust_credit/credited>.
2748 =item total_credited
2750 Old name for total_unapplied_credits. Don't use.
2754 sub total_credited {
2755 #carp "total_credited deprecated, use total_unapplied_credits";
2756 shift->total_unapplied_credits(@_);
2759 sub total_unapplied_credits {
2762 my $custnum = $self->custnum;
2764 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2767 SELECT SUM($unapplied_sql) FROM cust_credit
2768 WHERE custnum = $custnum
2771 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2775 =item total_unapplied_credits_pkgnum PKGNUM
2777 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2778 customer. See L<FS::cust_credit/credited>.
2782 sub total_unapplied_credits_pkgnum {
2783 my( $self, $pkgnum ) = @_;
2784 my $total_credit = 0;
2785 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2786 sprintf( "%.2f", $total_credit );
2790 =item total_unapplied_payments
2792 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2793 See L<FS::cust_pay/unapplied>.
2797 sub total_unapplied_payments {
2800 my $custnum = $self->custnum;
2802 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2805 SELECT SUM($unapplied_sql) FROM cust_pay
2806 WHERE custnum = $custnum
2809 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2813 =item total_unapplied_payments_pkgnum PKGNUM
2815 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2816 specific package when using experimental package balances. See
2817 L<FS::cust_pay/unapplied>.
2821 sub total_unapplied_payments_pkgnum {
2822 my( $self, $pkgnum ) = @_;
2823 my $total_unapplied = 0;
2824 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2825 sprintf( "%.2f", $total_unapplied );
2829 =item total_unapplied_refunds
2831 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2832 customer. See L<FS::cust_refund/unapplied>.
2836 sub total_unapplied_refunds {
2838 my $custnum = $self->custnum;
2840 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2843 SELECT SUM($unapplied_sql) FROM cust_refund
2844 WHERE custnum = $custnum
2847 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2853 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2854 total_unapplied_credits minus total_unapplied_payments).
2860 $self->balance_date_range;
2863 =item balance_date TIME
2865 Returns the balance for this customer, only considering invoices with date
2866 earlier than TIME (total_owed_date minus total_credited minus
2867 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2868 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2875 $self->balance_date_range(shift);
2878 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2880 Returns the balance for this customer, optionally considering invoices with
2881 date earlier than START_TIME, and not later than END_TIME
2882 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2884 Times are specified as SQL fragments or numeric
2885 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2886 L<Date::Parse> for conversion functions. The empty string can be passed
2887 to disable that time constraint completely.
2889 Accepts the same options as L<balance_date_sql>:
2893 =item unapplied_date
2895 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)
2899 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2900 time will be ignored. Note that START_TIME and END_TIME only limit the date
2901 range for invoices and I<unapplied> payments, credits, and refunds.
2907 sub balance_date_range {
2909 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2910 ') FROM cust_main WHERE custnum='. $self->custnum;
2911 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2914 =item balance_pkgnum PKGNUM
2916 Returns the balance for this customer's specific package when using
2917 experimental package balances (total_owed plus total_unrefunded, minus
2918 total_unapplied_credits minus total_unapplied_payments)
2922 sub balance_pkgnum {
2923 my( $self, $pkgnum ) = @_;
2926 $self->total_owed_pkgnum($pkgnum)
2927 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2928 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2929 - $self->total_unapplied_credits_pkgnum($pkgnum)
2930 - $self->total_unapplied_payments_pkgnum($pkgnum)
2934 =item in_transit_payments
2936 Returns the total of requests for payments for this customer pending in
2937 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
2941 sub in_transit_payments {
2943 my $in_transit_payments = 0;
2944 foreach my $pay_batch ( qsearch('pay_batch', {
2947 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2948 'batchnum' => $pay_batch->batchnum,
2949 'custnum' => $self->custnum,
2951 $in_transit_payments += $cust_pay_batch->amount;
2954 sprintf( "%.2f", $in_transit_payments );
2959 Returns a hash of useful information for making a payment.
2969 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2970 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2971 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2975 For credit card transactions:
2987 For electronic check transactions:
3002 $return{balance} = $self->balance;
3004 $return{payname} = $self->payname
3005 || ( $self->first. ' '. $self->get('last') );
3007 $return{$_} = $self->bill_location->$_
3008 for qw(address1 address2 city state zip);
3010 $return{payby} = $self->payby;
3011 $return{stateid_state} = $self->stateid_state;
3013 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3014 $return{card_type} = cardtype($self->payinfo);
3015 $return{payinfo} = $self->paymask;
3017 @return{'month', 'year'} = $self->paydate_monthyear;
3021 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3022 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3023 $return{payinfo1} = $payinfo1;
3024 $return{payinfo2} = $payinfo2;
3025 $return{paytype} = $self->paytype;
3026 $return{paystate} = $self->paystate;
3030 #doubleclick protection
3032 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3038 =item paydate_monthyear
3040 Returns a two-element list consisting of the month and year of this customer's
3041 paydate (credit card expiration date for CARD customers)
3045 sub paydate_monthyear {
3047 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3049 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3058 Returns the exact time in seconds corresponding to the payment method
3059 expiration date. For CARD/DCRD customers this is the end of the month;
3060 for others (COMP is the only other payby that uses paydate) it's the start.
3061 Returns 0 if the paydate is empty or set to the far future.
3067 my ($month, $year) = $self->paydate_monthyear;
3068 return 0 if !$year or $year >= 2037;
3069 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3071 if ( $month == 13 ) {
3075 return timelocal(0,0,0,1,$month-1,$year) - 1;
3078 return timelocal(0,0,0,1,$month-1,$year);
3082 =item paydate_epoch_sql
3084 Class method. Returns an SQL expression to obtain the payment expiration date
3085 as a number of seconds.
3089 # Special expiration date behavior for non-CARD/DCRD customers has been
3090 # carefully preserved. Do we really use that?
3091 sub paydate_epoch_sql {
3093 my $table = shift || 'cust_main';
3094 my ($case1, $case2);
3095 if ( driver_name eq 'Pg' ) {
3096 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3097 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3099 elsif ( lc(driver_name) eq 'mysql' ) {
3100 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3101 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3104 return "CASE WHEN $table.payby IN('CARD','DCRD')
3110 =item tax_exemption TAXNAME
3115 my( $self, $taxname ) = @_;
3117 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3118 'taxname' => $taxname,
3123 =item cust_main_exemption
3127 sub cust_main_exemption {
3129 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3132 =item invoicing_list [ ARRAYREF ]
3134 If an arguement is given, sets these email addresses as invoice recipients
3135 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3136 (except as warnings), so use check_invoicing_list first.
3138 Returns a list of email addresses (with svcnum entries expanded).
3140 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3141 check it without disturbing anything by passing nothing.
3143 This interface may change in the future.
3147 sub invoicing_list {
3148 my( $self, $arrayref ) = @_;
3151 my @cust_main_invoice;
3152 if ( $self->custnum ) {
3153 @cust_main_invoice =
3154 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3156 @cust_main_invoice = ();
3158 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3159 #warn $cust_main_invoice->destnum;
3160 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3161 #warn $cust_main_invoice->destnum;
3162 my $error = $cust_main_invoice->delete;
3163 warn $error if $error;
3166 if ( $self->custnum ) {
3167 @cust_main_invoice =
3168 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3170 @cust_main_invoice = ();
3172 my %seen = map { $_->address => 1 } @cust_main_invoice;
3173 foreach my $address ( @{$arrayref} ) {
3174 next if exists $seen{$address} && $seen{$address};
3175 $seen{$address} = 1;
3176 my $cust_main_invoice = new FS::cust_main_invoice ( {
3177 'custnum' => $self->custnum,
3180 my $error = $cust_main_invoice->insert;
3181 warn $error if $error;
3185 if ( $self->custnum ) {
3187 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3194 =item check_invoicing_list ARRAYREF
3196 Checks these arguements as valid input for the invoicing_list method. If there
3197 is an error, returns the error, otherwise returns false.
3201 sub check_invoicing_list {
3202 my( $self, $arrayref ) = @_;
3204 foreach my $address ( @$arrayref ) {
3206 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3207 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3210 my $cust_main_invoice = new FS::cust_main_invoice ( {
3211 'custnum' => $self->custnum,
3214 my $error = $self->custnum
3215 ? $cust_main_invoice->check
3216 : $cust_main_invoice->checkdest
3218 return $error if $error;
3222 return "Email address required"
3223 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3224 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3229 =item set_default_invoicing_list
3231 Sets the invoicing list to all accounts associated with this customer,
3232 overwriting any previous invoicing list.
3236 sub set_default_invoicing_list {
3238 $self->invoicing_list($self->all_emails);
3243 Returns the email addresses of all accounts provisioned for this customer.
3250 foreach my $cust_pkg ( $self->all_pkgs ) {
3251 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3253 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3254 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3256 $list{$_}=1 foreach map { $_->email } @svc_acct;
3261 =item invoicing_list_addpost
3263 Adds postal invoicing to this customer. If this customer is already configured
3264 to receive postal invoices, does nothing.
3268 sub invoicing_list_addpost {
3270 return if grep { $_ eq 'POST' } $self->invoicing_list;
3271 my @invoicing_list = $self->invoicing_list;
3272 push @invoicing_list, 'POST';
3273 $self->invoicing_list(\@invoicing_list);
3276 =item invoicing_list_emailonly
3278 Returns the list of email invoice recipients (invoicing_list without non-email
3279 destinations such as POST and FAX).
3283 sub invoicing_list_emailonly {
3285 warn "$me invoicing_list_emailonly called"
3287 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3290 =item invoicing_list_emailonly_scalar
3292 Returns the list of email invoice recipients (invoicing_list without non-email
3293 destinations such as POST and FAX) as a comma-separated scalar.
3297 sub invoicing_list_emailonly_scalar {
3299 warn "$me invoicing_list_emailonly_scalar called"
3301 join(', ', $self->invoicing_list_emailonly);
3304 =item referral_custnum_cust_main
3306 Returns the customer who referred this customer (or the empty string, if
3307 this customer was not referred).
3309 Note the difference with referral_cust_main method: This method,
3310 referral_custnum_cust_main returns the single customer (if any) who referred
3311 this customer, while referral_cust_main returns an array of customers referred
3316 sub referral_custnum_cust_main {
3318 return '' unless $self->referral_custnum;
3319 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3322 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3324 Returns an array of customers referred by this customer (referral_custnum set
3325 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3326 customers referred by customers referred by this customer and so on, inclusive.
3327 The default behavior is DEPTH 1 (no recursion).
3329 Note the difference with referral_custnum_cust_main method: This method,
3330 referral_cust_main, returns an array of customers referred BY this customer,
3331 while referral_custnum_cust_main returns the single customer (if any) who
3332 referred this customer.
3336 sub referral_cust_main {
3338 my $depth = @_ ? shift : 1;
3339 my $exclude = @_ ? shift : {};
3342 map { $exclude->{$_->custnum}++; $_; }
3343 grep { ! $exclude->{ $_->custnum } }
3344 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3348 map { $_->referral_cust_main($depth-1, $exclude) }
3355 =item referral_cust_main_ncancelled
3357 Same as referral_cust_main, except only returns customers with uncancelled
3362 sub referral_cust_main_ncancelled {
3364 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3367 =item referral_cust_pkg [ DEPTH ]
3369 Like referral_cust_main, except returns a flat list of all unsuspended (and
3370 uncancelled) packages for each customer. The number of items in this list may
3371 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3375 sub referral_cust_pkg {
3377 my $depth = @_ ? shift : 1;
3379 map { $_->unsuspended_pkgs }
3380 grep { $_->unsuspended_pkgs }
3381 $self->referral_cust_main($depth);
3384 =item referring_cust_main
3386 Returns the single cust_main record for the customer who referred this customer
3387 (referral_custnum), or false.
3391 sub referring_cust_main {
3393 return '' unless $self->referral_custnum;
3394 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3397 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3399 Applies a credit to this customer. If there is an error, returns the error,
3400 otherwise returns false.
3402 REASON can be a text string, an FS::reason object, or a scalar reference to
3403 a reasonnum. If a text string, it will be automatically inserted as a new
3404 reason, and a 'reason_type' option must be passed to indicate the
3405 FS::reason_type for the new reason.
3407 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3408 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3409 I<commission_pkgnum>.
3411 Any other options are passed to FS::cust_credit::insert.
3416 my( $self, $amount, $reason, %options ) = @_;
3418 my $cust_credit = new FS::cust_credit {
3419 'custnum' => $self->custnum,
3420 'amount' => $amount,
3423 if ( ref($reason) ) {
3425 if ( ref($reason) eq 'SCALAR' ) {
3426 $cust_credit->reasonnum( $$reason );
3428 $cust_credit->reasonnum( $reason->reasonnum );
3432 $cust_credit->set('reason', $reason)
3435 $cust_credit->$_( delete $options{$_} )
3436 foreach grep exists($options{$_}),
3437 qw( addlinfo eventnum ),
3438 map "commission_$_", qw( agentnum salesnum pkgnum );
3440 $cust_credit->insert(%options);
3444 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3446 Creates a one-time charge for this customer. If there is an error, returns
3447 the error, otherwise returns false.
3449 New-style, with a hashref of options:
3451 my $error = $cust_main->charge(
3455 'start_date' => str2time('7/4/2009'),
3456 'pkg' => 'Description',
3457 'comment' => 'Comment',
3458 'additional' => [], #extra invoice detail
3459 'classnum' => 1, #pkg_class
3461 'setuptax' => '', # or 'Y' for tax exempt
3463 'locationnum'=> 1234, # optional
3466 'taxclass' => 'Tax class',
3469 'taxproduct' => 2, #part_pkg_taxproduct
3470 'override' => {}, #XXX describe
3472 #will be filled in with the new object
3473 'cust_pkg_ref' => \$cust_pkg,
3475 #generate an invoice immediately
3477 'invoice_terms' => '', #with these terms
3483 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3487 #super false laziness w/quotation::charge
3490 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3491 my ( $pkg, $comment, $additional );
3492 my ( $setuptax, $taxclass ); #internal taxes
3493 my ( $taxproduct, $override ); #vendor (CCH) taxes
3495 my $separate_bill = '';
3496 my $cust_pkg_ref = '';
3497 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3499 if ( ref( $_[0] ) ) {
3500 $amount = $_[0]->{amount};
3501 $setup_cost = $_[0]->{setup_cost};
3502 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3503 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3504 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3505 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3506 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3507 : '$'. sprintf("%.2f",$amount);
3508 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3509 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3510 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3511 $additional = $_[0]->{additional} || [];
3512 $taxproduct = $_[0]->{taxproductnum};
3513 $override = { '' => $_[0]->{tax_override} };
3514 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3515 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3516 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3517 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3518 $separate_bill = $_[0]->{separate_bill} || '';
3524 $pkg = @_ ? shift : 'One-time charge';
3525 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3527 $taxclass = @_ ? shift : '';
3531 local $SIG{HUP} = 'IGNORE';
3532 local $SIG{INT} = 'IGNORE';
3533 local $SIG{QUIT} = 'IGNORE';
3534 local $SIG{TERM} = 'IGNORE';
3535 local $SIG{TSTP} = 'IGNORE';
3536 local $SIG{PIPE} = 'IGNORE';
3538 my $oldAutoCommit = $FS::UID::AutoCommit;
3539 local $FS::UID::AutoCommit = 0;
3542 my $part_pkg = new FS::part_pkg ( {
3544 'comment' => $comment,
3548 'classnum' => ( $classnum ? $classnum : '' ),
3549 'setuptax' => $setuptax,
3550 'taxclass' => $taxclass,
3551 'taxproductnum' => $taxproduct,
3552 'setup_cost' => $setup_cost,
3555 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3556 ( 0 .. @$additional - 1 )
3558 'additional_count' => scalar(@$additional),
3559 'setup_fee' => $amount,
3562 my $error = $part_pkg->insert( options => \%options,
3563 tax_overrides => $override,
3566 $dbh->rollback if $oldAutoCommit;
3570 my $pkgpart = $part_pkg->pkgpart;
3571 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3572 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3573 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3574 $error = $type_pkgs->insert;
3576 $dbh->rollback if $oldAutoCommit;
3581 my $cust_pkg = new FS::cust_pkg ( {
3582 'custnum' => $self->custnum,
3583 'pkgpart' => $pkgpart,
3584 'quantity' => $quantity,
3585 'start_date' => $start_date,
3586 'no_auto' => $no_auto,
3587 'separate_bill' => $separate_bill,
3588 'locationnum'=> $locationnum,
3591 $error = $cust_pkg->insert;
3593 $dbh->rollback if $oldAutoCommit;
3595 } elsif ( $cust_pkg_ref ) {
3596 ${$cust_pkg_ref} = $cust_pkg;
3600 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3601 'pkg_list' => [ $cust_pkg ],
3604 $dbh->rollback if $oldAutoCommit;
3609 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3614 #=item charge_postal_fee
3616 #Applies a one time charge this customer. If there is an error,
3617 #returns the error, returns the cust_pkg charge object or false
3618 #if there was no charge.
3622 # This should be a customer event. For that to work requires that bill
3623 # also be a customer event.
3625 sub charge_postal_fee {
3628 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3629 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3631 my $cust_pkg = new FS::cust_pkg ( {
3632 'custnum' => $self->custnum,
3633 'pkgpart' => $pkgpart,
3637 my $error = $cust_pkg->insert;
3638 $error ? $error : $cust_pkg;
3641 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3643 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3645 Optionally, a list or hashref of additional arguments to the qsearch call can
3652 my $opt = ref($_[0]) ? shift : { @_ };
3654 #return $self->num_cust_bill unless wantarray || keys %$opt;
3656 $opt->{'table'} = 'cust_bill';
3657 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3658 $opt->{'hashref'}{'custnum'} = $self->custnum;
3659 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3661 map { $_ } #behavior of sort undefined in scalar context
3662 sort { $a->_date <=> $b->_date }
3666 =item open_cust_bill
3668 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3673 sub open_cust_bill {
3677 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3683 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3685 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3689 sub legacy_cust_bill {
3692 #return $self->num_legacy_cust_bill unless wantarray;
3694 map { $_ } #behavior of sort undefined in scalar context
3695 sort { $a->_date <=> $b->_date }
3696 qsearch({ 'table' => 'legacy_cust_bill',
3697 'hashref' => { 'custnum' => $self->custnum, },
3698 'order_by' => 'ORDER BY _date ASC',
3702 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3704 Returns all the statements (see L<FS::cust_statement>) for this customer.
3706 Optionally, a list or hashref of additional arguments to the qsearch call can
3711 =item cust_bill_void
3713 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3717 sub cust_bill_void {
3720 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3721 sort { $a->_date <=> $b->_date }
3722 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3725 sub cust_statement {
3727 my $opt = ref($_[0]) ? shift : { @_ };
3729 #return $self->num_cust_statement unless wantarray || keys %$opt;
3731 $opt->{'table'} = 'cust_statement';
3732 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3733 $opt->{'hashref'}{'custnum'} = $self->custnum;
3734 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3736 map { $_ } #behavior of sort undefined in scalar context
3737 sort { $a->_date <=> $b->_date }
3741 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3743 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3745 Optionally, a list or hashref of additional arguments to the qsearch call can
3746 be passed following the SVCDB.
3753 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3754 warn "$me svc_x requires a svcdb";
3757 my $opt = ref($_[0]) ? shift : { @_ };
3759 $opt->{'table'} = $svcdb;
3760 $opt->{'addl_from'} =
3761 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3762 ($opt->{'addl_from'} || '');
3764 my $custnum = $self->custnum;
3765 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3766 my $where = "cust_pkg.custnum = $custnum";
3768 my $extra_sql = $opt->{'extra_sql'} || '';
3769 if ( keys %{ $opt->{'hashref'} } ) {
3770 $extra_sql = " AND $where $extra_sql";
3773 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3774 $extra_sql = "WHERE $where AND $1";
3777 $extra_sql = "WHERE $where $extra_sql";
3780 $opt->{'extra_sql'} = $extra_sql;
3785 # required for use as an eventtable;
3788 $self->svc_x('svc_acct', @_);
3793 Returns all the credits (see L<FS::cust_credit>) for this customer.
3799 map { $_ } #return $self->num_cust_credit unless wantarray;
3800 sort { $a->_date <=> $b->_date }
3801 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3804 =item cust_credit_pkgnum
3806 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3807 package when using experimental package balances.
3811 sub cust_credit_pkgnum {
3812 my( $self, $pkgnum ) = @_;
3813 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3814 sort { $a->_date <=> $b->_date }
3815 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3816 'pkgnum' => $pkgnum,
3821 =item cust_credit_void
3823 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3827 sub cust_credit_void {
3830 sort { $a->_date <=> $b->_date }
3831 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3836 Returns all the payments (see L<FS::cust_pay>) for this customer.
3842 my $opt = ref($_[0]) ? shift : { @_ };
3844 return $self->num_cust_pay unless wantarray || keys %$opt;
3846 $opt->{'table'} = 'cust_pay';
3847 $opt->{'hashref'}{'custnum'} = $self->custnum;
3849 map { $_ } #behavior of sort undefined in scalar context
3850 sort { $a->_date <=> $b->_date }
3857 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3858 called automatically when the cust_pay method is used in a scalar context.
3864 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3865 my $sth = dbh->prepare($sql) or die dbh->errstr;
3866 $sth->execute($self->custnum) or die $sth->errstr;
3867 $sth->fetchrow_arrayref->[0];
3870 =item unapplied_cust_pay
3872 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3876 sub unapplied_cust_pay {
3880 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3886 =item cust_pay_pkgnum
3888 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3889 package when using experimental package balances.
3893 sub cust_pay_pkgnum {
3894 my( $self, $pkgnum ) = @_;
3895 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3896 sort { $a->_date <=> $b->_date }
3897 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3898 'pkgnum' => $pkgnum,
3905 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3911 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3912 sort { $a->_date <=> $b->_date }
3913 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3916 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3918 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3920 Optionally, a list or hashref of additional arguments to the qsearch call can
3925 sub cust_pay_batch {
3927 my $opt = ref($_[0]) ? shift : { @_ };
3929 #return $self->num_cust_statement unless wantarray || keys %$opt;
3931 $opt->{'table'} = 'cust_pay_batch';
3932 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3933 $opt->{'hashref'}{'custnum'} = $self->custnum;
3934 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3936 map { $_ } #behavior of sort undefined in scalar context
3937 sort { $a->paybatchnum <=> $b->paybatchnum }
3941 =item cust_pay_pending
3943 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3944 (without status "done").
3948 sub cust_pay_pending {
3950 return $self->num_cust_pay_pending unless wantarray;
3951 sort { $a->_date <=> $b->_date }
3952 qsearch( 'cust_pay_pending', {
3953 'custnum' => $self->custnum,
3954 'status' => { op=>'!=', value=>'done' },
3959 =item cust_pay_pending_attempt
3961 Returns all payment attempts / declined payments for this customer, as pending
3962 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3963 a corresponding payment (see L<FS::cust_pay>).
3967 sub cust_pay_pending_attempt {
3969 return $self->num_cust_pay_pending_attempt unless wantarray;
3970 sort { $a->_date <=> $b->_date }
3971 qsearch( 'cust_pay_pending', {
3972 'custnum' => $self->custnum,
3979 =item num_cust_pay_pending
3981 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3982 customer (without status "done"). Also called automatically when the
3983 cust_pay_pending method is used in a scalar context.
3987 sub num_cust_pay_pending {
3990 " SELECT COUNT(*) FROM cust_pay_pending ".
3991 " WHERE custnum = ? AND status != 'done' ",
3996 =item num_cust_pay_pending_attempt
3998 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3999 customer, with status "done" but without a corresp. Also called automatically when the
4000 cust_pay_pending method is used in a scalar context.
4004 sub num_cust_pay_pending_attempt {
4007 " SELECT COUNT(*) FROM cust_pay_pending ".
4008 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4015 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4021 map { $_ } #return $self->num_cust_refund unless wantarray;
4022 sort { $a->_date <=> $b->_date }
4023 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4026 =item display_custnum
4028 Returns the displayed customer number for this customer: agent_custid if
4029 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4033 sub display_custnum {
4036 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
4037 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
4038 if ( $special eq 'CoStAg' ) {
4039 $prefix = uc( join('',
4041 ($self->state =~ /^(..)/),
4042 $prefix || ($self->agent->agent =~ /^(..)/)
4045 elsif ( $special eq 'CoStCl' ) {
4046 $prefix = uc( join('',
4048 ($self->state =~ /^(..)/),
4049 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
4052 # add any others here if needed
4055 my $length = $conf->config('cust_main-custnum-display_length');
4056 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4057 return $self->agent_custid;
4058 } elsif ( $prefix ) {
4059 $length = 8 if !defined($length);
4061 sprintf('%0'.$length.'d', $self->custnum)
4062 } elsif ( $length ) {
4063 return sprintf('%0'.$length.'d', $self->custnum);
4065 return $self->custnum;
4071 Returns a name string for this customer, either "Company (Last, First)" or
4078 my $name = $self->contact;
4079 $name = $self->company. " ($name)" if $self->company;
4083 =item service_contact
4085 Returns the L<FS::contact> object for this customer that has the 'Service'
4086 contact class, or undef if there is no such contact. Deprecated; don't use
4091 sub service_contact {
4093 if ( !exists($self->{service_contact}) ) {
4094 my $classnum = $self->scalar_sql(
4095 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4096 ) || 0; #if it's zero, qsearchs will return nothing
4097 $self->{service_contact} = qsearchs('contact', {
4098 'classnum' => $classnum, 'custnum' => $self->custnum
4101 $self->{service_contact};
4106 Returns a name string for this (service/shipping) contact, either
4107 "Company (Last, First)" or "Last, First".
4114 my $name = $self->ship_contact;
4115 $name = $self->company. " ($name)" if $self->company;
4121 Returns a name string for this customer, either "Company" or "First Last".
4127 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4130 =item ship_name_short
4132 Returns a name string for this (service/shipping) contact, either "Company"
4137 sub ship_name_short {
4139 $self->service_contact
4140 ? $self->ship_contact_firstlast
4146 Returns this customer's full (billing) contact name only, "Last, First"
4152 $self->get('last'). ', '. $self->first;
4157 Returns this customer's full (shipping) contact name only, "Last, First"
4163 my $contact = $self->service_contact || $self;
4164 $contact->get('last') . ', ' . $contact->get('first');
4167 =item contact_firstlast
4169 Returns this customers full (billing) contact name only, "First Last".
4173 sub contact_firstlast {
4175 $self->first. ' '. $self->get('last');
4178 =item ship_contact_firstlast
4180 Returns this customer's full (shipping) contact name only, "First Last".
4184 sub ship_contact_firstlast {
4186 my $contact = $self->service_contact || $self;
4187 $contact->get('first') . ' '. $contact->get('last');
4190 #XXX this doesn't work in 3.x+
4193 #Returns this customer's full country name
4199 # code2country($self->country);
4202 sub bill_country_full {
4204 code2country($self->bill_location->country);
4207 sub ship_country_full {
4209 code2country($self->ship_location->country);
4212 =item county_state_county [ PREFIX ]
4214 Returns a string consisting of just the county, state and country.
4218 sub county_state_country {
4221 if ( @_ && $_[0] && $self->has_ship_address ) {
4222 $locationnum = $self->ship_locationnum;
4224 $locationnum = $self->bill_locationnum;
4226 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4227 $cust_location->county_state_country;
4230 =item geocode DATA_VENDOR
4232 Returns a value for the customer location as encoded by DATA_VENDOR.
4233 Currently this only makes sense for "CCH" as DATA_VENDOR.
4241 Returns a status string for this customer, currently:
4245 =item prospect - No packages have ever been ordered
4247 =item ordered - Recurring packages all are new (not yet billed).
4249 =item active - One or more recurring packages is active
4251 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4253 =item suspended - All non-cancelled recurring packages are suspended
4255 =item cancelled - All recurring packages are cancelled
4259 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4260 cust_main-status_module configuration option.
4264 sub status { shift->cust_status(@_); }
4268 for my $status ( FS::cust_main->statuses() ) {
4269 my $method = $status.'_sql';
4270 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4271 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4272 $sth->execute( ($self->custnum) x $numnum )
4273 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4274 return $status if $sth->fetchrow_arrayref->[0];
4278 =item is_status_delay_cancel
4280 Returns true if customer status is 'suspended'
4281 and all suspended cust_pkg return true for
4282 cust_pkg->is_status_delay_cancel.
4284 This is not a real status, this only meant for hacking display
4285 values, because otherwise treating the customer as suspended is
4286 really the whole point of the delay_cancel option.
4290 sub is_status_delay_cancel {
4292 return 0 unless $self->status eq 'suspended';
4293 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4294 return 0 unless $cust_pkg->is_status_delay_cancel;
4299 =item ucfirst_cust_status
4301 =item ucfirst_status
4303 Returns the status with the first character capitalized.
4307 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4309 sub ucfirst_cust_status {
4311 ucfirst($self->cust_status);
4316 Returns a hex triplet color string for this customer's status.
4320 sub statuscolor { shift->cust_statuscolor(@_); }
4322 sub cust_statuscolor {
4324 __PACKAGE__->statuscolors->{$self->cust_status};
4327 =item tickets [ STATUS ]
4329 Returns an array of hashes representing the customer's RT tickets.
4331 An optional status (or arrayref or hashref of statuses) may be specified.
4337 my $status = ( @_ && $_[0] ) ? shift : '';
4339 my $num = $conf->config('cust_main-max_tickets') || 10;
4342 if ( $conf->config('ticket_system') ) {
4343 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4345 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4354 foreach my $priority (
4355 $conf->config('ticket_system-custom_priority_field-values'), ''
4357 last if scalar(@tickets) >= $num;
4359 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4360 $num - scalar(@tickets),
4371 # Return services representing svc_accts in customer support packages
4372 sub support_services {
4374 my %packages = map { $_ => 1 } $conf->config('support_packages');
4376 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4377 grep { $_->part_svc->svcdb eq 'svc_acct' }
4378 map { $_->cust_svc }
4379 grep { exists $packages{ $_->pkgpart } }
4380 $self->ncancelled_pkgs;
4384 # Return a list of latitude/longitude for one of the services (if any)
4385 sub service_coordinates {
4389 grep { $_->latitude && $_->longitude }
4391 map { $_->cust_svc }
4392 $self->ncancelled_pkgs;
4394 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4399 Returns a masked version of the named field
4404 my ($self,$field) = @_;
4408 'x'x(length($self->getfield($field))-4).
4409 substr($self->getfield($field), (length($self->getfield($field))-4));
4415 =head1 CLASS METHODS
4421 Class method that returns the list of possible status strings for customers
4422 (see L<the status method|/status>). For example:
4424 @statuses = FS::cust_main->statuses();
4430 keys %{ $self->statuscolors };
4433 =item cust_status_sql
4435 Returns an SQL fragment to determine the status of a cust_main record, as a
4440 sub cust_status_sql {
4442 for my $status ( FS::cust_main->statuses() ) {
4443 my $method = $status.'_sql';
4444 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4453 Returns an SQL expression identifying prospective cust_main records (customers
4454 with no packages ever ordered)
4458 use vars qw($select_count_pkgs);
4459 $select_count_pkgs =
4460 "SELECT COUNT(*) FROM cust_pkg
4461 WHERE cust_pkg.custnum = cust_main.custnum";
4463 sub select_count_pkgs_sql {
4468 " 0 = ( $select_count_pkgs ) ";
4473 Returns an SQL expression identifying ordered cust_main records (customers with
4474 no active packages, but recurring packages not yet setup or one time charges
4480 FS::cust_main->none_active_sql.
4481 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4486 Returns an SQL expression identifying active cust_main records (customers with
4487 active recurring packages).
4492 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4495 =item none_active_sql
4497 Returns an SQL expression identifying cust_main records with no active
4498 recurring packages. This includes customers of status prospect, ordered,
4499 inactive, and suspended.
4503 sub none_active_sql {
4504 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4509 Returns an SQL expression identifying inactive cust_main records (customers with
4510 no active recurring packages, but otherwise unsuspended/uncancelled).
4515 FS::cust_main->none_active_sql.
4516 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4522 Returns an SQL expression identifying suspended cust_main records.
4527 sub suspended_sql { susp_sql(@_); }
4529 FS::cust_main->none_active_sql.
4530 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4536 Returns an SQL expression identifying cancelled cust_main records.
4540 sub cancel_sql { shift->cancelled_sql(@_); }
4543 =item uncancelled_sql
4545 Returns an SQL expression identifying un-cancelled cust_main records.
4549 sub uncancelled_sql { uncancel_sql(@_); }
4550 sub uncancel_sql { "
4551 ( 0 < ( $select_count_pkgs
4552 AND ( cust_pkg.cancel IS NULL
4553 OR cust_pkg.cancel = 0
4556 OR 0 = ( $select_count_pkgs )
4562 Returns an SQL fragment to retreive the balance.
4567 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4568 WHERE cust_bill.custnum = cust_main.custnum )
4569 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4570 WHERE cust_pay.custnum = cust_main.custnum )
4571 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4572 WHERE cust_credit.custnum = cust_main.custnum )
4573 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4574 WHERE cust_refund.custnum = cust_main.custnum )
4577 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4579 Returns an SQL fragment to retreive the balance for this customer, optionally
4580 considering invoices with date earlier than START_TIME, and not
4581 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4582 total_unapplied_payments).
4584 Times are specified as SQL fragments or numeric
4585 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4586 L<Date::Parse> for conversion functions. The empty string can be passed
4587 to disable that time constraint completely.
4589 Available options are:
4593 =item unapplied_date
4595 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)
4600 set to true to remove all customer comparison clauses, for totals
4605 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4610 JOIN clause (typically used with the total option)
4614 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4615 time will be ignored. Note that START_TIME and END_TIME only limit the date
4616 range for invoices and I<unapplied> payments, credits, and refunds.
4622 sub balance_date_sql {
4623 my( $class, $start, $end, %opt ) = @_;
4625 my $cutoff = $opt{'cutoff'};
4627 my $owed = FS::cust_bill->owed_sql($cutoff);
4628 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4629 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4630 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4632 my $j = $opt{'join'} || '';
4634 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4635 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4636 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4637 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4639 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4640 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4641 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4642 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4647 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4649 Returns an SQL fragment to retreive the total unapplied payments for this
4650 customer, only considering payments with date earlier than START_TIME, and
4651 optionally not later than END_TIME.
4653 Times are specified as SQL fragments or numeric
4654 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4655 L<Date::Parse> for conversion functions. The empty string can be passed
4656 to disable that time constraint completely.
4658 Available options are:
4662 sub unapplied_payments_date_sql {
4663 my( $class, $start, $end, %opt ) = @_;
4665 my $cutoff = $opt{'cutoff'};
4667 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4669 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4670 'unapplied_date'=>1 );
4672 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4675 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4677 Helper method for balance_date_sql; name (and usage) subject to change
4678 (suggestions welcome).
4680 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4681 cust_refund, cust_credit or cust_pay).
4683 If TABLE is "cust_bill" or the unapplied_date option is true, only
4684 considers records with date earlier than START_TIME, and optionally not
4685 later than END_TIME .
4689 sub _money_table_where {
4690 my( $class, $table, $start, $end, %opt ) = @_;
4693 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4694 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4695 push @where, "$table._date <= $start" if defined($start) && length($start);
4696 push @where, "$table._date > $end" if defined($end) && length($end);
4698 push @where, @{$opt{'where'}} if $opt{'where'};
4699 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4705 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4706 use FS::cust_main::Search;
4709 FS::cust_main::Search->search(@_);
4724 #warn join('-',keys %$param);
4725 my $fh = $param->{filehandle};
4726 my $agentnum = $param->{agentnum};
4727 my $format = $param->{format};
4729 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4732 if ( $format eq 'simple' ) {
4733 @fields = qw( custnum agent_custid amount pkg );
4735 die "unknown format $format";
4738 eval "use Text::CSV_XS;";
4741 my $csv = new Text::CSV_XS;
4748 local $SIG{HUP} = 'IGNORE';
4749 local $SIG{INT} = 'IGNORE';
4750 local $SIG{QUIT} = 'IGNORE';
4751 local $SIG{TERM} = 'IGNORE';
4752 local $SIG{TSTP} = 'IGNORE';
4753 local $SIG{PIPE} = 'IGNORE';
4755 my $oldAutoCommit = $FS::UID::AutoCommit;
4756 local $FS::UID::AutoCommit = 0;
4759 #while ( $columns = $csv->getline($fh) ) {
4761 while ( defined($line=<$fh>) ) {
4763 $csv->parse($line) or do {
4764 $dbh->rollback if $oldAutoCommit;
4765 return "can't parse: ". $csv->error_input();
4768 my @columns = $csv->fields();
4769 #warn join('-',@columns);
4772 foreach my $field ( @fields ) {
4773 $row{$field} = shift @columns;
4776 if ( $row{custnum} && $row{agent_custid} ) {
4777 dbh->rollback if $oldAutoCommit;
4778 return "can't specify custnum with agent_custid $row{agent_custid}";
4782 if ( $row{agent_custid} && $agentnum ) {
4783 %hash = ( 'agent_custid' => $row{agent_custid},
4784 'agentnum' => $agentnum,
4788 if ( $row{custnum} ) {
4789 %hash = ( 'custnum' => $row{custnum} );
4792 unless ( scalar(keys %hash) ) {
4793 $dbh->rollback if $oldAutoCommit;
4794 return "can't find customer without custnum or agent_custid and agentnum";
4797 my $cust_main = qsearchs('cust_main', { %hash } );
4798 unless ( $cust_main ) {
4799 $dbh->rollback if $oldAutoCommit;
4800 my $custnum = $row{custnum} || $row{agent_custid};
4801 return "unknown custnum $custnum";
4804 if ( $row{'amount'} > 0 ) {
4805 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4807 $dbh->rollback if $oldAutoCommit;
4811 } elsif ( $row{'amount'} < 0 ) {
4812 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4815 $dbh->rollback if $oldAutoCommit;
4825 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4827 return "Empty file!" unless $imported;
4833 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4835 Deprecated. Use event notification and message templates
4836 (L<FS::msg_template>) instead.
4838 Sends a templated email notification to the customer (see L<Text::Template>).
4840 OPTIONS is a hash and may include
4842 I<from> - the email sender (default is invoice_from)
4844 I<to> - comma-separated scalar or arrayref of recipients
4845 (default is invoicing_list)
4847 I<subject> - The subject line of the sent email notification
4848 (default is "Notice from company_name")
4850 I<extra_fields> - a hashref of name/value pairs which will be substituted
4853 The following variables are vavailable in the template.
4855 I<$first> - the customer first name
4856 I<$last> - the customer last name
4857 I<$company> - the customer company
4858 I<$payby> - a description of the method of payment for the customer
4859 # would be nice to use FS::payby::shortname
4860 I<$payinfo> - the account information used to collect for this customer
4861 I<$expdate> - the expiration of the customer payment in seconds from epoch
4866 my ($self, $template, %options) = @_;
4868 return unless $conf->exists($template);
4870 my $from = $conf->invoice_from_full($self->agentnum)
4871 if $conf->exists('invoice_from', $self->agentnum);
4872 $from = $options{from} if exists($options{from});
4874 my $to = join(',', $self->invoicing_list_emailonly);
4875 $to = $options{to} if exists($options{to});
4877 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4878 if $conf->exists('company_name', $self->agentnum);
4879 $subject = $options{subject} if exists($options{subject});
4881 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4882 SOURCE => [ map "$_\n",
4883 $conf->config($template)]
4885 or die "can't create new Text::Template object: Text::Template::ERROR";
4886 $notify_template->compile()
4887 or die "can't compile template: Text::Template::ERROR";
4889 $FS::notify_template::_template::company_name =
4890 $conf->config('company_name', $self->agentnum);
4891 $FS::notify_template::_template::company_address =
4892 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4894 my $paydate = $self->paydate || '2037-12-31';
4895 $FS::notify_template::_template::first = $self->first;
4896 $FS::notify_template::_template::last = $self->last;
4897 $FS::notify_template::_template::company = $self->company;
4898 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4899 my $payby = $self->payby;
4900 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4901 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4903 #credit cards expire at the end of the month/year of their exp date
4904 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4905 $FS::notify_template::_template::payby = 'credit card';
4906 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4907 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4909 }elsif ($payby eq 'COMP') {
4910 $FS::notify_template::_template::payby = 'complimentary account';
4912 $FS::notify_template::_template::payby = 'current method';
4914 $FS::notify_template::_template::expdate = $expire_time;
4916 for (keys %{$options{extra_fields}}){
4918 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4921 send_email(from => $from,
4923 subject => $subject,
4924 body => $notify_template->fill_in( PACKAGE =>
4925 'FS::notify_template::_template' ),
4930 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4932 Generates a templated notification to the customer (see L<Text::Template>).
4934 OPTIONS is a hash and may include
4936 I<extra_fields> - a hashref of name/value pairs which will be substituted
4937 into the template. These values may override values mentioned below
4938 and those from the customer record.
4940 The following variables are available in the template instead of or in addition
4941 to the fields of the customer record.
4943 I<$payby> - a description of the method of payment for the customer
4944 # would be nice to use FS::payby::shortname
4945 I<$payinfo> - the masked account information used to collect for this customer
4946 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4947 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4951 # a lot like cust_bill::print_latex
4952 sub generate_letter {
4953 my ($self, $template, %options) = @_;
4955 return unless $conf->exists($template);
4957 my $letter_template = new Text::Template
4959 SOURCE => [ map "$_\n", $conf->config($template)],
4960 DELIMITERS => [ '[@--', '--@]' ],
4962 or die "can't create new Text::Template object: Text::Template::ERROR";
4964 $letter_template->compile()
4965 or die "can't compile template: Text::Template::ERROR";
4967 my %letter_data = map { $_ => $self->$_ } $self->fields;
4968 $letter_data{payinfo} = $self->mask_payinfo;
4970 #my $paydate = $self->paydate || '2037-12-31';
4971 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4973 my $payby = $self->payby;
4974 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4975 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4977 #credit cards expire at the end of the month/year of their exp date
4978 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4979 $letter_data{payby} = 'credit card';
4980 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4981 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4983 }elsif ($payby eq 'COMP') {
4984 $letter_data{payby} = 'complimentary account';
4986 $letter_data{payby} = 'current method';
4988 $letter_data{expdate} = $expire_time;
4990 for (keys %{$options{extra_fields}}){
4991 $letter_data{$_} = $options{extra_fields}->{$_};
4994 unless(exists($letter_data{returnaddress})){
4995 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4996 $self->agent_template)
4998 if ( length($retadd) ) {
4999 $letter_data{returnaddress} = $retadd;
5000 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5001 $letter_data{returnaddress} =
5002 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5006 ( $conf->config('company_name', $self->agentnum),
5007 $conf->config('company_address', $self->agentnum),
5011 $letter_data{returnaddress} = '~';
5015 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5017 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5019 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5021 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5025 ) or die "can't open temp file: $!\n";
5026 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5027 or die "can't write temp file: $!\n";
5029 $letter_data{'logo_file'} = $lh->filename;
5031 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5035 ) or die "can't open temp file: $!\n";
5037 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5039 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5040 return ($1, $letter_data{'logo_file'});
5044 =item print_ps TEMPLATE
5046 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5052 my($file, $lfile) = $self->generate_letter(@_);
5053 my $ps = FS::Misc::generate_ps($file);
5054 unlink($file.'.tex');
5060 =item print TEMPLATE
5062 Prints the filled in template.
5064 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5068 sub queueable_print {
5071 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5072 or die "invalid customer number: " . $opt{custnum};
5074 my $error = $self->print( { 'template' => $opt{template} } );
5075 die $error if $error;
5079 my ($self, $template) = (shift, shift);
5081 [ $self->print_ps($template) ],
5082 'agentnum' => $self->agentnum,
5086 #these three subs should just go away once agent stuff is all config overrides
5088 sub agent_template {
5090 $self->_agent_plandata('agent_templatename');
5093 sub agent_invoice_from {
5095 $self->_agent_plandata('agent_invoice_from');
5098 sub _agent_plandata {
5099 my( $self, $option ) = @_;
5101 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5102 #agent-specific Conf
5104 use FS::part_event::Condition;
5106 my $agentnum = $self->agentnum;
5108 my $regexp = regexp_sql();
5110 my $part_event_option =
5112 'select' => 'part_event_option.*',
5113 'table' => 'part_event_option',
5115 LEFT JOIN part_event USING ( eventpart )
5116 LEFT JOIN part_event_option AS peo_agentnum
5117 ON ( part_event.eventpart = peo_agentnum.eventpart
5118 AND peo_agentnum.optionname = 'agentnum'
5119 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5121 LEFT JOIN part_event_condition
5122 ON ( part_event.eventpart = part_event_condition.eventpart
5123 AND part_event_condition.conditionname = 'cust_bill_age'
5125 LEFT JOIN part_event_condition_option
5126 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5127 AND part_event_condition_option.optionname = 'age'
5130 #'hashref' => { 'optionname' => $option },
5131 #'hashref' => { 'part_event_option.optionname' => $option },
5133 " WHERE part_event_option.optionname = ". dbh->quote($option).
5134 " AND action = 'cust_bill_send_agent' ".
5135 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5136 " AND peo_agentnum.optionname = 'agentnum' ".
5137 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5139 CASE WHEN part_event_condition_option.optionname IS NULL
5141 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5143 , part_event.weight".
5147 unless ( $part_event_option ) {
5148 return $self->agent->invoice_template || ''
5149 if $option eq 'agent_templatename';
5153 $part_event_option->optionvalue;
5157 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5159 Subroutine (not a method), designed to be called from the queue.
5161 Takes a list of options and values.
5163 Pulls up the customer record via the custnum option and calls bill_and_collect.
5168 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5170 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5171 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5173 #without this errors don't get rolled back
5174 $args{'fatal'} = 1; # runs from job queue, will be caught
5176 $cust_main->bill_and_collect( %args );
5179 sub process_bill_and_collect {
5181 my $param = thaw(decode_base64(shift));
5182 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5183 or die "custnum '$param->{custnum}' not found!\n";
5184 $param->{'job'} = $job;
5185 $param->{'fatal'} = 1; # runs from job queue, will be caught
5186 $param->{'retry'} = 1;
5188 $cust_main->bill_and_collect( %$param );
5191 #starting to take quite a while for big dbs
5192 # (JRNL: journaled so it only happens once per database)
5193 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5194 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5195 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5196 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5197 # JRNL leading/trailing spaces in first, last, company
5198 # - otaker upgrade? journal and call it good? (double check to make sure
5199 # we're not still setting otaker here)
5201 #only going to get worse with new location stuff...
5203 sub _upgrade_data { #class method
5204 my ($class, %opts) = @_;
5207 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5210 #this seems to be the only expensive one.. why does it take so long?
5211 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5213 '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';
5214 FS::upgrade_journal->set_done('cust_main__signupdate');
5217 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5219 # fix yyyy-m-dd formatted paydates
5220 if ( driver_name =~ /^mysql/i ) {
5222 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5223 } else { # the SQL standard
5225 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5227 FS::upgrade_journal->set_done('cust_main__paydate');
5230 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5232 push @statements, #fix the weird BILL with a cc# in payinfo problem
5234 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5236 FS::upgrade_journal->set_done('cust_main__payinfo');
5241 foreach my $sql ( @statements ) {
5242 my $sth = dbh->prepare($sql) or die dbh->errstr;
5243 $sth->execute or die $sth->errstr;
5244 #warn ( (time - $t). " seconds\n" );
5248 local($ignore_expired_card) = 1;
5249 local($ignore_banned_card) = 1;
5250 local($skip_fuzzyfiles) = 1;
5251 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5253 FS::cust_main::Location->_upgrade_data(%opts);
5255 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5257 foreach my $cust_main ( qsearch({
5258 'table' => 'cust_main',
5260 'extra_sql' => 'WHERE '.
5262 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5263 qw( first last company )
5266 my $error = $cust_main->replace;
5267 die $error if $error;
5270 FS::upgrade_journal->set_done('cust_main__trimspaces');
5274 $class->_upgrade_otaker(%opts);
5284 The delete method should possibly take an FS::cust_main object reference
5285 instead of a scalar customer number.
5287 Bill and collect options should probably be passed as references instead of a
5290 There should probably be a configuration file with a list of allowed credit
5293 No multiple currency support (probably a larger project than just this module).
5295 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5297 Birthdates rely on negative epoch values.
5299 The payby for card/check batches is broken. With mixed batching, bad
5302 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5306 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5307 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5308 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.