5 #FS::cust_main:_Marketgear when they're ready to move to 2.1
6 use base qw( FS::cust_main::Packages FS::cust_main::Status
7 FS::cust_main::Billing FS::cust_main::Billing_Realtime
8 FS::cust_main::Billing_Discount
9 FS::cust_main::Location
10 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
11 FS::geocode_Mixin FS::Quotable_Mixin
15 use vars qw( $DEBUG $me $conf
18 $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
23 use Scalar::Util qw( blessed );
24 use Time::Local qw(timelocal);
25 use Storable qw(thaw);
29 use Digest::MD5 qw(md5_base64);
32 use File::Temp; #qw( tempfile );
33 use Business::CreditCard 0.28;
35 use FS::UID qw( getotaker dbh driver_name );
36 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
37 use FS::Misc qw( generate_email send_email generate_ps do_print );
38 use FS::Msgcat qw(gettext);
45 use FS::cust_bill_void;
46 use FS::legacy_cust_bill;
48 use FS::cust_pay_pending;
49 use FS::cust_pay_void;
50 use FS::cust_pay_batch;
53 use FS::part_referral;
54 use FS::cust_main_county;
55 use FS::cust_location;
57 use FS::cust_main_exemption;
58 use FS::cust_tax_adjustment;
59 use FS::cust_tax_location;
61 use FS::cust_main_invoice;
63 use FS::prepay_credit;
69 use FS::payment_gateway;
70 use FS::agent_payment_gateway;
72 use FS::cust_main_note;
73 use FS::cust_attachment;
76 use FS::upgrade_journal;
78 # 1 is mostly method/subroutine entry and options
79 # 2 traces progress of some operations
80 # 3 is even more information including possibly sensitive data
82 $me = '[FS::cust_main]';
85 $ignore_expired_card = 0;
86 $ignore_banned_card = 0;
90 @encrypted_fields = ('payinfo', 'paycvv');
91 sub nohistory_fields { ('payinfo', 'paycvv'); }
93 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
95 #ask FS::UID to run this stuff for us later
96 #$FS::UID::callback{'FS::cust_main'} = sub {
97 install_callback FS::UID sub {
99 #yes, need it for stuff below (prolly should be cached)
104 my ( $hashref, $cache ) = @_;
105 if ( exists $hashref->{'pkgnum'} ) {
106 #@{ $self->{'_pkgnum'} } = ();
107 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
108 $self->{'_pkgnum'} = $subcache;
109 #push @{ $self->{'_pkgnum'} },
110 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
116 FS::cust_main - Object methods for cust_main records
122 $record = new FS::cust_main \%hash;
123 $record = new FS::cust_main { 'column' => 'value' };
125 $error = $record->insert;
127 $error = $new_record->replace($old_record);
129 $error = $record->delete;
131 $error = $record->check;
133 @cust_pkg = $record->all_pkgs;
135 @cust_pkg = $record->ncancelled_pkgs;
137 @cust_pkg = $record->suspended_pkgs;
139 $error = $record->bill;
140 $error = $record->bill %options;
141 $error = $record->bill 'time' => $time;
143 $error = $record->collect;
144 $error = $record->collect %options;
145 $error = $record->collect 'invoice_time' => $time,
150 An FS::cust_main object represents a customer. FS::cust_main inherits from
151 FS::Record. The following fields are currently supported:
157 Primary key (assigned automatically for new customers)
161 Agent (see L<FS::agent>)
165 Advertising source (see L<FS::part_referral>)
177 Cocial security number (optional)
201 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
205 Payment Information (See L<FS::payinfo_Mixin> for data format)
209 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
213 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
217 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
221 Start date month (maestro/solo cards only)
225 Start date year (maestro/solo cards only)
229 Issue number (maestro/solo cards only)
233 Name on card or billing name
237 IP address from which payment information was received
241 Tax exempt, empty or `Y'
245 Order taker (see L<FS::access_user>)
251 =item referral_custnum
253 Referring customer number
257 Enable individual CDR spooling, empty or `Y'
261 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
265 Discourage individual CDR printing, empty or `Y'
269 Allow self-service editing of ticket subjects, empty or 'Y'
271 =item calling_list_exempt
273 Do not call, empty or 'Y'
283 Creates a new customer. To add the customer to the database, see L<"insert">.
285 Note that this stores the hash reference, not a distinct copy of the hash it
286 points to. You can ask the object for a copy with the I<hash> method.
290 sub table { 'cust_main'; }
292 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
294 Adds this customer to the database. If there is an error, returns the error,
295 otherwise returns false.
297 Usually the customer's location will not yet exist in the database, and
298 the C<bill_location> and C<ship_location> pseudo-fields must be set to
299 uninserted L<FS::cust_location> objects. These will be inserted and linked
300 (in both directions) to the new customer record. If they're references
301 to the same object, they will become the same location.
303 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
304 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
305 are inserted atomicly, or the transaction is rolled back. Passing an empty
306 hash reference is equivalent to not supplying this parameter. There should be
307 a better explanation of this, but until then, here's an example:
310 tie %hash, 'Tie::RefHash'; #this part is important
312 $cust_pkg => [ $svc_acct ],
315 $cust_main->insert( \%hash );
317 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
318 be set as the invoicing list (see L<"invoicing_list">). Errors return as
319 expected and rollback the entire transaction; it is not necessary to call
320 check_invoicing_list first. The invoicing_list is set after the records in the
321 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
322 invoicing_list destination to the newly-created svc_acct. Here's an example:
324 $cust_main->insert( {}, [ $email, 'POST' ] );
326 Currently available options are: I<depend_jobnum>, I<noexport>,
327 I<tax_exemption> and I<prospectnum>.
329 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
330 on the supplied jobnum (they will not run until the specific job completes).
331 This can be used to defer provisioning until some action completes (such
332 as running the customer's credit card successfully).
334 The I<noexport> option is deprecated. If I<noexport> is set true, no
335 provisioning jobs (exports) are scheduled. (You can schedule them later with
336 the B<reexport> method.)
338 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
339 of tax names and exemption numbers. FS::cust_main_exemption records will be
340 created and inserted.
342 If I<prospectnum> is set, moves contacts and locations from that prospect.
348 my $cust_pkgs = @_ ? shift : {};
349 my $invoicing_list = @_ ? shift : '';
351 warn "$me insert called with options ".
352 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
355 local $SIG{HUP} = 'IGNORE';
356 local $SIG{INT} = 'IGNORE';
357 local $SIG{QUIT} = 'IGNORE';
358 local $SIG{TERM} = 'IGNORE';
359 local $SIG{TSTP} = 'IGNORE';
360 local $SIG{PIPE} = 'IGNORE';
362 my $oldAutoCommit = $FS::UID::AutoCommit;
363 local $FS::UID::AutoCommit = 0;
366 my $prepay_identifier = '';
367 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
369 if ( $self->payby eq 'PREPAY' ) {
371 $self->payby('BILL');
372 $prepay_identifier = $self->payinfo;
375 warn " looking up prepaid card $prepay_identifier\n"
378 my $error = $self->get_prepay( $prepay_identifier,
379 'amount_ref' => \$amount,
380 'seconds_ref' => \$seconds,
381 'upbytes_ref' => \$upbytes,
382 'downbytes_ref' => \$downbytes,
383 'totalbytes_ref' => \$totalbytes,
386 $dbh->rollback if $oldAutoCommit;
387 #return "error applying prepaid card (transaction rolled back): $error";
391 $payby = 'PREP' if $amount;
393 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
396 $self->payby('BILL');
397 $amount = $self->paid;
402 foreach my $l (qw(bill_location ship_location)) {
403 my $loc = delete $self->hashref->{$l};
404 # XXX if we're moving a prospect's locations, do that here
409 if ( !$loc->locationnum ) {
410 # warn the location that we're going to insert it with no custnum
411 $loc->set(custnum_pending => 1);
412 warn " inserting $l\n"
414 my $error = $loc->insert;
416 $dbh->rollback if $oldAutoCommit;
417 my $label = $l eq 'ship_location' ? 'service' : 'billing';
418 return "$error (in $label location)";
421 elsif ( ($loc->custnum || 0) > 0 or $loc->prospectnum ) {
422 # then it somehow belongs to another customer--shouldn't happen
423 $dbh->rollback if $oldAutoCommit;
424 return "$l belongs to customer ".$loc->custnum;
426 # else it already belongs to this customer
427 # (happens when ship_location is identical to bill_location)
429 $self->set($l.'num', $loc->locationnum);
431 if ( $self->get($l.'num') eq '' ) {
432 $dbh->rollback if $oldAutoCommit;
437 warn " inserting $self\n"
440 $self->signupdate(time) unless $self->signupdate;
442 $self->auto_agent_custid()
443 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
445 my $error = $self->SUPER::insert;
447 $dbh->rollback if $oldAutoCommit;
448 #return "inserting cust_main record (transaction rolled back): $error";
452 # now set cust_location.custnum
453 foreach my $l (qw(bill_location ship_location)) {
454 warn " setting $l.custnum\n"
457 unless ( $loc->custnum ) {
458 $loc->set(custnum => $self->custnum);
459 $error ||= $loc->replace;
463 $dbh->rollback if $oldAutoCommit;
464 return "error setting $l custnum: $error";
468 warn " setting invoicing list\n"
471 if ( $invoicing_list ) {
472 $error = $self->check_invoicing_list( $invoicing_list );
474 $dbh->rollback if $oldAutoCommit;
475 #return "checking invoicing_list (transaction rolled back): $error";
478 $self->invoicing_list( $invoicing_list );
481 warn " setting customer tags\n"
484 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
485 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
486 'custnum' => $self->custnum };
487 my $error = $cust_tag->insert;
489 $dbh->rollback if $oldAutoCommit;
494 my $prospectnum = delete $options{'prospectnum'};
495 if ( $prospectnum ) {
497 warn " moving contacts and locations from prospect $prospectnum\n"
501 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
502 unless ( $prospect_main ) {
503 $dbh->rollback if $oldAutoCommit;
504 return "Unknown prospectnum $prospectnum";
506 $prospect_main->custnum($self->custnum);
507 $prospect_main->disabled('Y');
508 my $error = $prospect_main->replace;
510 $dbh->rollback if $oldAutoCommit;
514 my @contact = $prospect_main->contact;
515 my @cust_location = $prospect_main->cust_location;
516 my @qual = $prospect_main->qual;
518 foreach my $r ( @contact, @cust_location, @qual ) {
520 $r->custnum($self->custnum);
521 my $error = $r->replace;
523 $dbh->rollback if $oldAutoCommit;
530 warn " setting cust_main_exemption\n"
533 my $tax_exemption = delete $options{'tax_exemption'};
534 if ( $tax_exemption ) {
536 $tax_exemption = { map { $_ => '' } @$tax_exemption }
537 if ref($tax_exemption) eq 'ARRAY';
539 foreach my $taxname ( keys %$tax_exemption ) {
540 my $cust_main_exemption = new FS::cust_main_exemption {
541 'custnum' => $self->custnum,
542 'taxname' => $taxname,
543 'exempt_number' => $tax_exemption->{$taxname},
545 my $error = $cust_main_exemption->insert;
547 $dbh->rollback if $oldAutoCommit;
548 return "inserting cust_main_exemption (transaction rolled back): $error";
553 if ( $self->can('start_copy_skel') ) {
554 my $error = $self->start_copy_skel;
556 $dbh->rollback if $oldAutoCommit;
561 warn " ordering packages\n"
564 $error = $self->order_pkgs( $cust_pkgs,
566 'seconds_ref' => \$seconds,
567 'upbytes_ref' => \$upbytes,
568 'downbytes_ref' => \$downbytes,
569 'totalbytes_ref' => \$totalbytes,
572 $dbh->rollback if $oldAutoCommit;
577 $dbh->rollback if $oldAutoCommit;
578 return "No svc_acct record to apply pre-paid time";
580 if ( $upbytes || $downbytes || $totalbytes ) {
581 $dbh->rollback if $oldAutoCommit;
582 return "No svc_acct record to apply pre-paid data";
586 warn " inserting initial $payby payment of $amount\n"
588 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
590 $dbh->rollback if $oldAutoCommit;
591 return "inserting payment (transaction rolled back): $error";
595 unless ( $import || $skip_fuzzyfiles ) {
596 warn " queueing fuzzyfiles update\n"
598 $error = $self->queue_fuzzyfiles_update;
600 $dbh->rollback if $oldAutoCommit;
601 return "updating fuzzy search cache: $error";
605 # FS::geocode_Mixin::after_insert or something?
606 if ( $conf->config('tax_district_method') and !$import ) {
607 # if anything non-empty, try to look it up
608 my $queue = new FS::queue {
609 'job' => 'FS::geocode_Mixin::process_district_update',
610 'custnum' => $self->custnum,
612 my $error = $queue->insert( ref($self), $self->custnum );
614 $dbh->rollback if $oldAutoCommit;
615 return "queueing tax district update: $error";
620 warn " exporting\n" if $DEBUG > 1;
622 my $export_args = $options{'export_args'} || [];
625 map qsearch( 'part_export', {exportnum=>$_} ),
626 $conf->config('cust_main-exports'); #, $agentnum
628 foreach my $part_export ( @part_export ) {
629 my $error = $part_export->export_insert($self, @$export_args);
631 $dbh->rollback if $oldAutoCommit;
632 return "exporting to ". $part_export->exporttype.
633 " (transaction rolled back): $error";
637 #foreach my $depend_jobnum ( @$depend_jobnums ) {
638 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
640 # foreach my $jobnum ( @jobnums ) {
641 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
642 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
644 # my $error = $queue->depend_insert($depend_jobnum);
646 # $dbh->rollback if $oldAutoCommit;
647 # return "error queuing job dependancy: $error";
654 #if ( exists $options{'jobnums'} ) {
655 # push @{ $options{'jobnums'} }, @jobnums;
658 warn " insert complete; committing transaction\n"
661 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
666 use File::CounterFile;
667 sub auto_agent_custid {
670 my $format = $conf->config('cust_main-auto_agent_custid');
672 if ( $format eq '1YMMXXXXXXXX' ) {
674 my $counter = new File::CounterFile 'cust_main.agent_custid';
677 my $ym = 100000000000 + time2str('%y%m00000000', time);
678 if ( $ym > $counter->value ) {
679 $counter->{'value'} = $agent_custid = $ym;
680 $counter->{'updated'} = 1;
682 $agent_custid = $counter->inc;
688 die "Unknown cust_main-auto_agent_custid format: $format";
691 $self->agent_custid($agent_custid);
695 =item PACKAGE METHODS
697 Documentation on customer package methods has been moved to
698 L<FS::cust_main::Packages>.
700 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
702 Recharges this (existing) customer with the specified prepaid card (see
703 L<FS::prepay_credit>), specified either by I<identifier> or as an
704 FS::prepay_credit object. If there is an error, returns the error, otherwise
707 Optionally, five scalar references can be passed as well. They will have their
708 values filled in with the amount, number of seconds, and number of upload,
709 download, and total bytes applied by this prepaid card.
713 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
714 #the only place that uses these args
715 sub recharge_prepay {
716 my( $self, $prepay_credit, $amountref, $secondsref,
717 $upbytesref, $downbytesref, $totalbytesref ) = @_;
719 local $SIG{HUP} = 'IGNORE';
720 local $SIG{INT} = 'IGNORE';
721 local $SIG{QUIT} = 'IGNORE';
722 local $SIG{TERM} = 'IGNORE';
723 local $SIG{TSTP} = 'IGNORE';
724 local $SIG{PIPE} = 'IGNORE';
726 my $oldAutoCommit = $FS::UID::AutoCommit;
727 local $FS::UID::AutoCommit = 0;
730 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
732 my $error = $self->get_prepay( $prepay_credit,
733 'amount_ref' => \$amount,
734 'seconds_ref' => \$seconds,
735 'upbytes_ref' => \$upbytes,
736 'downbytes_ref' => \$downbytes,
737 'totalbytes_ref' => \$totalbytes,
739 || $self->increment_seconds($seconds)
740 || $self->increment_upbytes($upbytes)
741 || $self->increment_downbytes($downbytes)
742 || $self->increment_totalbytes($totalbytes)
743 || $self->insert_cust_pay_prepay( $amount,
745 ? $prepay_credit->identifier
750 $dbh->rollback if $oldAutoCommit;
754 if ( defined($amountref) ) { $$amountref = $amount; }
755 if ( defined($secondsref) ) { $$secondsref = $seconds; }
756 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
757 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
758 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
760 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
765 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
767 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
768 specified either by I<identifier> or as an FS::prepay_credit object.
770 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
771 incremented by the values of the prepaid card.
773 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
774 check or set this customer's I<agentnum>.
776 If there is an error, returns the error, otherwise returns false.
782 my( $self, $prepay_credit, %opt ) = @_;
784 local $SIG{HUP} = 'IGNORE';
785 local $SIG{INT} = 'IGNORE';
786 local $SIG{QUIT} = 'IGNORE';
787 local $SIG{TERM} = 'IGNORE';
788 local $SIG{TSTP} = 'IGNORE';
789 local $SIG{PIPE} = 'IGNORE';
791 my $oldAutoCommit = $FS::UID::AutoCommit;
792 local $FS::UID::AutoCommit = 0;
795 unless ( ref($prepay_credit) ) {
797 my $identifier = $prepay_credit;
799 $prepay_credit = qsearchs(
801 { 'identifier' => $identifier },
806 unless ( $prepay_credit ) {
807 $dbh->rollback if $oldAutoCommit;
808 return "Invalid prepaid card: ". $identifier;
813 if ( $prepay_credit->agentnum ) {
814 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
815 $dbh->rollback if $oldAutoCommit;
816 return "prepaid card not valid for agent ". $self->agentnum;
818 $self->agentnum($prepay_credit->agentnum);
821 my $error = $prepay_credit->delete;
823 $dbh->rollback if $oldAutoCommit;
824 return "removing prepay_credit (transaction rolled back): $error";
827 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
828 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
830 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
835 =item increment_upbytes SECONDS
837 Updates this customer's single or primary account (see L<FS::svc_acct>) by
838 the specified number of upbytes. If there is an error, returns the error,
839 otherwise returns false.
843 sub increment_upbytes {
844 _increment_column( shift, 'upbytes', @_);
847 =item increment_downbytes SECONDS
849 Updates this customer's single or primary account (see L<FS::svc_acct>) by
850 the specified number of downbytes. If there is an error, returns the error,
851 otherwise returns false.
855 sub increment_downbytes {
856 _increment_column( shift, 'downbytes', @_);
859 =item increment_totalbytes SECONDS
861 Updates this customer's single or primary account (see L<FS::svc_acct>) by
862 the specified number of totalbytes. If there is an error, returns the error,
863 otherwise returns false.
867 sub increment_totalbytes {
868 _increment_column( shift, 'totalbytes', @_);
871 =item increment_seconds SECONDS
873 Updates this customer's single or primary account (see L<FS::svc_acct>) by
874 the specified number of seconds. If there is an error, returns the error,
875 otherwise returns false.
879 sub increment_seconds {
880 _increment_column( shift, 'seconds', @_);
883 =item _increment_column AMOUNT
885 Updates this customer's single or primary account (see L<FS::svc_acct>) by
886 the specified number of seconds or bytes. If there is an error, returns
887 the error, otherwise returns false.
891 sub _increment_column {
892 my( $self, $column, $amount ) = @_;
893 warn "$me increment_column called: $column, $amount\n"
896 return '' unless $amount;
898 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
899 $self->ncancelled_pkgs;
902 return 'No packages with primary or single services found'.
903 ' to apply pre-paid time';
904 } elsif ( scalar(@cust_pkg) > 1 ) {
905 #maybe have a way to specify the package/account?
906 return 'Multiple packages found to apply pre-paid time';
909 my $cust_pkg = $cust_pkg[0];
910 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
914 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
917 return 'No account found to apply pre-paid time';
918 } elsif ( scalar(@cust_svc) > 1 ) {
919 return 'Multiple accounts found to apply pre-paid time';
922 my $svc_acct = $cust_svc[0]->svc_x;
923 warn " found service svcnum ". $svc_acct->pkgnum.
924 ' ('. $svc_acct->email. ")\n"
927 $column = "increment_$column";
928 $svc_acct->$column($amount);
932 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
934 Inserts a prepayment in the specified amount for this customer. An optional
935 second argument can specify the prepayment identifier for tracking purposes.
936 If there is an error, returns the error, otherwise returns false.
940 sub insert_cust_pay_prepay {
941 shift->insert_cust_pay('PREP', @_);
944 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
946 Inserts a cash payment in the specified amount for this customer. An optional
947 second argument can specify the payment identifier for tracking purposes.
948 If there is an error, returns the error, otherwise returns false.
952 sub insert_cust_pay_cash {
953 shift->insert_cust_pay('CASH', @_);
956 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
958 Inserts a Western Union payment in the specified amount for this customer. An
959 optional second argument can specify the prepayment identifier for tracking
960 purposes. If there is an error, returns the error, otherwise returns false.
964 sub insert_cust_pay_west {
965 shift->insert_cust_pay('WEST', @_);
968 sub insert_cust_pay {
969 my( $self, $payby, $amount ) = splice(@_, 0, 3);
970 my $payinfo = scalar(@_) ? shift : '';
972 my $cust_pay = new FS::cust_pay {
973 'custnum' => $self->custnum,
974 'paid' => sprintf('%.2f', $amount),
975 #'_date' => #date the prepaid card was purchased???
977 'payinfo' => $payinfo,
985 This method is deprecated. See the I<depend_jobnum> option to the insert and
986 order_pkgs methods for a better way to defer provisioning.
988 Re-schedules all exports by calling the B<reexport> method of all associated
989 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
990 otherwise returns false.
997 carp "WARNING: FS::cust_main::reexport is deprectated; ".
998 "use the depend_jobnum option to insert or order_pkgs to delay export";
1000 local $SIG{HUP} = 'IGNORE';
1001 local $SIG{INT} = 'IGNORE';
1002 local $SIG{QUIT} = 'IGNORE';
1003 local $SIG{TERM} = 'IGNORE';
1004 local $SIG{TSTP} = 'IGNORE';
1005 local $SIG{PIPE} = 'IGNORE';
1007 my $oldAutoCommit = $FS::UID::AutoCommit;
1008 local $FS::UID::AutoCommit = 0;
1011 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1012 my $error = $cust_pkg->reexport;
1014 $dbh->rollback if $oldAutoCommit;
1019 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1024 =item delete [ OPTION => VALUE ... ]
1026 This deletes the customer. If there is an error, returns the error, otherwise
1029 This will completely remove all traces of the customer record. This is not
1030 what you want when a customer cancels service; for that, cancel all of the
1031 customer's packages (see L</cancel>).
1033 If the customer has any uncancelled packages, you need to pass a new (valid)
1034 customer number for those packages to be transferred to, as the "new_customer"
1035 option. Cancelled packages will be deleted. Did I mention that this is NOT
1036 what you want when a customer cancels service and that you really should be
1037 looking at L<FS::cust_pkg/cancel>?
1039 You can't delete a customer with invoices (see L<FS::cust_bill>),
1040 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1041 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1042 set the "delete_financials" option to a true value.
1047 my( $self, %opt ) = @_;
1049 local $SIG{HUP} = 'IGNORE';
1050 local $SIG{INT} = 'IGNORE';
1051 local $SIG{QUIT} = 'IGNORE';
1052 local $SIG{TERM} = 'IGNORE';
1053 local $SIG{TSTP} = 'IGNORE';
1054 local $SIG{PIPE} = 'IGNORE';
1056 my $oldAutoCommit = $FS::UID::AutoCommit;
1057 local $FS::UID::AutoCommit = 0;
1060 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1061 $dbh->rollback if $oldAutoCommit;
1062 return "Can't delete a master agent customer";
1065 #use FS::access_user
1066 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1067 $dbh->rollback if $oldAutoCommit;
1068 return "Can't delete a master employee customer";
1071 tie my %financial_tables, 'Tie::IxHash',
1072 'cust_bill' => 'invoices',
1073 'cust_statement' => 'statements',
1074 'cust_credit' => 'credits',
1075 'cust_pay' => 'payments',
1076 'cust_refund' => 'refunds',
1079 foreach my $table ( keys %financial_tables ) {
1081 my @records = $self->$table();
1083 if ( @records && ! $opt{'delete_financials'} ) {
1084 $dbh->rollback if $oldAutoCommit;
1085 return "Can't delete a customer with ". $financial_tables{$table};
1088 foreach my $record ( @records ) {
1089 my $error = $record->delete;
1091 $dbh->rollback if $oldAutoCommit;
1092 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1098 my @cust_pkg = $self->ncancelled_pkgs;
1100 my $new_custnum = $opt{'new_custnum'};
1101 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1102 $dbh->rollback if $oldAutoCommit;
1103 return "Invalid new customer number: $new_custnum";
1105 foreach my $cust_pkg ( @cust_pkg ) {
1106 my %hash = $cust_pkg->hash;
1107 $hash{'custnum'} = $new_custnum;
1108 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1109 my $error = $new_cust_pkg->replace($cust_pkg,
1110 options => { $cust_pkg->options },
1113 $dbh->rollback if $oldAutoCommit;
1118 my @cancelled_cust_pkg = $self->all_pkgs;
1119 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1120 my $error = $cust_pkg->delete;
1122 $dbh->rollback if $oldAutoCommit;
1127 #cust_tax_adjustment in financials?
1128 #cust_pay_pending? ouch
1130 foreach my $table (qw(
1131 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1132 cust_location cust_main_note cust_tax_adjustment
1133 cust_pay_void cust_pay_batch queue cust_tax_exempt
1135 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1136 my $error = $record->delete;
1138 $dbh->rollback if $oldAutoCommit;
1144 my $sth = $dbh->prepare(
1145 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1147 my $errstr = $dbh->errstr;
1148 $dbh->rollback if $oldAutoCommit;
1151 $sth->execute($self->custnum) or do {
1152 my $errstr = $sth->errstr;
1153 $dbh->rollback if $oldAutoCommit;
1159 my $ticket_dbh = '';
1160 if ($conf->config('ticket_system') eq 'RT_Internal') {
1162 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1163 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1164 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1165 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1168 if ( $ticket_dbh ) {
1170 my $ticket_sth = $ticket_dbh->prepare(
1171 'DELETE FROM Links WHERE Target = ?'
1173 my $errstr = $ticket_dbh->errstr;
1174 $dbh->rollback if $oldAutoCommit;
1177 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1179 my $errstr = $ticket_sth->errstr;
1180 $dbh->rollback if $oldAutoCommit;
1184 #check and see if the customer is the only link on the ticket, and
1185 #if so, set the ticket to deleted status in RT?
1186 #maybe someday, for now this will at least fix tickets not displaying
1190 #delete the customer record
1192 my $error = $self->SUPER::delete;
1194 $dbh->rollback if $oldAutoCommit;
1198 # cust_main exports!
1200 #my $export_args = $options{'export_args'} || [];
1203 map qsearch( 'part_export', {exportnum=>$_} ),
1204 $conf->config('cust_main-exports'); #, $agentnum
1206 foreach my $part_export ( @part_export ) {
1207 my $error = $part_export->export_delete( $self ); #, @$export_args);
1209 $dbh->rollback if $oldAutoCommit;
1210 return "exporting to ". $part_export->exporttype.
1211 " (transaction rolled back): $error";
1215 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1220 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1222 This merges this customer into the provided new custnum, and then deletes the
1223 customer. If there is an error, returns the error, otherwise returns false.
1225 The source customer's name, company name, phone numbers, agent,
1226 referring customer, customer class, advertising source, order taker, and
1227 billing information (except balance) are discarded.
1229 All packages are moved to the target customer. Packages with package locations
1230 are preserved. Packages without package locations are moved to a new package
1231 location with the source customer's service/shipping address.
1233 All invoices, statements, payments, credits and refunds are moved to the target
1234 customer. The source customer's balance is added to the target customer.
1236 All notes, attachments, tickets and customer tags are moved to the target
1239 Change history is not currently moved.
1244 my( $self, $new_custnum, %opt ) = @_;
1246 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1248 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1249 return "Invalid new customer number: $new_custnum";
1252 local $SIG{HUP} = 'IGNORE';
1253 local $SIG{INT} = 'IGNORE';
1254 local $SIG{QUIT} = 'IGNORE';
1255 local $SIG{TERM} = 'IGNORE';
1256 local $SIG{TSTP} = 'IGNORE';
1257 local $SIG{PIPE} = 'IGNORE';
1259 my $oldAutoCommit = $FS::UID::AutoCommit;
1260 local $FS::UID::AutoCommit = 0;
1263 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1264 $dbh->rollback if $oldAutoCommit;
1265 return "Can't merge a master agent customer";
1268 #use FS::access_user
1269 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1270 $dbh->rollback if $oldAutoCommit;
1271 return "Can't merge a master employee customer";
1274 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1275 'status' => { op=>'!=', value=>'done' },
1279 $dbh->rollback if $oldAutoCommit;
1280 return "Can't merge a customer with pending payments";
1283 tie my %financial_tables, 'Tie::IxHash',
1284 'cust_bill' => 'invoices',
1285 'cust_bill_void' => 'voided invoices',
1286 'cust_statement' => 'statements',
1287 'cust_credit' => 'credits',
1288 'cust_pay' => 'payments',
1289 'cust_pay_void' => 'voided payments',
1290 'cust_refund' => 'refunds',
1293 foreach my $table ( keys %financial_tables ) {
1295 my @records = $self->$table();
1297 foreach my $record ( @records ) {
1298 $record->custnum($new_custnum);
1299 my $error = $record->replace;
1301 $dbh->rollback if $oldAutoCommit;
1302 return "Error merging ". $financial_tables{$table}. ": $error\n";
1308 my $name = $self->ship_name; #?
1310 my $locationnum = '';
1311 foreach my $cust_pkg ( $self->all_pkgs ) {
1312 $cust_pkg->custnum($new_custnum);
1314 unless ( $cust_pkg->locationnum ) {
1315 unless ( $locationnum ) {
1316 my $cust_location = new FS::cust_location {
1317 $self->location_hash,
1318 'custnum' => $new_custnum,
1320 my $error = $cust_location->insert;
1322 $dbh->rollback if $oldAutoCommit;
1325 $locationnum = $cust_location->locationnum;
1327 $cust_pkg->locationnum($locationnum);
1330 my $error = $cust_pkg->replace;
1332 $dbh->rollback if $oldAutoCommit;
1336 # add customer (ship) name to svc_phone.phone_name if blank
1337 my @cust_svc = $cust_pkg->cust_svc;
1338 foreach my $cust_svc (@cust_svc) {
1339 my($label, $value, $svcdb) = $cust_svc->label;
1340 next unless $svcdb eq 'svc_phone';
1341 my $svc_phone = $cust_svc->svc_x;
1342 next if $svc_phone->phone_name;
1343 $svc_phone->phone_name($name);
1344 my $error = $svc_phone->replace;
1346 $dbh->rollback if $oldAutoCommit;
1354 # cust_tax_exempt (texas tax exemptions)
1355 # cust_recon (some sort of not-well understood thing for OnPac)
1357 #these are moved over
1358 foreach my $table (qw(
1359 cust_tag cust_location contact cust_attachment cust_main_note
1360 cust_tax_adjustment cust_pay_batch queue
1362 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1363 $record->custnum($new_custnum);
1364 my $error = $record->replace;
1366 $dbh->rollback if $oldAutoCommit;
1372 #these aren't preserved
1373 foreach my $table (qw(
1374 cust_main_exemption cust_main_invoice
1376 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1377 my $error = $record->delete;
1379 $dbh->rollback if $oldAutoCommit;
1386 my $sth = $dbh->prepare(
1387 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1389 my $errstr = $dbh->errstr;
1390 $dbh->rollback if $oldAutoCommit;
1393 $sth->execute($new_custnum, $self->custnum) or do {
1394 my $errstr = $sth->errstr;
1395 $dbh->rollback if $oldAutoCommit;
1401 my $ticket_dbh = '';
1402 if ($conf->config('ticket_system') eq 'RT_Internal') {
1404 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1405 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1406 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1407 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1410 if ( $ticket_dbh ) {
1412 my $ticket_sth = $ticket_dbh->prepare(
1413 'UPDATE Links SET Target = ? WHERE Target = ?'
1415 my $errstr = $ticket_dbh->errstr;
1416 $dbh->rollback if $oldAutoCommit;
1419 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1420 'freeside://freeside/cust_main/'.$self->custnum)
1422 my $errstr = $ticket_sth->errstr;
1423 $dbh->rollback if $oldAutoCommit;
1429 #delete the customer record
1431 my $error = $self->delete;
1433 $dbh->rollback if $oldAutoCommit;
1437 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1442 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1444 Replaces the OLD_RECORD with this one in the database. If there is an error,
1445 returns the error, otherwise returns false.
1447 To change the customer's address, set the pseudo-fields C<bill_location> and
1448 C<ship_location>. The address will still only change if at least one of the
1449 address fields differs from the existing values.
1451 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1452 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1453 expected and rollback the entire transaction; it is not necessary to call
1454 check_invoicing_list first. Here's an example:
1456 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1458 Currently available options are: I<tax_exemption>.
1460 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1461 of tax names and exemption numbers. FS::cust_main_exemption records will be
1462 deleted and inserted as appropriate.
1469 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1471 : $self->replace_old;
1475 warn "$me replace called\n"
1478 my $curuser = $FS::CurrentUser::CurrentUser;
1479 if ( $self->payby eq 'COMP'
1480 && $self->payby ne $old->payby
1481 && ! $curuser->access_right('Complimentary customer')
1484 return "You are not permitted to create complimentary accounts.";
1487 # should be unnecessary--geocode will default to null on new locations
1488 #if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode')
1489 # && $conf->exists('enable_taxproducts')
1492 # my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip)
1494 # $self->set('geocode', '')
1495 # if $old->get($pre.'zip') ne $self->get($pre.'zip')
1496 # && length($self->get($pre.'zip')) >= 10;
1499 # set_coord/coord_auto stuff is now handled by cust_location
1501 local($ignore_expired_card) = 1
1502 if $old->payby =~ /^(CARD|DCRD)$/
1503 && $self->payby =~ /^(CARD|DCRD)$/
1504 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1506 local($ignore_banned_card) = 1
1507 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1508 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1509 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1511 return "Invoicing locale is required"
1514 && $conf->exists('cust_main-require_locale');
1516 local $SIG{HUP} = 'IGNORE';
1517 local $SIG{INT} = 'IGNORE';
1518 local $SIG{QUIT} = 'IGNORE';
1519 local $SIG{TERM} = 'IGNORE';
1520 local $SIG{TSTP} = 'IGNORE';
1521 local $SIG{PIPE} = 'IGNORE';
1523 my $oldAutoCommit = $FS::UID::AutoCommit;
1524 local $FS::UID::AutoCommit = 0;
1527 for my $l (qw(bill_location ship_location)) {
1528 my $old_loc = $old->$l;
1529 my $new_loc = $self->$l;
1531 if ( !$new_loc->locationnum ) {
1533 # If the new location is all empty fields, or if it's identical to
1534 # the old location in all fields, don't replace.
1535 my @nonempty = grep { $new_loc->$_ } $self->location_fields;
1537 my @unlike = grep { $new_loc->$_ ne $old_loc->$_ } $self->location_fields;
1539 if ( @unlike or $old_loc->disabled ) {
1540 warn " changed $l fields: ".join(',',@unlike)."\n"
1542 $new_loc->set(custnum => $self->custnum);
1544 # insert it--the old location will be disabled later
1545 my $error = $new_loc->insert;
1547 $dbh->rollback if $oldAutoCommit;
1552 # no fields have changed and $old_loc isn't disabled, so don't change it
1557 elsif ( $new_loc->custnum ne $self->custnum or $new_loc->prospectnum ) {
1558 $dbh->rollback if $oldAutoCommit;
1559 return "$l belongs to customer ".$new_loc->custnum;
1561 # else the new location belongs to this customer so we're good
1563 # set the foo_locationnum now that we have one.
1564 $self->set($l.'num', $new_loc->locationnum);
1568 my $error = $self->SUPER::replace($old);
1571 $dbh->rollback if $oldAutoCommit;
1575 # now move packages to the new service location
1576 $self->set('ship_location', ''); #flush cache
1577 if ( $old->ship_locationnum and # should only be null during upgrade...
1578 $old->ship_locationnum != $self->ship_locationnum ) {
1579 $error = $old->ship_location->move_to($self->ship_location);
1581 $dbh->rollback if $oldAutoCommit;
1585 # don't move packages based on the billing location, but
1586 # disable it if it's no longer in use
1587 if ( $old->bill_locationnum and
1588 $old->bill_locationnum != $self->bill_locationnum ) {
1589 $error = $old->bill_location->disable_if_unused;
1591 $dbh->rollback if $oldAutoCommit;
1596 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1597 my $invoicing_list = shift @param;
1598 $error = $self->check_invoicing_list( $invoicing_list );
1600 $dbh->rollback if $oldAutoCommit;
1603 $self->invoicing_list( $invoicing_list );
1606 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1608 #this could be more efficient than deleting and re-inserting, if it matters
1609 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1610 my $error = $cust_tag->delete;
1612 $dbh->rollback if $oldAutoCommit;
1616 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1617 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1618 'custnum' => $self->custnum };
1619 my $error = $cust_tag->insert;
1621 $dbh->rollback if $oldAutoCommit;
1628 my %options = @param;
1630 my $tax_exemption = delete $options{'tax_exemption'};
1631 if ( $tax_exemption ) {
1633 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1634 if ref($tax_exemption) eq 'ARRAY';
1636 my %cust_main_exemption =
1637 map { $_->taxname => $_ }
1638 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1640 foreach my $taxname ( keys %$tax_exemption ) {
1642 if ( $cust_main_exemption{$taxname} &&
1643 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1646 delete $cust_main_exemption{$taxname};
1650 my $cust_main_exemption = new FS::cust_main_exemption {
1651 'custnum' => $self->custnum,
1652 'taxname' => $taxname,
1653 'exempt_number' => $tax_exemption->{$taxname},
1655 my $error = $cust_main_exemption->insert;
1657 $dbh->rollback if $oldAutoCommit;
1658 return "inserting cust_main_exemption (transaction rolled back): $error";
1662 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1663 my $error = $cust_main_exemption->delete;
1665 $dbh->rollback if $oldAutoCommit;
1666 return "deleting cust_main_exemption (transaction rolled back): $error";
1672 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1673 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1674 && $self->get('payinfo') !~ /^99\d{14}$/
1676 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1681 # card/check/lec info has changed, want to retry realtime_ invoice events
1682 my $error = $self->retry_realtime;
1684 $dbh->rollback if $oldAutoCommit;
1689 unless ( $import || $skip_fuzzyfiles ) {
1690 $error = $self->queue_fuzzyfiles_update;
1692 $dbh->rollback if $oldAutoCommit;
1693 return "updating fuzzy search cache: $error";
1697 # tax district update in cust_location
1699 # cust_main exports!
1701 my $export_args = $options{'export_args'} || [];
1704 map qsearch( 'part_export', {exportnum=>$_} ),
1705 $conf->config('cust_main-exports'); #, $agentnum
1707 foreach my $part_export ( @part_export ) {
1708 my $error = $part_export->export_replace( $self, $old, @$export_args);
1710 $dbh->rollback if $oldAutoCommit;
1711 return "exporting to ". $part_export->exporttype.
1712 " (transaction rolled back): $error";
1716 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1721 =item queue_fuzzyfiles_update
1723 Used by insert & replace to update the fuzzy search cache
1727 use FS::cust_main::Search;
1728 sub queue_fuzzyfiles_update {
1731 local $SIG{HUP} = 'IGNORE';
1732 local $SIG{INT} = 'IGNORE';
1733 local $SIG{QUIT} = 'IGNORE';
1734 local $SIG{TERM} = 'IGNORE';
1735 local $SIG{TSTP} = 'IGNORE';
1736 local $SIG{PIPE} = 'IGNORE';
1738 my $oldAutoCommit = $FS::UID::AutoCommit;
1739 local $FS::UID::AutoCommit = 0;
1742 my @locations = $self->bill_location;
1743 push @locations, $self->ship_location if $self->has_ship_address;
1744 foreach my $location (@locations) {
1745 my $queue = new FS::queue {
1746 'job' => 'FS::cust_main::Search::append_fuzzyfiles'
1748 my @args = map $location->get($_), @FS::cust_main::Search::fuzzyfields;
1749 my $error = $queue->insert( @args );
1751 $dbh->rollback if $oldAutoCommit;
1752 return "queueing job (transaction rolled back): $error";
1756 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1763 Checks all fields to make sure this is a valid customer record. If there is
1764 an error, returns the error, otherwise returns false. Called by the insert
1765 and replace methods.
1772 warn "$me check BEFORE: \n". $self->_dump
1776 $self->ut_numbern('custnum')
1777 || $self->ut_number('agentnum')
1778 || $self->ut_textn('agent_custid')
1779 || $self->ut_number('refnum')
1780 || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
1781 || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
1782 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1783 || $self->ut_textn('custbatch')
1784 || $self->ut_name('last')
1785 || $self->ut_name('first')
1786 || $self->ut_snumbern('signupdate')
1787 || $self->ut_snumbern('birthdate')
1788 || $self->ut_snumbern('spouse_birthdate')
1789 || $self->ut_snumbern('anniversary_date')
1790 || $self->ut_textn('company')
1791 || $self->ut_anything('comments')
1792 || $self->ut_numbern('referral_custnum')
1793 || $self->ut_textn('stateid')
1794 || $self->ut_textn('stateid_state')
1795 || $self->ut_textn('invoice_terms')
1796 || $self->ut_floatn('cdr_termination_percentage')
1797 || $self->ut_floatn('credit_limit')
1798 || $self->ut_numbern('billday')
1799 || $self->ut_numbern('prorate_day')
1800 || $self->ut_enum('edit_subject', [ '', 'Y' ] )
1801 || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] )
1802 || $self->ut_enum('invoice_noemail', [ '', 'Y' ] )
1803 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1806 #barf. need message catalogs. i18n. etc.
1807 $error .= "Please select an advertising source."
1808 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1809 return $error if $error;
1811 return "Unknown agent"
1812 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1814 return "Unknown refnum"
1815 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1817 return "Unknown referring custnum: ". $self->referral_custnum
1818 unless ! $self->referral_custnum
1819 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1821 if ( $self->ss eq '' ) {
1826 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1827 or return "Illegal social security number: ". $self->ss;
1828 $self->ss("$1-$2-$3");
1831 # cust_main_county verification now handled by cust_location check
1834 $self->ut_phonen('daytime', $self->country)
1835 || $self->ut_phonen('night', $self->country)
1836 || $self->ut_phonen('fax', $self->country)
1837 || $self->ut_phonen('mobile', $self->country)
1839 return $error if $error;
1841 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1843 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1846 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1848 : FS::Msgcat::_gettext('daytime');
1849 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1851 : FS::Msgcat::_gettext('night');
1853 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1855 : FS::Msgcat::_gettext('mobile');
1857 return "$daytime_label, $night_label or $mobile_label is required"
1861 #ship_ fields are gone
1863 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1864 # or return "Illegal payby: ". $self->payby;
1866 FS::payby->can_payby($self->table, $self->payby)
1867 or return "Illegal payby: ". $self->payby;
1869 $error = $self->ut_numbern('paystart_month')
1870 || $self->ut_numbern('paystart_year')
1871 || $self->ut_numbern('payissue')
1872 || $self->ut_textn('paytype')
1874 return $error if $error;
1876 if ( $self->payip eq '' ) {
1879 $error = $self->ut_ip('payip');
1880 return $error if $error;
1883 # If it is encrypted and the private key is not availaible then we can't
1884 # check the credit card.
1885 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1887 # Need some kind of global flag to accept invalid cards, for testing
1889 if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1891 my $payinfo = $self->payinfo;
1892 $payinfo =~ s/\D//g;
1893 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1894 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1896 $self->payinfo($payinfo);
1898 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1900 return gettext('unknown_card_type')
1901 if $self->payinfo !~ /^99\d{14}$/ #token
1902 && cardtype($self->payinfo) eq "Unknown";
1904 unless ( $ignore_banned_card ) {
1905 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1907 if ( $ban->bantype eq 'warn' ) {
1908 #or others depending on value of $ban->reason ?
1909 return '_duplicate_card'.
1910 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1911 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1912 ' (ban# '. $ban->bannum. ')'
1913 unless $self->override_ban_warn;
1915 return 'Banned credit card: banned on '.
1916 time2str('%a %h %o at %r', $ban->_date).
1917 ' by '. $ban->otaker.
1918 ' (ban# '. $ban->bannum. ')';
1923 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1924 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1925 $self->paycvv =~ /^(\d{4})$/
1926 or return "CVV2 (CID) for American Express cards is four digits.";
1929 $self->paycvv =~ /^(\d{3})$/
1930 or return "CVV2 (CVC2/CID) is three digits.";
1937 my $cardtype = cardtype($payinfo);
1938 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1940 return "Start date or issue number is required for $cardtype cards"
1941 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1943 return "Start month must be between 1 and 12"
1944 if $self->paystart_month
1945 and $self->paystart_month < 1 || $self->paystart_month > 12;
1947 return "Start year must be 1990 or later"
1948 if $self->paystart_year
1949 and $self->paystart_year < 1990;
1951 return "Issue number must be beween 1 and 99"
1953 and $self->payissue < 1 || $self->payissue > 99;
1956 $self->paystart_month('');
1957 $self->paystart_year('');
1958 $self->payissue('');
1961 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1963 my $payinfo = $self->payinfo;
1964 $payinfo =~ s/[^\d\@\.]//g;
1965 if ( $conf->config('echeck-country') eq 'CA' ) {
1966 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1967 or return 'invalid echeck account@branch.bank';
1968 $payinfo = "$1\@$2.$3";
1969 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1970 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1971 $payinfo = "$1\@$2";
1973 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1974 $payinfo = "$1\@$2";
1976 $self->payinfo($payinfo);
1979 unless ( $ignore_banned_card ) {
1980 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1982 if ( $ban->bantype eq 'warn' ) {
1983 #or others depending on value of $ban->reason ?
1984 return '_duplicate_ach' unless $self->override_ban_warn;
1986 return 'Banned ACH account: banned on '.
1987 time2str('%a %h %o at %r', $ban->_date).
1988 ' by '. $ban->otaker.
1989 ' (ban# '. $ban->bannum. ')';
1994 } elsif ( $self->payby eq 'LECB' ) {
1996 my $payinfo = $self->payinfo;
1997 $payinfo =~ s/\D//g;
1998 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2000 $self->payinfo($payinfo);
2003 } elsif ( $self->payby eq 'BILL' ) {
2005 $error = $self->ut_textn('payinfo');
2006 return "Illegal P.O. number: ". $self->payinfo if $error;
2009 } elsif ( $self->payby eq 'COMP' ) {
2011 my $curuser = $FS::CurrentUser::CurrentUser;
2012 if ( ! $self->custnum
2013 && ! $curuser->access_right('Complimentary customer')
2016 return "You are not permitted to create complimentary accounts."
2019 $error = $self->ut_textn('payinfo');
2020 return "Illegal comp account issuer: ". $self->payinfo if $error;
2023 } elsif ( $self->payby eq 'PREPAY' ) {
2025 my $payinfo = $self->payinfo;
2026 $payinfo =~ s/\W//g; #anything else would just confuse things
2027 $self->payinfo($payinfo);
2028 $error = $self->ut_alpha('payinfo');
2029 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2030 return "Unknown prepayment identifier"
2031 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2036 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2037 return "Expiration date required"
2038 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
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') );
2066 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2067 or return gettext('illegal_name'). " payname: ". $self->payname;
2071 return "Please select an invoicing locale"
2074 && $conf->exists('cust_main-require_locale');
2076 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2077 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2081 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2083 warn "$me check AFTER: \n". $self->_dump
2086 $self->SUPER::check;
2091 Returns a list of fields which have ship_ duplicates.
2096 qw( last first company
2097 address1 address2 city county state zip country
2099 daytime night fax mobile
2103 =item has_ship_address
2105 Returns true if this customer record has a separate shipping address.
2109 sub has_ship_address {
2111 $self->bill_locationnum != $self->ship_locationnum;
2116 Returns a list of key/value pairs, with the following keys: address1,
2117 adddress2, city, county, state, zip, country, district, and geocode. The
2118 shipping address is used if present.
2124 $self->ship_location->location_hash;
2129 Returns all locations (see L<FS::cust_location>) for this customer.
2135 qsearch('cust_location', { 'custnum' => $self->custnum,
2136 'prospectnum' => '' } );
2141 Returns all contacts (see L<FS::contact>) for this customer.
2145 #already used :/ sub contact {
2148 qsearch('contact', { 'custnum' => $self->custnum } );
2153 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2154 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2155 on success or a list of errors.
2161 grep { $_->unsuspend } $self->suspended_pkgs;
2166 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2168 Returns a list: an empty list on success or a list of errors.
2174 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2177 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2179 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2180 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2181 of a list of pkgparts; the hashref has the following keys:
2185 =item pkgparts - listref of pkgparts
2187 =item (other options are passed to the suspend method)
2192 Returns a list: an empty list on success or a list of errors.
2196 sub suspend_if_pkgpart {
2198 my (@pkgparts, %opt);
2199 if (ref($_[0]) eq 'HASH'){
2200 @pkgparts = @{$_[0]{pkgparts}};
2205 grep { $_->suspend(%opt) }
2206 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2207 $self->unsuspended_pkgs;
2210 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2212 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2213 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2214 instead of a list of pkgparts; the hashref has the following keys:
2218 =item pkgparts - listref of pkgparts
2220 =item (other options are passed to the suspend method)
2224 Returns a list: an empty list on success or a list of errors.
2228 sub suspend_unless_pkgpart {
2230 my (@pkgparts, %opt);
2231 if (ref($_[0]) eq 'HASH'){
2232 @pkgparts = @{$_[0]{pkgparts}};
2237 grep { $_->suspend(%opt) }
2238 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2239 $self->unsuspended_pkgs;
2242 =item cancel [ OPTION => VALUE ... ]
2244 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2246 Available options are:
2250 =item quiet - can be set true to supress email cancellation notices.
2252 =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.
2254 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2256 =item nobill - can be set true to skip billing if it might otherwise be done.
2260 Always returns a list: an empty list on success or a list of errors.
2264 # nb that dates are not specified as valid options to this method
2267 my( $self, %opt ) = @_;
2269 warn "$me cancel called on customer ". $self->custnum. " with options ".
2270 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2273 return ( 'access denied' )
2274 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2276 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2278 #should try decryption (we might have the private key)
2279 # and if not maybe queue a job for the server that does?
2280 return ( "Can't (yet) ban encrypted credit cards" )
2281 if $self->is_encrypted($self->payinfo);
2283 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2284 my $error = $ban->insert;
2285 return ( $error ) if $error;
2289 my @pkgs = $self->ncancelled_pkgs;
2291 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2293 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2294 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2298 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2299 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2302 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2305 sub _banned_pay_hashref {
2316 'payby' => $payby2ban{$self->payby},
2317 'payinfo' => $self->payinfo,
2318 #don't ever *search* on reason! #'reason' =>
2322 sub _new_banned_pay_hashref {
2324 my $hr = $self->_banned_pay_hashref;
2325 $hr->{payinfo} = md5_base64($hr->{payinfo});
2331 Returns all notes (see L<FS::cust_main_note>) for this customer.
2336 my($self,$orderby_classnum) = (shift,shift);
2337 my $orderby = "_DATE DESC";
2338 $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
2339 qsearch( 'cust_main_note',
2340 { 'custnum' => $self->custnum },
2342 "ORDER BY $orderby",
2348 Returns the agent (see L<FS::agent>) for this customer.
2354 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2359 Returns the agent name (see L<FS::agent>) for this customer.
2365 $self->agent->agent;
2370 Returns any tags associated with this customer, as FS::cust_tag objects,
2371 or an empty list if there are no tags.
2377 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2382 Returns any tags associated with this customer, as FS::part_tag objects,
2383 or an empty list if there are no tags.
2389 map $_->part_tag, $self->cust_tag;
2395 Returns the customer class, as an FS::cust_class object, or the empty string
2396 if there is no customer class.
2402 if ( $self->classnum ) {
2403 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2411 Returns the customer category name, or the empty string if there is no customer
2418 my $cust_class = $self->cust_class;
2420 ? $cust_class->categoryname
2426 Returns the customer class name, or the empty string if there is no customer
2433 my $cust_class = $self->cust_class;
2435 ? $cust_class->classname
2439 =item BILLING METHODS
2441 Documentation on billing methods has been moved to
2442 L<FS::cust_main::Billing>.
2444 =item REALTIME BILLING METHODS
2446 Documentation on realtime billing methods has been moved to
2447 L<FS::cust_main::Billing_Realtime>.
2451 Removes the I<paycvv> field from the database directly.
2453 If there is an error, returns the error, otherwise returns false.
2459 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2460 or return dbh->errstr;
2461 $sth->execute($self->custnum)
2462 or return $sth->errstr;
2467 =item batch_card OPTION => VALUE...
2469 Adds a payment for this invoice to the pending credit card batch (see
2470 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2471 runs the payment using a realtime gateway.
2473 Options may include:
2475 B<amount>: the amount to be paid; defaults to the customer's balance minus
2476 any payments in transit.
2478 B<payby>: the payment method; defaults to cust_main.payby
2480 B<realtime>: runs this as a realtime payment instead of adding it to a
2483 B<invnum>: sets cust_pay_batch.invnum.
2485 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2486 the billing address for the payment; defaults to the customer's billing
2489 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2490 date, and name; defaults to those fields in cust_main.
2495 my ($self, %options) = @_;
2498 if (exists($options{amount})) {
2499 $amount = $options{amount};
2501 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2503 return '' unless $amount > 0;
2505 my $invnum = delete $options{invnum};
2506 my $payby = $options{payby} || $self->payby; #still dubious
2508 if ($options{'realtime'}) {
2509 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2515 my $oldAutoCommit = $FS::UID::AutoCommit;
2516 local $FS::UID::AutoCommit = 0;
2519 #this needs to handle mysql as well as Pg, like svc_acct.pm
2520 #(make it into a common function if folks need to do batching with mysql)
2521 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2522 or return "Cannot lock pay_batch: " . $dbh->errstr;
2526 'payby' => FS::payby->payby2payment($payby),
2528 $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2530 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2532 unless ( $pay_batch ) {
2533 $pay_batch = new FS::pay_batch \%pay_batch;
2534 my $error = $pay_batch->insert;
2536 $dbh->rollback if $oldAutoCommit;
2537 die "error creating new batch: $error\n";
2541 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2542 'batchnum' => $pay_batch->batchnum,
2543 'custnum' => $self->custnum,
2546 foreach (qw( address1 address2 city state zip country latitude longitude
2547 payby payinfo paydate payname ))
2549 $options{$_} = '' unless exists($options{$_});
2552 my $loc = $self->bill_location;
2554 my $cust_pay_batch = new FS::cust_pay_batch ( {
2555 'batchnum' => $pay_batch->batchnum,
2556 'invnum' => $invnum || 0, # is there a better value?
2557 # this field should be
2559 # cust_bill_pay_batch now
2560 'custnum' => $self->custnum,
2561 'last' => $self->getfield('last'),
2562 'first' => $self->getfield('first'),
2563 'address1' => $options{address1} || $loc->address1,
2564 'address2' => $options{address2} || $loc->address2,
2565 'city' => $options{city} || $loc->city,
2566 'state' => $options{state} || $loc->state,
2567 'zip' => $options{zip} || $loc->zip,
2568 'country' => $options{country} || $loc->country,
2569 'payby' => $options{payby} || $self->payby,
2570 'payinfo' => $options{payinfo} || $self->payinfo,
2571 'exp' => $options{paydate} || $self->paydate,
2572 'payname' => $options{payname} || $self->payname,
2573 'amount' => $amount, # consolidating
2576 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2577 if $old_cust_pay_batch;
2580 if ($old_cust_pay_batch) {
2581 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2583 $error = $cust_pay_batch->insert;
2587 $dbh->rollback if $oldAutoCommit;
2591 my $unapplied = $self->total_unapplied_credits
2592 + $self->total_unapplied_payments
2593 + $self->in_transit_payments;
2594 foreach my $cust_bill ($self->open_cust_bill) {
2595 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2596 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2597 'invnum' => $cust_bill->invnum,
2598 'paybatchnum' => $cust_pay_batch->paybatchnum,
2599 'amount' => $cust_bill->owed,
2602 if ($unapplied >= $cust_bill_pay_batch->amount){
2603 $unapplied -= $cust_bill_pay_batch->amount;
2606 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2607 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2609 $error = $cust_bill_pay_batch->insert;
2611 $dbh->rollback if $oldAutoCommit;
2616 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2622 Returns the total owed for this customer on all invoices
2623 (see L<FS::cust_bill/owed>).
2629 $self->total_owed_date(2145859200); #12/31/2037
2632 =item total_owed_date TIME
2634 Returns the total owed for this customer on all invoices with date earlier than
2635 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2636 see L<Time::Local> and L<Date::Parse> for conversion functions.
2640 sub total_owed_date {
2644 my $custnum = $self->custnum;
2646 my $owed_sql = FS::cust_bill->owed_sql;
2649 SELECT SUM($owed_sql) FROM cust_bill
2650 WHERE custnum = $custnum
2654 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2658 =item total_owed_pkgnum PKGNUM
2660 Returns the total owed on all invoices for this customer's specific package
2661 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2665 sub total_owed_pkgnum {
2666 my( $self, $pkgnum ) = @_;
2667 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2670 =item total_owed_date_pkgnum TIME PKGNUM
2672 Returns the total owed for this customer's specific package when using
2673 experimental package balances on all invoices with date earlier than
2674 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2675 see L<Time::Local> and L<Date::Parse> for conversion functions.
2679 sub total_owed_date_pkgnum {
2680 my( $self, $time, $pkgnum ) = @_;
2683 foreach my $cust_bill (
2684 grep { $_->_date <= $time }
2685 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2687 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2689 sprintf( "%.2f", $total_bill );
2695 Returns the total amount of all payments.
2702 $total += $_->paid foreach $self->cust_pay;
2703 sprintf( "%.2f", $total );
2706 =item total_unapplied_credits
2708 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2709 customer. See L<FS::cust_credit/credited>.
2711 =item total_credited
2713 Old name for total_unapplied_credits. Don't use.
2717 sub total_credited {
2718 #carp "total_credited deprecated, use total_unapplied_credits";
2719 shift->total_unapplied_credits(@_);
2722 sub total_unapplied_credits {
2725 my $custnum = $self->custnum;
2727 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2730 SELECT SUM($unapplied_sql) FROM cust_credit
2731 WHERE custnum = $custnum
2734 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2738 =item total_unapplied_credits_pkgnum PKGNUM
2740 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2741 customer. See L<FS::cust_credit/credited>.
2745 sub total_unapplied_credits_pkgnum {
2746 my( $self, $pkgnum ) = @_;
2747 my $total_credit = 0;
2748 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2749 sprintf( "%.2f", $total_credit );
2753 =item total_unapplied_payments
2755 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2756 See L<FS::cust_pay/unapplied>.
2760 sub total_unapplied_payments {
2763 my $custnum = $self->custnum;
2765 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2768 SELECT SUM($unapplied_sql) FROM cust_pay
2769 WHERE custnum = $custnum
2772 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2776 =item total_unapplied_payments_pkgnum PKGNUM
2778 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2779 specific package when using experimental package balances. See
2780 L<FS::cust_pay/unapplied>.
2784 sub total_unapplied_payments_pkgnum {
2785 my( $self, $pkgnum ) = @_;
2786 my $total_unapplied = 0;
2787 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2788 sprintf( "%.2f", $total_unapplied );
2792 =item total_unapplied_refunds
2794 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2795 customer. See L<FS::cust_refund/unapplied>.
2799 sub total_unapplied_refunds {
2801 my $custnum = $self->custnum;
2803 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2806 SELECT SUM($unapplied_sql) FROM cust_refund
2807 WHERE custnum = $custnum
2810 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2816 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2817 total_unapplied_credits minus total_unapplied_payments).
2823 $self->balance_date_range;
2826 =item balance_date TIME
2828 Returns the balance for this customer, only considering invoices with date
2829 earlier than TIME (total_owed_date minus total_credited minus
2830 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2831 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2838 $self->balance_date_range(shift);
2841 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2843 Returns the balance for this customer, optionally considering invoices with
2844 date earlier than START_TIME, and not later than END_TIME
2845 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2847 Times are specified as SQL fragments or numeric
2848 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2849 L<Date::Parse> for conversion functions. The empty string can be passed
2850 to disable that time constraint completely.
2852 Available options are:
2856 =item unapplied_date
2858 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)
2864 sub balance_date_range {
2866 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2867 ') FROM cust_main WHERE custnum='. $self->custnum;
2868 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2871 =item balance_pkgnum PKGNUM
2873 Returns the balance for this customer's specific package when using
2874 experimental package balances (total_owed plus total_unrefunded, minus
2875 total_unapplied_credits minus total_unapplied_payments)
2879 sub balance_pkgnum {
2880 my( $self, $pkgnum ) = @_;
2883 $self->total_owed_pkgnum($pkgnum)
2884 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2885 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2886 - $self->total_unapplied_credits_pkgnum($pkgnum)
2887 - $self->total_unapplied_payments_pkgnum($pkgnum)
2891 =item in_transit_payments
2893 Returns the total of requests for payments for this customer pending in
2894 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
2898 sub in_transit_payments {
2900 my $in_transit_payments = 0;
2901 foreach my $pay_batch ( qsearch('pay_batch', {
2904 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2905 'batchnum' => $pay_batch->batchnum,
2906 'custnum' => $self->custnum,
2908 $in_transit_payments += $cust_pay_batch->amount;
2911 sprintf( "%.2f", $in_transit_payments );
2916 Returns a hash of useful information for making a payment.
2926 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2927 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2928 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2932 For credit card transactions:
2944 For electronic check transactions:
2959 $return{balance} = $self->balance;
2961 $return{payname} = $self->payname
2962 || ( $self->first. ' '. $self->get('last') );
2964 $return{$_} = $self->bill_location->$_
2965 for qw(address1 address2 city state zip);
2967 $return{payby} = $self->payby;
2968 $return{stateid_state} = $self->stateid_state;
2970 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2971 $return{card_type} = cardtype($self->payinfo);
2972 $return{payinfo} = $self->paymask;
2974 @return{'month', 'year'} = $self->paydate_monthyear;
2978 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2979 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2980 $return{payinfo1} = $payinfo1;
2981 $return{payinfo2} = $payinfo2;
2982 $return{paytype} = $self->paytype;
2983 $return{paystate} = $self->paystate;
2987 #doubleclick protection
2989 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2995 =item paydate_monthyear
2997 Returns a two-element list consisting of the month and year of this customer's
2998 paydate (credit card expiration date for CARD customers)
3002 sub paydate_monthyear {
3004 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3006 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3015 Returns the exact time in seconds corresponding to the payment method
3016 expiration date. For CARD/DCRD customers this is the end of the month;
3017 for others (COMP is the only other payby that uses paydate) it's the start.
3018 Returns 0 if the paydate is empty or set to the far future.
3024 my ($month, $year) = $self->paydate_monthyear;
3025 return 0 if !$year or $year >= 2037;
3026 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3028 if ( $month == 13 ) {
3032 return timelocal(0,0,0,1,$month-1,$year) - 1;
3035 return timelocal(0,0,0,1,$month-1,$year);
3039 =item paydate_epoch_sql
3041 Class method. Returns an SQL expression to obtain the payment expiration date
3042 as a number of seconds.
3046 # Special expiration date behavior for non-CARD/DCRD customers has been
3047 # carefully preserved. Do we really use that?
3048 sub paydate_epoch_sql {
3050 my $table = shift || 'cust_main';
3051 my ($case1, $case2);
3052 if ( driver_name eq 'Pg' ) {
3053 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3054 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3056 elsif ( lc(driver_name) eq 'mysql' ) {
3057 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3058 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3061 return "CASE WHEN $table.payby IN('CARD','DCRD')
3067 =item tax_exemption TAXNAME
3072 my( $self, $taxname ) = @_;
3074 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3075 'taxname' => $taxname,
3080 =item cust_main_exemption
3084 sub cust_main_exemption {
3086 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3089 =item invoicing_list [ ARRAYREF ]
3091 If an arguement is given, sets these email addresses as invoice recipients
3092 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3093 (except as warnings), so use check_invoicing_list first.
3095 Returns a list of email addresses (with svcnum entries expanded).
3097 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3098 check it without disturbing anything by passing nothing.
3100 This interface may change in the future.
3104 sub invoicing_list {
3105 my( $self, $arrayref ) = @_;
3108 my @cust_main_invoice;
3109 if ( $self->custnum ) {
3110 @cust_main_invoice =
3111 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3113 @cust_main_invoice = ();
3115 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3116 #warn $cust_main_invoice->destnum;
3117 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3118 #warn $cust_main_invoice->destnum;
3119 my $error = $cust_main_invoice->delete;
3120 warn $error if $error;
3123 if ( $self->custnum ) {
3124 @cust_main_invoice =
3125 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3127 @cust_main_invoice = ();
3129 my %seen = map { $_->address => 1 } @cust_main_invoice;
3130 foreach my $address ( @{$arrayref} ) {
3131 next if exists $seen{$address} && $seen{$address};
3132 $seen{$address} = 1;
3133 my $cust_main_invoice = new FS::cust_main_invoice ( {
3134 'custnum' => $self->custnum,
3137 my $error = $cust_main_invoice->insert;
3138 warn $error if $error;
3142 if ( $self->custnum ) {
3144 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3151 =item check_invoicing_list ARRAYREF
3153 Checks these arguements as valid input for the invoicing_list method. If there
3154 is an error, returns the error, otherwise returns false.
3158 sub check_invoicing_list {
3159 my( $self, $arrayref ) = @_;
3161 foreach my $address ( @$arrayref ) {
3163 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3164 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3167 my $cust_main_invoice = new FS::cust_main_invoice ( {
3168 'custnum' => $self->custnum,
3171 my $error = $self->custnum
3172 ? $cust_main_invoice->check
3173 : $cust_main_invoice->checkdest
3175 return $error if $error;
3179 return "Email address required"
3180 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3181 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3186 =item set_default_invoicing_list
3188 Sets the invoicing list to all accounts associated with this customer,
3189 overwriting any previous invoicing list.
3193 sub set_default_invoicing_list {
3195 $self->invoicing_list($self->all_emails);
3200 Returns the email addresses of all accounts provisioned for this customer.
3207 foreach my $cust_pkg ( $self->all_pkgs ) {
3208 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3210 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3211 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3213 $list{$_}=1 foreach map { $_->email } @svc_acct;
3218 =item invoicing_list_addpost
3220 Adds postal invoicing to this customer. If this customer is already configured
3221 to receive postal invoices, does nothing.
3225 sub invoicing_list_addpost {
3227 return if grep { $_ eq 'POST' } $self->invoicing_list;
3228 my @invoicing_list = $self->invoicing_list;
3229 push @invoicing_list, 'POST';
3230 $self->invoicing_list(\@invoicing_list);
3233 =item invoicing_list_emailonly
3235 Returns the list of email invoice recipients (invoicing_list without non-email
3236 destinations such as POST and FAX).
3240 sub invoicing_list_emailonly {
3242 warn "$me invoicing_list_emailonly called"
3244 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3247 =item invoicing_list_emailonly_scalar
3249 Returns the list of email invoice recipients (invoicing_list without non-email
3250 destinations such as POST and FAX) as a comma-separated scalar.
3254 sub invoicing_list_emailonly_scalar {
3256 warn "$me invoicing_list_emailonly_scalar called"
3258 join(', ', $self->invoicing_list_emailonly);
3261 =item referral_custnum_cust_main
3263 Returns the customer who referred this customer (or the empty string, if
3264 this customer was not referred).
3266 Note the difference with referral_cust_main method: This method,
3267 referral_custnum_cust_main returns the single customer (if any) who referred
3268 this customer, while referral_cust_main returns an array of customers referred
3273 sub referral_custnum_cust_main {
3275 return '' unless $self->referral_custnum;
3276 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3279 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3281 Returns an array of customers referred by this customer (referral_custnum set
3282 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3283 customers referred by customers referred by this customer and so on, inclusive.
3284 The default behavior is DEPTH 1 (no recursion).
3286 Note the difference with referral_custnum_cust_main method: This method,
3287 referral_cust_main, returns an array of customers referred BY this customer,
3288 while referral_custnum_cust_main returns the single customer (if any) who
3289 referred this customer.
3293 sub referral_cust_main {
3295 my $depth = @_ ? shift : 1;
3296 my $exclude = @_ ? shift : {};
3299 map { $exclude->{$_->custnum}++; $_; }
3300 grep { ! $exclude->{ $_->custnum } }
3301 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3305 map { $_->referral_cust_main($depth-1, $exclude) }
3312 =item referral_cust_main_ncancelled
3314 Same as referral_cust_main, except only returns customers with uncancelled
3319 sub referral_cust_main_ncancelled {
3321 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3324 =item referral_cust_pkg [ DEPTH ]
3326 Like referral_cust_main, except returns a flat list of all unsuspended (and
3327 uncancelled) packages for each customer. The number of items in this list may
3328 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3332 sub referral_cust_pkg {
3334 my $depth = @_ ? shift : 1;
3336 map { $_->unsuspended_pkgs }
3337 grep { $_->unsuspended_pkgs }
3338 $self->referral_cust_main($depth);
3341 =item referring_cust_main
3343 Returns the single cust_main record for the customer who referred this customer
3344 (referral_custnum), or false.
3348 sub referring_cust_main {
3350 return '' unless $self->referral_custnum;
3351 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3354 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3356 Applies a credit to this customer. If there is an error, returns the error,
3357 otherwise returns false.
3359 REASON can be a text string, an FS::reason object, or a scalar reference to
3360 a reasonnum. If a text string, it will be automatically inserted as a new
3361 reason, and a 'reason_type' option must be passed to indicate the
3362 FS::reason_type for the new reason.
3364 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3366 Any other options are passed to FS::cust_credit::insert.
3371 my( $self, $amount, $reason, %options ) = @_;
3373 my $cust_credit = new FS::cust_credit {
3374 'custnum' => $self->custnum,
3375 'amount' => $amount,
3378 if ( ref($reason) ) {
3380 if ( ref($reason) eq 'SCALAR' ) {
3381 $cust_credit->reasonnum( $$reason );
3383 $cust_credit->reasonnum( $reason->reasonnum );
3387 $cust_credit->set('reason', $reason)
3390 for (qw( addlinfo eventnum )) {
3391 $cust_credit->$_( delete $options{$_} )
3392 if exists($options{$_});
3395 $cust_credit->insert(%options);
3399 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3401 Creates a one-time charge for this customer. If there is an error, returns
3402 the error, otherwise returns false.
3404 New-style, with a hashref of options:
3406 my $error = $cust_main->charge(
3410 'start_date' => str2time('7/4/2009'),
3411 'pkg' => 'Description',
3412 'comment' => 'Comment',
3413 'additional' => [], #extra invoice detail
3414 'classnum' => 1, #pkg_class
3416 'setuptax' => '', # or 'Y' for tax exempt
3419 'taxclass' => 'Tax class',
3422 'taxproduct' => 2, #part_pkg_taxproduct
3423 'override' => {}, #XXX describe
3425 #will be filled in with the new object
3426 'cust_pkg_ref' => \$cust_pkg,
3428 #generate an invoice immediately
3430 'invoice_terms' => '', #with these terms
3436 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3442 my ( $amount, $quantity, $start_date, $classnum );
3443 my ( $pkg, $comment, $additional );
3444 my ( $setuptax, $taxclass ); #internal taxes
3445 my ( $taxproduct, $override ); #vendor (CCH) taxes
3447 my $cust_pkg_ref = '';
3448 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3449 if ( ref( $_[0] ) ) {
3450 $amount = $_[0]->{amount};
3451 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3452 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3453 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3454 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3455 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3456 : '$'. sprintf("%.2f",$amount);
3457 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3458 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3459 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3460 $additional = $_[0]->{additional} || [];
3461 $taxproduct = $_[0]->{taxproductnum};
3462 $override = { '' => $_[0]->{tax_override} };
3463 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3464 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3465 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3470 $pkg = @_ ? shift : 'One-time charge';
3471 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3473 $taxclass = @_ ? shift : '';
3477 local $SIG{HUP} = 'IGNORE';
3478 local $SIG{INT} = 'IGNORE';
3479 local $SIG{QUIT} = 'IGNORE';
3480 local $SIG{TERM} = 'IGNORE';
3481 local $SIG{TSTP} = 'IGNORE';
3482 local $SIG{PIPE} = 'IGNORE';
3484 my $oldAutoCommit = $FS::UID::AutoCommit;
3485 local $FS::UID::AutoCommit = 0;
3488 my $part_pkg = new FS::part_pkg ( {
3490 'comment' => $comment,
3494 'classnum' => ( $classnum ? $classnum : '' ),
3495 'setuptax' => $setuptax,
3496 'taxclass' => $taxclass,
3497 'taxproductnum' => $taxproduct,
3500 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3501 ( 0 .. @$additional - 1 )
3503 'additional_count' => scalar(@$additional),
3504 'setup_fee' => $amount,
3507 my $error = $part_pkg->insert( options => \%options,
3508 tax_overrides => $override,
3511 $dbh->rollback if $oldAutoCommit;
3515 my $pkgpart = $part_pkg->pkgpart;
3516 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3517 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3518 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3519 $error = $type_pkgs->insert;
3521 $dbh->rollback if $oldAutoCommit;
3526 my $cust_pkg = new FS::cust_pkg ( {
3527 'custnum' => $self->custnum,
3528 'pkgpart' => $pkgpart,
3529 'quantity' => $quantity,
3530 'start_date' => $start_date,
3531 'no_auto' => $no_auto,
3534 $error = $cust_pkg->insert;
3536 $dbh->rollback if $oldAutoCommit;
3538 } elsif ( $cust_pkg_ref ) {
3539 ${$cust_pkg_ref} = $cust_pkg;
3543 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3544 'pkg_list' => [ $cust_pkg ],
3547 $dbh->rollback if $oldAutoCommit;
3552 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3557 #=item charge_postal_fee
3559 #Applies a one time charge this customer. If there is an error,
3560 #returns the error, returns the cust_pkg charge object or false
3561 #if there was no charge.
3565 # This should be a customer event. For that to work requires that bill
3566 # also be a customer event.
3568 sub charge_postal_fee {
3571 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3572 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3574 my $cust_pkg = new FS::cust_pkg ( {
3575 'custnum' => $self->custnum,
3576 'pkgpart' => $pkgpart,
3580 my $error = $cust_pkg->insert;
3581 $error ? $error : $cust_pkg;
3584 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3586 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3588 Optionally, a list or hashref of additional arguments to the qsearch call can
3595 my $opt = ref($_[0]) ? shift : { @_ };
3597 #return $self->num_cust_bill unless wantarray || keys %$opt;
3599 $opt->{'table'} = 'cust_bill';
3600 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3601 $opt->{'hashref'}{'custnum'} = $self->custnum;
3602 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3604 map { $_ } #behavior of sort undefined in scalar context
3605 sort { $a->_date <=> $b->_date }
3609 =item open_cust_bill
3611 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3616 sub open_cust_bill {
3620 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3626 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3628 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3632 sub legacy_cust_bill {
3635 #return $self->num_legacy_cust_bill unless wantarray;
3637 map { $_ } #behavior of sort undefined in scalar context
3638 sort { $a->_date <=> $b->_date }
3639 qsearch({ 'table' => 'legacy_cust_bill',
3640 'hashref' => { 'custnum' => $self->custnum, },
3641 'order_by' => 'ORDER BY _date ASC',
3645 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3647 Returns all the statements (see L<FS::cust_statement>) for this customer.
3649 Optionally, a list or hashref of additional arguments to the qsearch call can
3654 =item cust_bill_void
3656 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3660 sub cust_bill_void {
3663 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3664 sort { $a->_date <=> $b->_date }
3665 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3668 sub cust_statement {
3670 my $opt = ref($_[0]) ? shift : { @_ };
3672 #return $self->num_cust_statement unless wantarray || keys %$opt;
3674 $opt->{'table'} = 'cust_statement';
3675 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3676 $opt->{'hashref'}{'custnum'} = $self->custnum;
3677 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3679 map { $_ } #behavior of sort undefined in scalar context
3680 sort { $a->_date <=> $b->_date }
3684 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3686 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3688 Optionally, a list or hashref of additional arguments to the qsearch call can
3689 be passed following the SVCDB.
3696 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3697 warn "$me svc_x requires a svcdb";
3700 my $opt = ref($_[0]) ? shift : { @_ };
3702 $opt->{'table'} = $svcdb;
3703 $opt->{'addl_from'} =
3704 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3705 ($opt->{'addl_from'} || '');
3707 my $custnum = $self->custnum;
3708 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3709 my $where = "cust_pkg.custnum = $custnum";
3711 my $extra_sql = $opt->{'extra_sql'} || '';
3712 if ( keys %{ $opt->{'hashref'} } ) {
3713 $extra_sql = " AND $where $extra_sql";
3716 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3717 $extra_sql = "WHERE $where AND $1";
3720 $extra_sql = "WHERE $where $extra_sql";
3723 $opt->{'extra_sql'} = $extra_sql;
3728 # required for use as an eventtable;
3731 $self->svc_x('svc_acct', @_);
3736 Returns all the credits (see L<FS::cust_credit>) for this customer.
3742 map { $_ } #return $self->num_cust_credit unless wantarray;
3743 sort { $a->_date <=> $b->_date }
3744 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3747 =item cust_credit_pkgnum
3749 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3750 package when using experimental package balances.
3754 sub cust_credit_pkgnum {
3755 my( $self, $pkgnum ) = @_;
3756 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3757 sort { $a->_date <=> $b->_date }
3758 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3759 'pkgnum' => $pkgnum,
3766 Returns all the payments (see L<FS::cust_pay>) for this customer.
3772 return $self->num_cust_pay unless wantarray;
3773 sort { $a->_date <=> $b->_date }
3774 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3779 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3780 called automatically when the cust_pay method is used in a scalar context.
3786 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3787 my $sth = dbh->prepare($sql) or die dbh->errstr;
3788 $sth->execute($self->custnum) or die $sth->errstr;
3789 $sth->fetchrow_arrayref->[0];
3792 =item cust_pay_pkgnum
3794 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3795 package when using experimental package balances.
3799 sub cust_pay_pkgnum {
3800 my( $self, $pkgnum ) = @_;
3801 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3802 sort { $a->_date <=> $b->_date }
3803 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3804 'pkgnum' => $pkgnum,
3811 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3817 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3818 sort { $a->_date <=> $b->_date }
3819 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3822 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3824 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3826 Optionally, a list or hashref of additional arguments to the qsearch call can
3831 sub cust_pay_batch {
3833 my $opt = ref($_[0]) ? shift : { @_ };
3835 #return $self->num_cust_statement unless wantarray || keys %$opt;
3837 $opt->{'table'} = 'cust_pay_batch';
3838 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3839 $opt->{'hashref'}{'custnum'} = $self->custnum;
3840 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3842 map { $_ } #behavior of sort undefined in scalar context
3843 sort { $a->paybatchnum <=> $b->paybatchnum }
3847 =item cust_pay_pending
3849 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3850 (without status "done").
3854 sub cust_pay_pending {
3856 return $self->num_cust_pay_pending unless wantarray;
3857 sort { $a->_date <=> $b->_date }
3858 qsearch( 'cust_pay_pending', {
3859 'custnum' => $self->custnum,
3860 'status' => { op=>'!=', value=>'done' },
3865 =item cust_pay_pending_attempt
3867 Returns all payment attempts / declined payments for this customer, as pending
3868 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3869 a corresponding payment (see L<FS::cust_pay>).
3873 sub cust_pay_pending_attempt {
3875 return $self->num_cust_pay_pending_attempt unless wantarray;
3876 sort { $a->_date <=> $b->_date }
3877 qsearch( 'cust_pay_pending', {
3878 'custnum' => $self->custnum,
3885 =item num_cust_pay_pending
3887 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3888 customer (without status "done"). Also called automatically when the
3889 cust_pay_pending method is used in a scalar context.
3893 sub num_cust_pay_pending {
3896 " SELECT COUNT(*) FROM cust_pay_pending ".
3897 " WHERE custnum = ? AND status != 'done' ",
3902 =item num_cust_pay_pending_attempt
3904 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3905 customer, with status "done" but without a corresp. Also called automatically when the
3906 cust_pay_pending method is used in a scalar context.
3910 sub num_cust_pay_pending_attempt {
3913 " SELECT COUNT(*) FROM cust_pay_pending ".
3914 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3921 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3927 map { $_ } #return $self->num_cust_refund unless wantarray;
3928 sort { $a->_date <=> $b->_date }
3929 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3932 =item display_custnum
3934 Returns the displayed customer number for this customer: agent_custid if
3935 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3939 sub display_custnum {
3942 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3943 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3944 if ( $special eq 'CoStAg' ) {
3945 $prefix = uc( join('',
3947 ($self->state =~ /^(..)/),
3948 $prefix || ($self->agent->agent =~ /^(..)/)
3951 elsif ( $special eq 'CoStCl' ) {
3952 $prefix = uc( join('',
3954 ($self->state =~ /^(..)/),
3955 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3958 # add any others here if needed
3961 my $length = $conf->config('cust_main-custnum-display_length');
3962 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3963 return $self->agent_custid;
3964 } elsif ( $prefix ) {
3965 $length = 8 if !defined($length);
3967 sprintf('%0'.$length.'d', $self->custnum)
3968 } elsif ( $length ) {
3969 return sprintf('%0'.$length.'d', $self->custnum);
3971 return $self->custnum;
3977 Returns a name string for this customer, either "Company (Last, First)" or
3984 my $name = $self->contact;
3985 $name = $self->company. " ($name)" if $self->company;
3989 =item service_contact
3991 Returns the L<FS::contact> object for this customer that has the 'Service'
3992 contact class, or undef if there is no such contact. Deprecated; don't use
3997 sub service_contact {
3999 if ( !exists($self->{service_contact}) ) {
4000 my $classnum = $self->scalar_sql(
4001 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4002 ) || 0; #if it's zero, qsearchs will return nothing
4003 $self->{service_contact} = qsearchs('contact', {
4004 'classnum' => $classnum, 'custnum' => $self->custnum
4007 $self->{service_contact};
4012 Returns a name string for this (service/shipping) contact, either
4013 "Company (Last, First)" or "Last, First".
4020 my $name = $self->ship_contact;
4021 $name = $self->company. " ($name)" if $self->company;
4027 Returns a name string for this customer, either "Company" or "First Last".
4033 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4036 =item ship_name_short
4038 Returns a name string for this (service/shipping) contact, either "Company"
4043 sub ship_name_short {
4045 $self->service_contact
4046 ? $self->ship_contact_firstlast
4052 Returns this customer's full (billing) contact name only, "Last, First"
4058 $self->get('last'). ', '. $self->first;
4063 Returns this customer's full (shipping) contact name only, "Last, First"
4069 my $contact = $self->service_contact || $self;
4070 $contact->get('last') . ', ' . $contact->get('first');
4073 =item contact_firstlast
4075 Returns this customers full (billing) contact name only, "First Last".
4079 sub contact_firstlast {
4081 $self->first. ' '. $self->get('last');
4084 =item ship_contact_firstlast
4086 Returns this customer's full (shipping) contact name only, "First Last".
4090 sub ship_contact_firstlast {
4092 my $contact = $self->service_contact || $self;
4093 $contact->get('first') . ' '. $contact->get('last');
4098 Returns this customer's full country name
4104 code2country($self->country);
4107 =item geocode DATA_VENDOR
4109 Returns a value for the customer location as encoded by DATA_VENDOR.
4110 Currently this only makes sense for "CCH" as DATA_VENDOR.
4118 Returns a status string for this customer, currently:
4122 =item prospect - No packages have ever been ordered
4124 =item ordered - Recurring packages all are new (not yet billed).
4126 =item active - One or more recurring packages is active
4128 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4130 =item suspended - All non-cancelled recurring packages are suspended
4132 =item cancelled - All recurring packages are cancelled
4136 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4137 cust_main-status_module configuration option.
4141 sub status { shift->cust_status(@_); }
4145 for my $status ( FS::cust_main->statuses() ) {
4146 my $method = $status.'_sql';
4147 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4148 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4149 $sth->execute( ($self->custnum) x $numnum )
4150 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4151 return $status if $sth->fetchrow_arrayref->[0];
4155 =item ucfirst_cust_status
4157 =item ucfirst_status
4159 Returns the status with the first character capitalized.
4163 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4165 sub ucfirst_cust_status {
4167 ucfirst($self->cust_status);
4172 Returns a hex triplet color string for this customer's status.
4176 sub statuscolor { shift->cust_statuscolor(@_); }
4178 sub cust_statuscolor {
4180 __PACKAGE__->statuscolors->{$self->cust_status};
4185 Returns an array of hashes representing the customer's RT tickets.
4192 my $num = $conf->config('cust_main-max_tickets') || 10;
4195 if ( $conf->config('ticket_system') ) {
4196 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4198 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4202 foreach my $priority (
4203 $conf->config('ticket_system-custom_priority_field-values'), ''
4205 last if scalar(@tickets) >= $num;
4207 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4208 $num - scalar(@tickets),
4218 # Return services representing svc_accts in customer support packages
4219 sub support_services {
4221 my %packages = map { $_ => 1 } $conf->config('support_packages');
4223 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4224 grep { $_->part_svc->svcdb eq 'svc_acct' }
4225 map { $_->cust_svc }
4226 grep { exists $packages{ $_->pkgpart } }
4227 $self->ncancelled_pkgs;
4231 # Return a list of latitude/longitude for one of the services (if any)
4232 sub service_coordinates {
4236 grep { $_->latitude && $_->longitude }
4238 map { $_->cust_svc }
4239 $self->ncancelled_pkgs;
4241 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4246 Returns a masked version of the named field
4251 my ($self,$field) = @_;
4255 'x'x(length($self->getfield($field))-4).
4256 substr($self->getfield($field), (length($self->getfield($field))-4));
4262 =head1 CLASS METHODS
4268 Class method that returns the list of possible status strings for customers
4269 (see L<the status method|/status>). For example:
4271 @statuses = FS::cust_main->statuses();
4277 keys %{ $self->statuscolors };
4280 =item cust_status_sql
4282 Returns an SQL fragment to determine the status of a cust_main record, as a
4287 sub cust_status_sql {
4289 for my $status ( FS::cust_main->statuses() ) {
4290 my $method = $status.'_sql';
4291 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4300 Returns an SQL expression identifying prospective cust_main records (customers
4301 with no packages ever ordered)
4305 use vars qw($select_count_pkgs);
4306 $select_count_pkgs =
4307 "SELECT COUNT(*) FROM cust_pkg
4308 WHERE cust_pkg.custnum = cust_main.custnum";
4310 sub select_count_pkgs_sql {
4315 " 0 = ( $select_count_pkgs ) ";
4320 Returns an SQL expression identifying ordered cust_main records (customers with
4321 no active packages, but recurring packages not yet setup or one time charges
4327 FS::cust_main->none_active_sql.
4328 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4333 Returns an SQL expression identifying active cust_main records (customers with
4334 active recurring packages).
4339 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4342 =item none_active_sql
4344 Returns an SQL expression identifying cust_main records with no active
4345 recurring packages. This includes customers of status prospect, ordered,
4346 inactive, and suspended.
4350 sub none_active_sql {
4351 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4356 Returns an SQL expression identifying inactive cust_main records (customers with
4357 no active recurring packages, but otherwise unsuspended/uncancelled).
4362 FS::cust_main->none_active_sql.
4363 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4369 Returns an SQL expression identifying suspended cust_main records.
4374 sub suspended_sql { susp_sql(@_); }
4376 FS::cust_main->none_active_sql.
4377 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4383 Returns an SQL expression identifying cancelled cust_main records.
4387 sub cancel_sql { shift->cancelled_sql(@_); }
4390 =item uncancelled_sql
4392 Returns an SQL expression identifying un-cancelled cust_main records.
4396 sub uncancelled_sql { uncancel_sql(@_); }
4397 sub uncancel_sql { "
4398 ( 0 < ( $select_count_pkgs
4399 AND ( cust_pkg.cancel IS NULL
4400 OR cust_pkg.cancel = 0
4403 OR 0 = ( $select_count_pkgs )
4409 Returns an SQL fragment to retreive the balance.
4414 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4415 WHERE cust_bill.custnum = cust_main.custnum )
4416 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4417 WHERE cust_pay.custnum = cust_main.custnum )
4418 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4419 WHERE cust_credit.custnum = cust_main.custnum )
4420 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4421 WHERE cust_refund.custnum = cust_main.custnum )
4424 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4426 Returns an SQL fragment to retreive the balance for this customer, optionally
4427 considering invoices with date earlier than START_TIME, and not
4428 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4429 total_unapplied_payments).
4431 Times are specified as SQL fragments or numeric
4432 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4433 L<Date::Parse> for conversion functions. The empty string can be passed
4434 to disable that time constraint completely.
4436 Available options are:
4440 =item unapplied_date
4442 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)
4447 set to true to remove all customer comparison clauses, for totals
4452 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4457 JOIN clause (typically used with the total option)
4461 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4462 time will be ignored. Note that START_TIME and END_TIME only limit the date
4463 range for invoices and I<unapplied> payments, credits, and refunds.
4469 sub balance_date_sql {
4470 my( $class, $start, $end, %opt ) = @_;
4472 my $cutoff = $opt{'cutoff'};
4474 my $owed = FS::cust_bill->owed_sql($cutoff);
4475 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4476 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4477 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4479 my $j = $opt{'join'} || '';
4481 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4482 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4483 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4484 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4486 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4487 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4488 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4489 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4494 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4496 Returns an SQL fragment to retreive the total unapplied payments for this
4497 customer, only considering payments with date earlier than START_TIME, and
4498 optionally not later than END_TIME.
4500 Times are specified as SQL fragments or numeric
4501 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4502 L<Date::Parse> for conversion functions. The empty string can be passed
4503 to disable that time constraint completely.
4505 Available options are:
4509 sub unapplied_payments_date_sql {
4510 my( $class, $start, $end, %opt ) = @_;
4512 my $cutoff = $opt{'cutoff'};
4514 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4516 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4517 'unapplied_date'=>1 );
4519 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4522 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4524 Helper method for balance_date_sql; name (and usage) subject to change
4525 (suggestions welcome).
4527 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4528 cust_refund, cust_credit or cust_pay).
4530 If TABLE is "cust_bill" or the unapplied_date option is true, only
4531 considers records with date earlier than START_TIME, and optionally not
4532 later than END_TIME .
4536 sub _money_table_where {
4537 my( $class, $table, $start, $end, %opt ) = @_;
4540 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4541 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4542 push @where, "$table._date <= $start" if defined($start) && length($start);
4543 push @where, "$table._date > $end" if defined($end) && length($end);
4545 push @where, @{$opt{'where'}} if $opt{'where'};
4546 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4552 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4553 use FS::cust_main::Search;
4556 FS::cust_main::Search->search(@_);
4571 #warn join('-',keys %$param);
4572 my $fh = $param->{filehandle};
4573 my $agentnum = $param->{agentnum};
4574 my $format = $param->{format};
4576 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4579 if ( $format eq 'simple' ) {
4580 @fields = qw( custnum agent_custid amount pkg );
4582 die "unknown format $format";
4585 eval "use Text::CSV_XS;";
4588 my $csv = new Text::CSV_XS;
4595 local $SIG{HUP} = 'IGNORE';
4596 local $SIG{INT} = 'IGNORE';
4597 local $SIG{QUIT} = 'IGNORE';
4598 local $SIG{TERM} = 'IGNORE';
4599 local $SIG{TSTP} = 'IGNORE';
4600 local $SIG{PIPE} = 'IGNORE';
4602 my $oldAutoCommit = $FS::UID::AutoCommit;
4603 local $FS::UID::AutoCommit = 0;
4606 #while ( $columns = $csv->getline($fh) ) {
4608 while ( defined($line=<$fh>) ) {
4610 $csv->parse($line) or do {
4611 $dbh->rollback if $oldAutoCommit;
4612 return "can't parse: ". $csv->error_input();
4615 my @columns = $csv->fields();
4616 #warn join('-',@columns);
4619 foreach my $field ( @fields ) {
4620 $row{$field} = shift @columns;
4623 if ( $row{custnum} && $row{agent_custid} ) {
4624 dbh->rollback if $oldAutoCommit;
4625 return "can't specify custnum with agent_custid $row{agent_custid}";
4629 if ( $row{agent_custid} && $agentnum ) {
4630 %hash = ( 'agent_custid' => $row{agent_custid},
4631 'agentnum' => $agentnum,
4635 if ( $row{custnum} ) {
4636 %hash = ( 'custnum' => $row{custnum} );
4639 unless ( scalar(keys %hash) ) {
4640 $dbh->rollback if $oldAutoCommit;
4641 return "can't find customer without custnum or agent_custid and agentnum";
4644 my $cust_main = qsearchs('cust_main', { %hash } );
4645 unless ( $cust_main ) {
4646 $dbh->rollback if $oldAutoCommit;
4647 my $custnum = $row{custnum} || $row{agent_custid};
4648 return "unknown custnum $custnum";
4651 if ( $row{'amount'} > 0 ) {
4652 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4654 $dbh->rollback if $oldAutoCommit;
4658 } elsif ( $row{'amount'} < 0 ) {
4659 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4662 $dbh->rollback if $oldAutoCommit;
4672 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4674 return "Empty file!" unless $imported;
4680 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4682 Deprecated. Use event notification and message templates
4683 (L<FS::msg_template>) instead.
4685 Sends a templated email notification to the customer (see L<Text::Template>).
4687 OPTIONS is a hash and may include
4689 I<from> - the email sender (default is invoice_from)
4691 I<to> - comma-separated scalar or arrayref of recipients
4692 (default is invoicing_list)
4694 I<subject> - The subject line of the sent email notification
4695 (default is "Notice from company_name")
4697 I<extra_fields> - a hashref of name/value pairs which will be substituted
4700 The following variables are vavailable in the template.
4702 I<$first> - the customer first name
4703 I<$last> - the customer last name
4704 I<$company> - the customer company
4705 I<$payby> - a description of the method of payment for the customer
4706 # would be nice to use FS::payby::shortname
4707 I<$payinfo> - the account information used to collect for this customer
4708 I<$expdate> - the expiration of the customer payment in seconds from epoch
4713 my ($self, $template, %options) = @_;
4715 return unless $conf->exists($template);
4717 my $from = $conf->config('invoice_from', $self->agentnum)
4718 if $conf->exists('invoice_from', $self->agentnum);
4719 $from = $options{from} if exists($options{from});
4721 my $to = join(',', $self->invoicing_list_emailonly);
4722 $to = $options{to} if exists($options{to});
4724 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4725 if $conf->exists('company_name', $self->agentnum);
4726 $subject = $options{subject} if exists($options{subject});
4728 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4729 SOURCE => [ map "$_\n",
4730 $conf->config($template)]
4732 or die "can't create new Text::Template object: Text::Template::ERROR";
4733 $notify_template->compile()
4734 or die "can't compile template: Text::Template::ERROR";
4736 $FS::notify_template::_template::company_name =
4737 $conf->config('company_name', $self->agentnum);
4738 $FS::notify_template::_template::company_address =
4739 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4741 my $paydate = $self->paydate || '2037-12-31';
4742 $FS::notify_template::_template::first = $self->first;
4743 $FS::notify_template::_template::last = $self->last;
4744 $FS::notify_template::_template::company = $self->company;
4745 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4746 my $payby = $self->payby;
4747 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4748 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4750 #credit cards expire at the end of the month/year of their exp date
4751 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4752 $FS::notify_template::_template::payby = 'credit card';
4753 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4754 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4756 }elsif ($payby eq 'COMP') {
4757 $FS::notify_template::_template::payby = 'complimentary account';
4759 $FS::notify_template::_template::payby = 'current method';
4761 $FS::notify_template::_template::expdate = $expire_time;
4763 for (keys %{$options{extra_fields}}){
4765 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4768 send_email(from => $from,
4770 subject => $subject,
4771 body => $notify_template->fill_in( PACKAGE =>
4772 'FS::notify_template::_template' ),
4777 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4779 Generates a templated notification to the customer (see L<Text::Template>).
4781 OPTIONS is a hash and may include
4783 I<extra_fields> - a hashref of name/value pairs which will be substituted
4784 into the template. These values may override values mentioned below
4785 and those from the customer record.
4787 The following variables are available in the template instead of or in addition
4788 to the fields of the customer record.
4790 I<$payby> - a description of the method of payment for the customer
4791 # would be nice to use FS::payby::shortname
4792 I<$payinfo> - the masked account information used to collect for this customer
4793 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4794 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4798 # a lot like cust_bill::print_latex
4799 sub generate_letter {
4800 my ($self, $template, %options) = @_;
4802 return unless $conf->exists($template);
4804 my $letter_template = new Text::Template
4806 SOURCE => [ map "$_\n", $conf->config($template)],
4807 DELIMITERS => [ '[@--', '--@]' ],
4809 or die "can't create new Text::Template object: Text::Template::ERROR";
4811 $letter_template->compile()
4812 or die "can't compile template: Text::Template::ERROR";
4814 my %letter_data = map { $_ => $self->$_ } $self->fields;
4815 $letter_data{payinfo} = $self->mask_payinfo;
4817 #my $paydate = $self->paydate || '2037-12-31';
4818 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4820 my $payby = $self->payby;
4821 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4822 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4824 #credit cards expire at the end of the month/year of their exp date
4825 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4826 $letter_data{payby} = 'credit card';
4827 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4828 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4830 }elsif ($payby eq 'COMP') {
4831 $letter_data{payby} = 'complimentary account';
4833 $letter_data{payby} = 'current method';
4835 $letter_data{expdate} = $expire_time;
4837 for (keys %{$options{extra_fields}}){
4838 $letter_data{$_} = $options{extra_fields}->{$_};
4841 unless(exists($letter_data{returnaddress})){
4842 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4843 $self->agent_template)
4845 if ( length($retadd) ) {
4846 $letter_data{returnaddress} = $retadd;
4847 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4848 $letter_data{returnaddress} =
4849 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4853 ( $conf->config('company_name', $self->agentnum),
4854 $conf->config('company_address', $self->agentnum),
4858 $letter_data{returnaddress} = '~';
4862 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4864 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4866 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4868 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4872 ) or die "can't open temp file: $!\n";
4873 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4874 or die "can't write temp file: $!\n";
4876 $letter_data{'logo_file'} = $lh->filename;
4878 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4882 ) or die "can't open temp file: $!\n";
4884 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4886 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4887 return ($1, $letter_data{'logo_file'});
4891 =item print_ps TEMPLATE
4893 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4899 my($file, $lfile) = $self->generate_letter(@_);
4900 my $ps = FS::Misc::generate_ps($file);
4901 unlink($file.'.tex');
4907 =item print TEMPLATE
4909 Prints the filled in template.
4911 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4915 sub queueable_print {
4918 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4919 or die "invalid customer number: " . $opt{custvnum};
4921 my $error = $self->print( $opt{template} );
4922 die $error if $error;
4926 my ($self, $template) = (shift, shift);
4927 do_print [ $self->print_ps($template) ];
4930 #these three subs should just go away once agent stuff is all config overrides
4932 sub agent_template {
4934 $self->_agent_plandata('agent_templatename');
4937 sub agent_invoice_from {
4939 $self->_agent_plandata('agent_invoice_from');
4942 sub _agent_plandata {
4943 my( $self, $option ) = @_;
4945 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4946 #agent-specific Conf
4948 use FS::part_event::Condition;
4950 my $agentnum = $self->agentnum;
4952 my $regexp = regexp_sql();
4954 my $part_event_option =
4956 'select' => 'part_event_option.*',
4957 'table' => 'part_event_option',
4959 LEFT JOIN part_event USING ( eventpart )
4960 LEFT JOIN part_event_option AS peo_agentnum
4961 ON ( part_event.eventpart = peo_agentnum.eventpart
4962 AND peo_agentnum.optionname = 'agentnum'
4963 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4965 LEFT JOIN part_event_condition
4966 ON ( part_event.eventpart = part_event_condition.eventpart
4967 AND part_event_condition.conditionname = 'cust_bill_age'
4969 LEFT JOIN part_event_condition_option
4970 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4971 AND part_event_condition_option.optionname = 'age'
4974 #'hashref' => { 'optionname' => $option },
4975 #'hashref' => { 'part_event_option.optionname' => $option },
4977 " WHERE part_event_option.optionname = ". dbh->quote($option).
4978 " AND action = 'cust_bill_send_agent' ".
4979 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4980 " AND peo_agentnum.optionname = 'agentnum' ".
4981 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4983 CASE WHEN part_event_condition_option.optionname IS NULL
4985 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4987 , part_event.weight".
4991 unless ( $part_event_option ) {
4992 return $self->agent->invoice_template || ''
4993 if $option eq 'agent_templatename';
4997 $part_event_option->optionvalue;
5001 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5003 Subroutine (not a method), designed to be called from the queue.
5005 Takes a list of options and values.
5007 Pulls up the customer record via the custnum option and calls bill_and_collect.
5012 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5014 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5015 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5017 $cust_main->bill_and_collect( %args );
5020 sub process_bill_and_collect {
5022 my $param = thaw(decode_base64(shift));
5023 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5024 or die "custnum '$param->{custnum}' not found!\n";
5025 $param->{'job'} = $job;
5026 $param->{'fatal'} = 1; # runs from job queue, will be caught
5027 $param->{'retry'} = 1;
5029 $cust_main->bill_and_collect( %$param );
5032 =item process_censustract_update CUSTNUM
5034 Queueable function to update the census tract to the current year (as set in
5035 the 'census_year' configuration variable) and retrieve the new tract code.
5039 sub process_censustract_update {
5040 eval "use FS::Misc::Geo qw(get_censustract)";
5042 my $custnum = shift;
5043 my $cust_main = qsearchs( 'cust_main', { custnum => $custnum })
5044 or die "custnum '$custnum' not found!\n";
5046 my $new_year = $conf->config('census_year') or return;
5047 my $new_tract = get_censustract({ $cust_main->location_hash }, $new_year);
5048 if ( $new_tract =~ /^\d/ ) {
5049 # then it's a tract code
5050 $cust_main->set('censustract', $new_tract);
5051 $cust_main->set('censusyear', $new_year);
5053 local($ignore_expired_card) = 1;
5054 local($ignore_illegal_zip) = 1;
5055 local($ignore_banned_card) = 1;
5056 local($skip_fuzzyfiles) = 1;
5057 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5058 my $error = $cust_main->replace;
5059 die $error if $error;
5062 # it's an error message
5068 #starting to take quite a while for big dbs
5069 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5070 # - seq scan of cust_main on signupdate... index signupdate? will that help?
5071 # - seq scan of cust_main on paydate... index on substrings? maybe set an
5072 # upgrade journal flag now that we have that, yyyy-m-dd paydates are ancient
5073 # - seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5074 # upgrade journal again? this is also an ancient problem
5075 # - otaker upgrade? journal and call it good? (double check to make sure
5076 # we're not still setting otaker here)
5078 #only going to get worse with new location stuff...
5080 sub _upgrade_data { #class method
5081 my ($class, %opts) = @_;
5084 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5087 #this seems to be the only expensive one.. why does it take so long?
5088 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5090 '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';
5091 FS::upgrade_journal->set_done('cust_main__signupdate');
5094 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5096 # fix yyyy-m-dd formatted paydates
5097 if ( driver_name =~ /^mysql/i ) {
5099 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5100 } else { # the SQL standard
5102 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5104 FS::upgrade_journal->set_done('cust_main__paydate');
5107 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5109 push @statements, #fix the weird BILL with a cc# in payinfo problem
5111 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5113 FS::upgrade_journal->set_done('cust_main__payinfo');
5118 foreach my $sql ( @statements ) {
5119 my $sth = dbh->prepare($sql) or die dbh->errstr;
5120 $sth->execute or die $sth->errstr;
5121 #warn ( (time - $t). " seconds\n" );
5125 local($ignore_expired_card) = 1;
5126 local($ignore_banned_card) = 1;
5127 local($skip_fuzzyfiles) = 1;
5128 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5129 $class->_upgrade_otaker(%opts);
5131 FS::cust_main::Location->_upgrade_data(%opts);
5141 The delete method should possibly take an FS::cust_main object reference
5142 instead of a scalar customer number.
5144 Bill and collect options should probably be passed as references instead of a
5147 There should probably be a configuration file with a list of allowed credit
5150 No multiple currency support (probably a larger project than just this module).
5152 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5154 Birthdates rely on negative epoch values.
5156 The payby for card/check batches is broken. With mixed batching, bad
5159 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5163 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5164 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5165 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.