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
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::legacy_cust_bill;
47 use FS::cust_pay_pending;
48 use FS::cust_pay_void;
49 use FS::cust_pay_batch;
52 use FS::part_referral;
53 use FS::cust_main_county;
54 use FS::cust_location;
56 use FS::cust_main_exemption;
57 use FS::cust_tax_adjustment;
58 use FS::cust_tax_location;
60 use FS::cust_main_invoice;
62 use FS::prepay_credit;
68 use FS::payment_gateway;
69 use FS::agent_payment_gateway;
71 use FS::cust_main_note;
72 use FS::cust_attachment;
76 # 1 is mostly method/subroutine entry and options
77 # 2 traces progress of some operations
78 # 3 is even more information including possibly sensitive data
80 $me = '[FS::cust_main]';
83 $ignore_expired_card = 0;
84 $ignore_banned_card = 0;
88 @encrypted_fields = ('payinfo', 'paycvv');
89 sub nohistory_fields { ('payinfo', 'paycvv'); }
91 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
93 #ask FS::UID to run this stuff for us later
94 #$FS::UID::callback{'FS::cust_main'} = sub {
95 install_callback FS::UID sub {
97 #yes, need it for stuff below (prolly should be cached)
102 my ( $hashref, $cache ) = @_;
103 if ( exists $hashref->{'pkgnum'} ) {
104 #@{ $self->{'_pkgnum'} } = ();
105 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
106 $self->{'_pkgnum'} = $subcache;
107 #push @{ $self->{'_pkgnum'} },
108 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
114 FS::cust_main - Object methods for cust_main records
120 $record = new FS::cust_main \%hash;
121 $record = new FS::cust_main { 'column' => 'value' };
123 $error = $record->insert;
125 $error = $new_record->replace($old_record);
127 $error = $record->delete;
129 $error = $record->check;
131 @cust_pkg = $record->all_pkgs;
133 @cust_pkg = $record->ncancelled_pkgs;
135 @cust_pkg = $record->suspended_pkgs;
137 $error = $record->bill;
138 $error = $record->bill %options;
139 $error = $record->bill 'time' => $time;
141 $error = $record->collect;
142 $error = $record->collect %options;
143 $error = $record->collect 'invoice_time' => $time,
148 An FS::cust_main object represents a customer. FS::cust_main inherits from
149 FS::Record. The following fields are currently supported:
155 Primary key (assigned automatically for new customers)
159 Agent (see L<FS::agent>)
163 Advertising source (see L<FS::part_referral>)
175 Cocial security number (optional)
199 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
203 Payment Information (See L<FS::payinfo_Mixin> for data format)
207 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
211 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
215 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
219 Start date month (maestro/solo cards only)
223 Start date year (maestro/solo cards only)
227 Issue number (maestro/solo cards only)
231 Name on card or billing name
235 IP address from which payment information was received
239 Tax exempt, empty or `Y'
243 Order taker (see L<FS::access_user>)
249 =item referral_custnum
251 Referring customer number
255 Enable individual CDR spooling, empty or `Y'
259 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
263 Discourage individual CDR printing, empty or `Y'
267 Allow self-service editing of ticket subjects, empty or 'Y'
269 =item calling_list_exempt
271 Do not call, empty or 'Y'
281 Creates a new customer. To add the customer to the database, see L<"insert">.
283 Note that this stores the hash reference, not a distinct copy of the hash it
284 points to. You can ask the object for a copy with the I<hash> method.
288 sub table { 'cust_main'; }
290 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
292 Adds this customer to the database. If there is an error, returns the error,
293 otherwise returns false.
295 Usually the customer's location will not yet exist in the database, and
296 the C<bill_location> and C<ship_location> pseudo-fields must be set to
297 uninserted L<FS::cust_location> objects. These will be inserted and linked
298 (in both directions) to the new customer record. If they're references
299 to the same object, they will become the same location.
301 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
302 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
303 are inserted atomicly, or the transaction is rolled back. Passing an empty
304 hash reference is equivalent to not supplying this parameter. There should be
305 a better explanation of this, but until then, here's an example:
308 tie %hash, 'Tie::RefHash'; #this part is important
310 $cust_pkg => [ $svc_acct ],
313 $cust_main->insert( \%hash );
315 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
316 be set as the invoicing list (see L<"invoicing_list">). Errors return as
317 expected and rollback the entire transaction; it is not necessary to call
318 check_invoicing_list first. The invoicing_list is set after the records in the
319 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
320 invoicing_list destination to the newly-created svc_acct. Here's an example:
322 $cust_main->insert( {}, [ $email, 'POST' ] );
324 Currently available options are: I<depend_jobnum>, I<noexport>,
325 I<tax_exemption> and I<prospectnum>.
327 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
328 on the supplied jobnum (they will not run until the specific job completes).
329 This can be used to defer provisioning until some action completes (such
330 as running the customer's credit card successfully).
332 The I<noexport> option is deprecated. If I<noexport> is set true, no
333 provisioning jobs (exports) are scheduled. (You can schedule them later with
334 the B<reexport> method.)
336 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
337 of tax names and exemption numbers. FS::cust_main_exemption records will be
338 created and inserted.
340 If I<prospectnum> is set, moves contacts and locations from that prospect.
346 my $cust_pkgs = @_ ? shift : {};
347 my $invoicing_list = @_ ? shift : '';
349 warn "$me insert called with options ".
350 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
353 local $SIG{HUP} = 'IGNORE';
354 local $SIG{INT} = 'IGNORE';
355 local $SIG{QUIT} = 'IGNORE';
356 local $SIG{TERM} = 'IGNORE';
357 local $SIG{TSTP} = 'IGNORE';
358 local $SIG{PIPE} = 'IGNORE';
360 my $oldAutoCommit = $FS::UID::AutoCommit;
361 local $FS::UID::AutoCommit = 0;
364 my $prepay_identifier = '';
365 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
367 if ( $self->payby eq 'PREPAY' ) {
369 $self->payby('BILL');
370 $prepay_identifier = $self->payinfo;
373 warn " looking up prepaid card $prepay_identifier\n"
376 my $error = $self->get_prepay( $prepay_identifier,
377 'amount_ref' => \$amount,
378 'seconds_ref' => \$seconds,
379 'upbytes_ref' => \$upbytes,
380 'downbytes_ref' => \$downbytes,
381 'totalbytes_ref' => \$totalbytes,
384 $dbh->rollback if $oldAutoCommit;
385 #return "error applying prepaid card (transaction rolled back): $error";
389 $payby = 'PREP' if $amount;
391 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
394 $self->payby('BILL');
395 $amount = $self->paid;
400 foreach my $l (qw(bill_location ship_location)) {
401 my $loc = delete $self->hashref->{$l};
402 # XXX if we're moving a prospect's locations, do that here
404 if ( !$loc->locationnum ) {
405 # warn the location that we're going to insert it with no custnum
406 $loc->set(custnum_pending => 1);
407 warn " inserting $l\n"
409 my $error = $loc->insert;
411 $dbh->rollback if $oldAutoCommit;
412 my $label = $l eq 'ship_location' ? 'service' : 'billing';
413 return "$error (in $label location)";
416 elsif ( $loc->custnum != $self->custnum or $loc->prospectnum > 0 ) {
417 # this shouldn't happen
418 $dbh->rollback if $oldAutoCommit;
419 return "$l belongs to customer ".$loc->custnum;
421 # else it already belongs to this customer
422 # (happens when ship_location is identical to bill_location)
424 $self->set($l.'num', $loc->locationnum);
426 if ( $self->get($l.'num') eq '' ) {
427 $dbh->rollback if $oldAutoCommit;
432 warn " inserting $self\n"
435 $self->signupdate(time) unless $self->signupdate;
437 $self->auto_agent_custid()
438 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
440 my $error = $self->SUPER::insert;
442 $dbh->rollback if $oldAutoCommit;
443 #return "inserting cust_main record (transaction rolled back): $error";
447 # now set cust_location.custnum
448 foreach my $l (qw(bill_location ship_location)) {
449 warn " setting $l.custnum\n"
452 $loc->set(custnum => $self->custnum);
453 $error ||= $loc->replace;
456 $dbh->rollback if $oldAutoCommit;
457 return "error setting $l custnum: $error";
461 warn " setting invoicing list\n"
464 if ( $invoicing_list ) {
465 $error = $self->check_invoicing_list( $invoicing_list );
467 $dbh->rollback if $oldAutoCommit;
468 #return "checking invoicing_list (transaction rolled back): $error";
471 $self->invoicing_list( $invoicing_list );
474 warn " setting customer tags\n"
477 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
478 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
479 'custnum' => $self->custnum };
480 my $error = $cust_tag->insert;
482 $dbh->rollback if $oldAutoCommit;
487 my $prospectnum = delete $options{'prospectnum'};
488 if ( $prospectnum ) {
490 warn " moving contacts and locations from prospect $prospectnum\n"
494 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
495 unless ( $prospect_main ) {
496 $dbh->rollback if $oldAutoCommit;
497 return "Unknown prospectnum $prospectnum";
499 $prospect_main->custnum($self->custnum);
500 $prospect_main->disabled('Y');
501 my $error = $prospect_main->replace;
503 $dbh->rollback if $oldAutoCommit;
507 my @contact = $prospect_main->contact;
508 my @cust_location = $prospect_main->cust_location;
509 my @qual = $prospect_main->qual;
511 foreach my $r ( @contact, @cust_location, @qual ) {
513 $r->custnum($self->custnum);
514 my $error = $r->replace;
516 $dbh->rollback if $oldAutoCommit;
523 warn " setting cust_main_exemption\n"
526 my $tax_exemption = delete $options{'tax_exemption'};
527 if ( $tax_exemption ) {
529 $tax_exemption = { map { $_ => '' } @$tax_exemption }
530 if ref($tax_exemption) eq 'ARRAY';
532 foreach my $taxname ( keys %$tax_exemption ) {
533 my $cust_main_exemption = new FS::cust_main_exemption {
534 'custnum' => $self->custnum,
535 'taxname' => $taxname,
536 'exempt_number' => $tax_exemption->{$taxname},
538 my $error = $cust_main_exemption->insert;
540 $dbh->rollback if $oldAutoCommit;
541 return "inserting cust_main_exemption (transaction rolled back): $error";
546 if ( $self->can('start_copy_skel') ) {
547 my $error = $self->start_copy_skel;
549 $dbh->rollback if $oldAutoCommit;
554 warn " ordering packages\n"
557 $error = $self->order_pkgs( $cust_pkgs,
559 'seconds_ref' => \$seconds,
560 'upbytes_ref' => \$upbytes,
561 'downbytes_ref' => \$downbytes,
562 'totalbytes_ref' => \$totalbytes,
565 $dbh->rollback if $oldAutoCommit;
570 $dbh->rollback if $oldAutoCommit;
571 return "No svc_acct record to apply pre-paid time";
573 if ( $upbytes || $downbytes || $totalbytes ) {
574 $dbh->rollback if $oldAutoCommit;
575 return "No svc_acct record to apply pre-paid data";
579 warn " inserting initial $payby payment of $amount\n"
581 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
583 $dbh->rollback if $oldAutoCommit;
584 return "inserting payment (transaction rolled back): $error";
588 unless ( $import || $skip_fuzzyfiles ) {
589 warn " queueing fuzzyfiles update\n"
591 $error = $self->queue_fuzzyfiles_update;
593 $dbh->rollback if $oldAutoCommit;
594 return "updating fuzzy search cache: $error";
598 # FS::geocode_Mixin::after_insert or something?
599 if ( $conf->config('tax_district_method') and !$import ) {
600 # if anything non-empty, try to look it up
601 my $queue = new FS::queue {
602 'job' => 'FS::geocode_Mixin::process_district_update',
603 'custnum' => $self->custnum,
605 my $error = $queue->insert( ref($self), $self->custnum );
607 $dbh->rollback if $oldAutoCommit;
608 return "queueing tax district update: $error";
613 warn " exporting\n" if $DEBUG > 1;
615 my $export_args = $options{'export_args'} || [];
618 map qsearch( 'part_export', {exportnum=>$_} ),
619 $conf->config('cust_main-exports'); #, $agentnum
621 foreach my $part_export ( @part_export ) {
622 my $error = $part_export->export_insert($self, @$export_args);
624 $dbh->rollback if $oldAutoCommit;
625 return "exporting to ". $part_export->exporttype.
626 " (transaction rolled back): $error";
630 #foreach my $depend_jobnum ( @$depend_jobnums ) {
631 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
633 # foreach my $jobnum ( @jobnums ) {
634 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
635 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
637 # my $error = $queue->depend_insert($depend_jobnum);
639 # $dbh->rollback if $oldAutoCommit;
640 # return "error queuing job dependancy: $error";
647 #if ( exists $options{'jobnums'} ) {
648 # push @{ $options{'jobnums'} }, @jobnums;
651 warn " insert complete; committing transaction\n"
654 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
659 use File::CounterFile;
660 sub auto_agent_custid {
663 my $format = $conf->config('cust_main-auto_agent_custid');
665 if ( $format eq '1YMMXXXXXXXX' ) {
667 my $counter = new File::CounterFile 'cust_main.agent_custid';
670 my $ym = 100000000000 + time2str('%y%m00000000', time);
671 if ( $ym > $counter->value ) {
672 $counter->{'value'} = $agent_custid = $ym;
673 $counter->{'updated'} = 1;
675 $agent_custid = $counter->inc;
681 die "Unknown cust_main-auto_agent_custid format: $format";
684 $self->agent_custid($agent_custid);
688 =item PACKAGE METHODS
690 Documentation on customer package methods has been moved to
691 L<FS::cust_main::Packages>.
693 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
695 Recharges this (existing) customer with the specified prepaid card (see
696 L<FS::prepay_credit>), specified either by I<identifier> or as an
697 FS::prepay_credit object. If there is an error, returns the error, otherwise
700 Optionally, five scalar references can be passed as well. They will have their
701 values filled in with the amount, number of seconds, and number of upload,
702 download, and total bytes applied by this prepaid card.
706 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
707 #the only place that uses these args
708 sub recharge_prepay {
709 my( $self, $prepay_credit, $amountref, $secondsref,
710 $upbytesref, $downbytesref, $totalbytesref ) = @_;
712 local $SIG{HUP} = 'IGNORE';
713 local $SIG{INT} = 'IGNORE';
714 local $SIG{QUIT} = 'IGNORE';
715 local $SIG{TERM} = 'IGNORE';
716 local $SIG{TSTP} = 'IGNORE';
717 local $SIG{PIPE} = 'IGNORE';
719 my $oldAutoCommit = $FS::UID::AutoCommit;
720 local $FS::UID::AutoCommit = 0;
723 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
725 my $error = $self->get_prepay( $prepay_credit,
726 'amount_ref' => \$amount,
727 'seconds_ref' => \$seconds,
728 'upbytes_ref' => \$upbytes,
729 'downbytes_ref' => \$downbytes,
730 'totalbytes_ref' => \$totalbytes,
732 || $self->increment_seconds($seconds)
733 || $self->increment_upbytes($upbytes)
734 || $self->increment_downbytes($downbytes)
735 || $self->increment_totalbytes($totalbytes)
736 || $self->insert_cust_pay_prepay( $amount,
738 ? $prepay_credit->identifier
743 $dbh->rollback if $oldAutoCommit;
747 if ( defined($amountref) ) { $$amountref = $amount; }
748 if ( defined($secondsref) ) { $$secondsref = $seconds; }
749 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
750 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
751 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
753 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
758 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
760 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
761 specified either by I<identifier> or as an FS::prepay_credit object.
763 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
764 incremented by the values of the prepaid card.
766 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
767 check or set this customer's I<agentnum>.
769 If there is an error, returns the error, otherwise returns false.
775 my( $self, $prepay_credit, %opt ) = @_;
777 local $SIG{HUP} = 'IGNORE';
778 local $SIG{INT} = 'IGNORE';
779 local $SIG{QUIT} = 'IGNORE';
780 local $SIG{TERM} = 'IGNORE';
781 local $SIG{TSTP} = 'IGNORE';
782 local $SIG{PIPE} = 'IGNORE';
784 my $oldAutoCommit = $FS::UID::AutoCommit;
785 local $FS::UID::AutoCommit = 0;
788 unless ( ref($prepay_credit) ) {
790 my $identifier = $prepay_credit;
792 $prepay_credit = qsearchs(
794 { 'identifier' => $identifier },
799 unless ( $prepay_credit ) {
800 $dbh->rollback if $oldAutoCommit;
801 return "Invalid prepaid card: ". $identifier;
806 if ( $prepay_credit->agentnum ) {
807 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
808 $dbh->rollback if $oldAutoCommit;
809 return "prepaid card not valid for agent ". $self->agentnum;
811 $self->agentnum($prepay_credit->agentnum);
814 my $error = $prepay_credit->delete;
816 $dbh->rollback if $oldAutoCommit;
817 return "removing prepay_credit (transaction rolled back): $error";
820 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
821 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
823 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
828 =item increment_upbytes SECONDS
830 Updates this customer's single or primary account (see L<FS::svc_acct>) by
831 the specified number of upbytes. If there is an error, returns the error,
832 otherwise returns false.
836 sub increment_upbytes {
837 _increment_column( shift, 'upbytes', @_);
840 =item increment_downbytes SECONDS
842 Updates this customer's single or primary account (see L<FS::svc_acct>) by
843 the specified number of downbytes. If there is an error, returns the error,
844 otherwise returns false.
848 sub increment_downbytes {
849 _increment_column( shift, 'downbytes', @_);
852 =item increment_totalbytes SECONDS
854 Updates this customer's single or primary account (see L<FS::svc_acct>) by
855 the specified number of totalbytes. If there is an error, returns the error,
856 otherwise returns false.
860 sub increment_totalbytes {
861 _increment_column( shift, 'totalbytes', @_);
864 =item increment_seconds SECONDS
866 Updates this customer's single or primary account (see L<FS::svc_acct>) by
867 the specified number of seconds. If there is an error, returns the error,
868 otherwise returns false.
872 sub increment_seconds {
873 _increment_column( shift, 'seconds', @_);
876 =item _increment_column AMOUNT
878 Updates this customer's single or primary account (see L<FS::svc_acct>) by
879 the specified number of seconds or bytes. If there is an error, returns
880 the error, otherwise returns false.
884 sub _increment_column {
885 my( $self, $column, $amount ) = @_;
886 warn "$me increment_column called: $column, $amount\n"
889 return '' unless $amount;
891 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
892 $self->ncancelled_pkgs;
895 return 'No packages with primary or single services found'.
896 ' to apply pre-paid time';
897 } elsif ( scalar(@cust_pkg) > 1 ) {
898 #maybe have a way to specify the package/account?
899 return 'Multiple packages found to apply pre-paid time';
902 my $cust_pkg = $cust_pkg[0];
903 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
907 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
910 return 'No account found to apply pre-paid time';
911 } elsif ( scalar(@cust_svc) > 1 ) {
912 return 'Multiple accounts found to apply pre-paid time';
915 my $svc_acct = $cust_svc[0]->svc_x;
916 warn " found service svcnum ". $svc_acct->pkgnum.
917 ' ('. $svc_acct->email. ")\n"
920 $column = "increment_$column";
921 $svc_acct->$column($amount);
925 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
927 Inserts a prepayment in the specified amount for this customer. An optional
928 second argument can specify the prepayment identifier for tracking purposes.
929 If there is an error, returns the error, otherwise returns false.
933 sub insert_cust_pay_prepay {
934 shift->insert_cust_pay('PREP', @_);
937 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
939 Inserts a cash payment in the specified amount for this customer. An optional
940 second argument can specify the payment identifier for tracking purposes.
941 If there is an error, returns the error, otherwise returns false.
945 sub insert_cust_pay_cash {
946 shift->insert_cust_pay('CASH', @_);
949 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
951 Inserts a Western Union payment in the specified amount for this customer. An
952 optional second argument can specify the prepayment identifier for tracking
953 purposes. If there is an error, returns the error, otherwise returns false.
957 sub insert_cust_pay_west {
958 shift->insert_cust_pay('WEST', @_);
961 sub insert_cust_pay {
962 my( $self, $payby, $amount ) = splice(@_, 0, 3);
963 my $payinfo = scalar(@_) ? shift : '';
965 my $cust_pay = new FS::cust_pay {
966 'custnum' => $self->custnum,
967 'paid' => sprintf('%.2f', $amount),
968 #'_date' => #date the prepaid card was purchased???
970 'payinfo' => $payinfo,
978 This method is deprecated. See the I<depend_jobnum> option to the insert and
979 order_pkgs methods for a better way to defer provisioning.
981 Re-schedules all exports by calling the B<reexport> method of all associated
982 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
983 otherwise returns false.
990 carp "WARNING: FS::cust_main::reexport is deprectated; ".
991 "use the depend_jobnum option to insert or order_pkgs to delay export";
993 local $SIG{HUP} = 'IGNORE';
994 local $SIG{INT} = 'IGNORE';
995 local $SIG{QUIT} = 'IGNORE';
996 local $SIG{TERM} = 'IGNORE';
997 local $SIG{TSTP} = 'IGNORE';
998 local $SIG{PIPE} = 'IGNORE';
1000 my $oldAutoCommit = $FS::UID::AutoCommit;
1001 local $FS::UID::AutoCommit = 0;
1004 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1005 my $error = $cust_pkg->reexport;
1007 $dbh->rollback if $oldAutoCommit;
1012 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1017 =item delete [ OPTION => VALUE ... ]
1019 This deletes the customer. If there is an error, returns the error, otherwise
1022 This will completely remove all traces of the customer record. This is not
1023 what you want when a customer cancels service; for that, cancel all of the
1024 customer's packages (see L</cancel>).
1026 If the customer has any uncancelled packages, you need to pass a new (valid)
1027 customer number for those packages to be transferred to, as the "new_customer"
1028 option. Cancelled packages will be deleted. Did I mention that this is NOT
1029 what you want when a customer cancels service and that you really should be
1030 looking at L<FS::cust_pkg/cancel>?
1032 You can't delete a customer with invoices (see L<FS::cust_bill>),
1033 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1034 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1035 set the "delete_financials" option to a true value.
1040 my( $self, %opt ) = @_;
1042 local $SIG{HUP} = 'IGNORE';
1043 local $SIG{INT} = 'IGNORE';
1044 local $SIG{QUIT} = 'IGNORE';
1045 local $SIG{TERM} = 'IGNORE';
1046 local $SIG{TSTP} = 'IGNORE';
1047 local $SIG{PIPE} = 'IGNORE';
1049 my $oldAutoCommit = $FS::UID::AutoCommit;
1050 local $FS::UID::AutoCommit = 0;
1053 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1054 $dbh->rollback if $oldAutoCommit;
1055 return "Can't delete a master agent customer";
1058 #use FS::access_user
1059 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1060 $dbh->rollback if $oldAutoCommit;
1061 return "Can't delete a master employee customer";
1064 tie my %financial_tables, 'Tie::IxHash',
1065 'cust_bill' => 'invoices',
1066 'cust_statement' => 'statements',
1067 'cust_credit' => 'credits',
1068 'cust_pay' => 'payments',
1069 'cust_refund' => 'refunds',
1072 foreach my $table ( keys %financial_tables ) {
1074 my @records = $self->$table();
1076 if ( @records && ! $opt{'delete_financials'} ) {
1077 $dbh->rollback if $oldAutoCommit;
1078 return "Can't delete a customer with ". $financial_tables{$table};
1081 foreach my $record ( @records ) {
1082 my $error = $record->delete;
1084 $dbh->rollback if $oldAutoCommit;
1085 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1091 my @cust_pkg = $self->ncancelled_pkgs;
1093 my $new_custnum = $opt{'new_custnum'};
1094 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1095 $dbh->rollback if $oldAutoCommit;
1096 return "Invalid new customer number: $new_custnum";
1098 foreach my $cust_pkg ( @cust_pkg ) {
1099 my %hash = $cust_pkg->hash;
1100 $hash{'custnum'} = $new_custnum;
1101 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1102 my $error = $new_cust_pkg->replace($cust_pkg,
1103 options => { $cust_pkg->options },
1106 $dbh->rollback if $oldAutoCommit;
1111 my @cancelled_cust_pkg = $self->all_pkgs;
1112 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1113 my $error = $cust_pkg->delete;
1115 $dbh->rollback if $oldAutoCommit;
1120 #cust_tax_adjustment in financials?
1121 #cust_pay_pending? ouch
1123 foreach my $table (qw(
1124 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1125 cust_location cust_main_note cust_tax_adjustment
1126 cust_pay_void cust_pay_batch queue cust_tax_exempt
1128 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1129 my $error = $record->delete;
1131 $dbh->rollback if $oldAutoCommit;
1137 my $sth = $dbh->prepare(
1138 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1140 my $errstr = $dbh->errstr;
1141 $dbh->rollback if $oldAutoCommit;
1144 $sth->execute($self->custnum) or do {
1145 my $errstr = $sth->errstr;
1146 $dbh->rollback if $oldAutoCommit;
1152 my $ticket_dbh = '';
1153 if ($conf->config('ticket_system') eq 'RT_Internal') {
1155 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1156 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1157 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1158 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1161 if ( $ticket_dbh ) {
1163 my $ticket_sth = $ticket_dbh->prepare(
1164 'DELETE FROM Links WHERE Target = ?'
1166 my $errstr = $ticket_dbh->errstr;
1167 $dbh->rollback if $oldAutoCommit;
1170 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1172 my $errstr = $ticket_sth->errstr;
1173 $dbh->rollback if $oldAutoCommit;
1177 #check and see if the customer is the only link on the ticket, and
1178 #if so, set the ticket to deleted status in RT?
1179 #maybe someday, for now this will at least fix tickets not displaying
1183 #delete the customer record
1185 my $error = $self->SUPER::delete;
1187 $dbh->rollback if $oldAutoCommit;
1191 # cust_main exports!
1193 #my $export_args = $options{'export_args'} || [];
1196 map qsearch( 'part_export', {exportnum=>$_} ),
1197 $conf->config('cust_main-exports'); #, $agentnum
1199 foreach my $part_export ( @part_export ) {
1200 my $error = $part_export->export_delete( $self ); #, @$export_args);
1202 $dbh->rollback if $oldAutoCommit;
1203 return "exporting to ". $part_export->exporttype.
1204 " (transaction rolled back): $error";
1208 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1213 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1215 This merges this customer into the provided new custnum, and then deletes the
1216 customer. If there is an error, returns the error, otherwise returns false.
1218 The source customer's name, company name, phone numbers, agent,
1219 referring customer, customer class, advertising source, order taker, and
1220 billing information (except balance) are discarded.
1222 All packages are moved to the target customer. Packages with package locations
1223 are preserved. Packages without package locations are moved to a new package
1224 location with the source customer's service/shipping address.
1226 All invoices, statements, payments, credits and refunds are moved to the target
1227 customer. The source customer's balance is added to the target customer.
1229 All notes, attachments, tickets and customer tags are moved to the target
1232 Change history is not currently moved.
1237 my( $self, $new_custnum, %opt ) = @_;
1239 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1241 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1242 return "Invalid new customer number: $new_custnum";
1245 local $SIG{HUP} = 'IGNORE';
1246 local $SIG{INT} = 'IGNORE';
1247 local $SIG{QUIT} = 'IGNORE';
1248 local $SIG{TERM} = 'IGNORE';
1249 local $SIG{TSTP} = 'IGNORE';
1250 local $SIG{PIPE} = 'IGNORE';
1252 my $oldAutoCommit = $FS::UID::AutoCommit;
1253 local $FS::UID::AutoCommit = 0;
1256 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1257 $dbh->rollback if $oldAutoCommit;
1258 return "Can't merge a master agent customer";
1261 #use FS::access_user
1262 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1263 $dbh->rollback if $oldAutoCommit;
1264 return "Can't merge a master employee customer";
1267 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1268 'status' => { op=>'!=', value=>'done' },
1272 $dbh->rollback if $oldAutoCommit;
1273 return "Can't merge a customer with pending payments";
1276 tie my %financial_tables, 'Tie::IxHash',
1277 'cust_bill' => 'invoices',
1278 'cust_statement' => 'statements',
1279 'cust_credit' => 'credits',
1280 'cust_pay' => 'payments',
1281 'cust_pay_void' => 'voided payments',
1282 'cust_refund' => 'refunds',
1285 foreach my $table ( keys %financial_tables ) {
1287 my @records = $self->$table();
1289 foreach my $record ( @records ) {
1290 $record->custnum($new_custnum);
1291 my $error = $record->replace;
1293 $dbh->rollback if $oldAutoCommit;
1294 return "Error merging ". $financial_tables{$table}. ": $error\n";
1300 my $name = $self->ship_name; #?
1302 my $locationnum = '';
1303 foreach my $cust_pkg ( $self->all_pkgs ) {
1304 $cust_pkg->custnum($new_custnum);
1306 unless ( $cust_pkg->locationnum ) {
1307 unless ( $locationnum ) {
1308 my $cust_location = new FS::cust_location {
1309 $self->location_hash,
1310 'custnum' => $new_custnum,
1312 my $error = $cust_location->insert;
1314 $dbh->rollback if $oldAutoCommit;
1317 $locationnum = $cust_location->locationnum;
1319 $cust_pkg->locationnum($locationnum);
1322 my $error = $cust_pkg->replace;
1324 $dbh->rollback if $oldAutoCommit;
1328 # add customer (ship) name to svc_phone.phone_name if blank
1329 my @cust_svc = $cust_pkg->cust_svc;
1330 foreach my $cust_svc (@cust_svc) {
1331 my($label, $value, $svcdb) = $cust_svc->label;
1332 next unless $svcdb eq 'svc_phone';
1333 my $svc_phone = $cust_svc->svc_x;
1334 next if $svc_phone->phone_name;
1335 $svc_phone->phone_name($name);
1336 my $error = $svc_phone->replace;
1338 $dbh->rollback if $oldAutoCommit;
1346 # cust_tax_exempt (texas tax exemptions)
1347 # cust_recon (some sort of not-well understood thing for OnPac)
1349 #these are moved over
1350 foreach my $table (qw(
1351 cust_tag cust_location contact cust_attachment cust_main_note
1352 cust_tax_adjustment cust_pay_batch queue
1354 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1355 $record->custnum($new_custnum);
1356 my $error = $record->replace;
1358 $dbh->rollback if $oldAutoCommit;
1364 #these aren't preserved
1365 foreach my $table (qw(
1366 cust_main_exemption cust_main_invoice
1368 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1369 my $error = $record->delete;
1371 $dbh->rollback if $oldAutoCommit;
1378 my $sth = $dbh->prepare(
1379 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1381 my $errstr = $dbh->errstr;
1382 $dbh->rollback if $oldAutoCommit;
1385 $sth->execute($new_custnum, $self->custnum) or do {
1386 my $errstr = $sth->errstr;
1387 $dbh->rollback if $oldAutoCommit;
1393 my $ticket_dbh = '';
1394 if ($conf->config('ticket_system') eq 'RT_Internal') {
1396 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1397 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1398 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1399 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1402 if ( $ticket_dbh ) {
1404 my $ticket_sth = $ticket_dbh->prepare(
1405 'UPDATE Links SET Target = ? WHERE Target = ?'
1407 my $errstr = $ticket_dbh->errstr;
1408 $dbh->rollback if $oldAutoCommit;
1411 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1412 'freeside://freeside/cust_main/'.$self->custnum)
1414 my $errstr = $ticket_sth->errstr;
1415 $dbh->rollback if $oldAutoCommit;
1421 #delete the customer record
1423 my $error = $self->delete;
1425 $dbh->rollback if $oldAutoCommit;
1429 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1434 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1436 Replaces the OLD_RECORD with this one in the database. If there is an error,
1437 returns the error, otherwise returns false.
1439 To change the customer's address, set the pseudo-fields C<bill_location> and
1440 C<ship_location>. The address will still only change if at least one of the
1441 address fields differs from the existing values.
1443 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1444 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1445 expected and rollback the entire transaction; it is not necessary to call
1446 check_invoicing_list first. Here's an example:
1448 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1450 Currently available options are: I<tax_exemption>.
1452 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1453 of tax names and exemption numbers. FS::cust_main_exemption records will be
1454 deleted and inserted as appropriate.
1461 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1463 : $self->replace_old;
1467 warn "$me replace called\n"
1470 my $curuser = $FS::CurrentUser::CurrentUser;
1471 if ( $self->payby eq 'COMP'
1472 && $self->payby ne $old->payby
1473 && ! $curuser->access_right('Complimentary customer')
1476 return "You are not permitted to create complimentary accounts.";
1479 # should be unnecessary--geocode will default to null on new locations
1480 #if ( $old->get('geocode') && $old->get('geocode') eq $self->get('geocode')
1481 # && $conf->exists('enable_taxproducts')
1484 # my $pre = ($conf->exists('tax-ship_address') && $self->ship_zip)
1486 # $self->set('geocode', '')
1487 # if $old->get($pre.'zip') ne $self->get($pre.'zip')
1488 # && length($self->get($pre.'zip')) >= 10;
1491 # set_coord/coord_auto stuff is now handled by cust_location
1493 local($ignore_expired_card) = 1
1494 if $old->payby =~ /^(CARD|DCRD)$/
1495 && $self->payby =~ /^(CARD|DCRD)$/
1496 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1498 local($ignore_banned_card) = 1
1499 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1500 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1501 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1503 return "Invoicing locale is required"
1506 && $conf->exists('cust_main-require_locale');
1508 local $SIG{HUP} = 'IGNORE';
1509 local $SIG{INT} = 'IGNORE';
1510 local $SIG{QUIT} = 'IGNORE';
1511 local $SIG{TERM} = 'IGNORE';
1512 local $SIG{TSTP} = 'IGNORE';
1513 local $SIG{PIPE} = 'IGNORE';
1515 my $oldAutoCommit = $FS::UID::AutoCommit;
1516 local $FS::UID::AutoCommit = 0;
1519 for my $l (qw(bill_location ship_location)) {
1520 my $old_loc = $old->$l;
1521 my $new_loc = $self->$l;
1523 if ( !$new_loc->locationnum ) {
1525 # If the new location is all empty fields, or if it's identical to
1526 # the old location in all fields, don't replace.
1527 my @nonempty = grep { $new_loc->$_ } $self->location_fields;
1529 my @unlike = grep { $new_loc->$_ ne $old_loc->$_ } $self->location_fields;
1531 if ( @unlike or $old_loc->disabled ) {
1532 warn " changed $l fields: ".join(',',@unlike)."\n"
1534 $new_loc->set(custnum => $self->custnum);
1536 # insert it--the old location will be disabled later
1537 my $error = $new_loc->insert;
1539 $dbh->rollback if $oldAutoCommit;
1544 # no fields have changed and $old_loc isn't disabled, so don't change it
1549 elsif ( $new_loc->custnum ne $self->custnum or $new_loc->prospectnum ) {
1550 $dbh->rollback if $oldAutoCommit;
1551 return "$l belongs to customer ".$new_loc->custnum;
1553 # else the new location belongs to this customer so we're good
1555 # set the foo_locationnum now that we have one.
1556 $self->set($l.'num', $new_loc->locationnum);
1560 my $error = $self->SUPER::replace($old);
1563 $dbh->rollback if $oldAutoCommit;
1567 # now move packages to the new service location
1568 $self->set('ship_location', ''); #flush cache
1569 if ( $old->ship_locationnum and # should only be null during upgrade...
1570 $old->ship_locationnum != $self->ship_locationnum ) {
1571 $error = $old->ship_location->move_to($self->ship_location);
1573 $dbh->rollback if $oldAutoCommit;
1577 # don't move packages based on the billing location, but
1578 # disable it if it's no longer in use
1579 if ( $old->bill_locationnum and
1580 $old->bill_locationnum != $self->bill_locationnum ) {
1581 $error = $old->bill_location->disable_if_unused;
1583 $dbh->rollback if $oldAutoCommit;
1588 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1589 my $invoicing_list = shift @param;
1590 $error = $self->check_invoicing_list( $invoicing_list );
1592 $dbh->rollback if $oldAutoCommit;
1595 $self->invoicing_list( $invoicing_list );
1598 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1600 #this could be more efficient than deleting and re-inserting, if it matters
1601 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1602 my $error = $cust_tag->delete;
1604 $dbh->rollback if $oldAutoCommit;
1608 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1609 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1610 'custnum' => $self->custnum };
1611 my $error = $cust_tag->insert;
1613 $dbh->rollback if $oldAutoCommit;
1620 my %options = @param;
1622 my $tax_exemption = delete $options{'tax_exemption'};
1623 if ( $tax_exemption ) {
1625 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1626 if ref($tax_exemption) eq 'ARRAY';
1628 my %cust_main_exemption =
1629 map { $_->taxname => $_ }
1630 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1632 foreach my $taxname ( keys %$tax_exemption ) {
1634 if ( $cust_main_exemption{$taxname} &&
1635 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1638 delete $cust_main_exemption{$taxname};
1642 my $cust_main_exemption = new FS::cust_main_exemption {
1643 'custnum' => $self->custnum,
1644 'taxname' => $taxname,
1645 'exempt_number' => $tax_exemption->{$taxname},
1647 my $error = $cust_main_exemption->insert;
1649 $dbh->rollback if $oldAutoCommit;
1650 return "inserting cust_main_exemption (transaction rolled back): $error";
1654 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1655 my $error = $cust_main_exemption->delete;
1657 $dbh->rollback if $oldAutoCommit;
1658 return "deleting cust_main_exemption (transaction rolled back): $error";
1664 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1665 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1666 && $self->get('payinfo') !~ /^99\d{14}$/
1668 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1673 # card/check/lec info has changed, want to retry realtime_ invoice events
1674 my $error = $self->retry_realtime;
1676 $dbh->rollback if $oldAutoCommit;
1681 unless ( $import || $skip_fuzzyfiles ) {
1682 $error = $self->queue_fuzzyfiles_update;
1684 $dbh->rollback if $oldAutoCommit;
1685 return "updating fuzzy search cache: $error";
1689 # tax district update in cust_location
1691 # cust_main exports!
1693 my $export_args = $options{'export_args'} || [];
1696 map qsearch( 'part_export', {exportnum=>$_} ),
1697 $conf->config('cust_main-exports'); #, $agentnum
1699 foreach my $part_export ( @part_export ) {
1700 my $error = $part_export->export_replace( $self, $old, @$export_args);
1702 $dbh->rollback if $oldAutoCommit;
1703 return "exporting to ". $part_export->exporttype.
1704 " (transaction rolled back): $error";
1708 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1713 =item queue_fuzzyfiles_update
1715 Used by insert & replace to update the fuzzy search cache
1719 use FS::cust_main::Search;
1720 sub queue_fuzzyfiles_update {
1723 local $SIG{HUP} = 'IGNORE';
1724 local $SIG{INT} = 'IGNORE';
1725 local $SIG{QUIT} = 'IGNORE';
1726 local $SIG{TERM} = 'IGNORE';
1727 local $SIG{TSTP} = 'IGNORE';
1728 local $SIG{PIPE} = 'IGNORE';
1730 my $oldAutoCommit = $FS::UID::AutoCommit;
1731 local $FS::UID::AutoCommit = 0;
1734 my @locations = $self->bill_location;
1735 push @locations, $self->ship_location if $self->has_ship_address;
1736 foreach my $location (@locations) {
1737 my $queue = new FS::queue {
1738 'job' => 'FS::cust_main::Search::append_fuzzyfiles'
1740 my @args = map $location->get($_), @FS::cust_main::Search::fuzzyfields;
1741 my $error = $queue->insert( @args );
1743 $dbh->rollback if $oldAutoCommit;
1744 return "queueing job (transaction rolled back): $error";
1748 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1755 Checks all fields to make sure this is a valid customer record. If there is
1756 an error, returns the error, otherwise returns false. Called by the insert
1757 and replace methods.
1764 warn "$me check BEFORE: \n". $self->_dump
1768 $self->ut_numbern('custnum')
1769 || $self->ut_number('agentnum')
1770 || $self->ut_textn('agent_custid')
1771 || $self->ut_number('refnum')
1772 || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
1773 || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
1774 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1775 || $self->ut_textn('custbatch')
1776 || $self->ut_name('last')
1777 || $self->ut_name('first')
1778 || $self->ut_snumbern('birthdate')
1779 || $self->ut_snumbern('signupdate')
1780 || $self->ut_textn('company')
1781 || $self->ut_anything('comments')
1782 || $self->ut_numbern('referral_custnum')
1783 || $self->ut_textn('stateid')
1784 || $self->ut_textn('stateid_state')
1785 || $self->ut_textn('invoice_terms')
1786 || $self->ut_alphan('geocode')
1787 || $self->ut_alphan('district')
1788 || $self->ut_floatn('cdr_termination_percentage')
1789 || $self->ut_floatn('credit_limit')
1790 || $self->ut_numbern('billday')
1791 || $self->ut_enum('edit_subject', [ '', 'Y' ] )
1792 || $self->ut_enum('calling_list_exempt', [ '', 'Y' ] )
1793 || $self->ut_enum('invoice_noemail', [ '', 'Y' ] )
1794 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1797 #barf. need message catalogs. i18n. etc.
1798 $error .= "Please select an advertising source."
1799 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1800 return $error if $error;
1802 return "Unknown agent"
1803 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1805 return "Unknown refnum"
1806 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1808 return "Unknown referring custnum: ". $self->referral_custnum
1809 unless ! $self->referral_custnum
1810 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1812 if ( $self->ss eq '' ) {
1817 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1818 or return "Illegal social security number: ". $self->ss;
1819 $self->ss("$1-$2-$3");
1822 # cust_main_county verification now handled by cust_location check
1825 $self->ut_phonen('daytime', $self->country)
1826 || $self->ut_phonen('night', $self->country)
1827 || $self->ut_phonen('fax', $self->country)
1828 || $self->ut_phonen('mobile', $self->country)
1830 return $error if $error;
1832 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1834 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1837 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1839 : FS::Msgcat::_gettext('daytime');
1840 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1842 : FS::Msgcat::_gettext('night');
1844 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1846 : FS::Msgcat::_gettext('mobile');
1848 return "$daytime_label, $night_label or $mobile_label is required"
1852 #ship_ fields are gone
1854 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1855 # or return "Illegal payby: ". $self->payby;
1857 FS::payby->can_payby($self->table, $self->payby)
1858 or return "Illegal payby: ". $self->payby;
1860 $error = $self->ut_numbern('paystart_month')
1861 || $self->ut_numbern('paystart_year')
1862 || $self->ut_numbern('payissue')
1863 || $self->ut_textn('paytype')
1865 return $error if $error;
1867 if ( $self->payip eq '' ) {
1870 $error = $self->ut_ip('payip');
1871 return $error if $error;
1874 # If it is encrypted and the private key is not availaible then we can't
1875 # check the credit card.
1876 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1878 # Need some kind of global flag to accept invalid cards, for testing
1880 if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1882 my $payinfo = $self->payinfo;
1883 $payinfo =~ s/\D//g;
1884 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1885 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1887 $self->payinfo($payinfo);
1889 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1891 return gettext('unknown_card_type')
1892 if $self->payinfo !~ /^99\d{14}$/ #token
1893 && cardtype($self->payinfo) eq "Unknown";
1895 unless ( $ignore_banned_card ) {
1896 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1898 if ( $ban->bantype eq 'warn' ) {
1899 #or others depending on value of $ban->reason ?
1900 return '_duplicate_card'.
1901 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1902 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1903 ' (ban# '. $ban->bannum. ')'
1904 unless $self->override_ban_warn;
1906 return 'Banned credit card: banned on '.
1907 time2str('%a %h %o at %r', $ban->_date).
1908 ' by '. $ban->otaker.
1909 ' (ban# '. $ban->bannum. ')';
1914 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1915 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1916 $self->paycvv =~ /^(\d{4})$/
1917 or return "CVV2 (CID) for American Express cards is four digits.";
1920 $self->paycvv =~ /^(\d{3})$/
1921 or return "CVV2 (CVC2/CID) is three digits.";
1928 my $cardtype = cardtype($payinfo);
1929 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1931 return "Start date or issue number is required for $cardtype cards"
1932 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1934 return "Start month must be between 1 and 12"
1935 if $self->paystart_month
1936 and $self->paystart_month < 1 || $self->paystart_month > 12;
1938 return "Start year must be 1990 or later"
1939 if $self->paystart_year
1940 and $self->paystart_year < 1990;
1942 return "Issue number must be beween 1 and 99"
1944 and $self->payissue < 1 || $self->payissue > 99;
1947 $self->paystart_month('');
1948 $self->paystart_year('');
1949 $self->payissue('');
1952 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1954 my $payinfo = $self->payinfo;
1955 $payinfo =~ s/[^\d\@\.]//g;
1956 if ( $conf->config('echeck-country') eq 'CA' ) {
1957 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1958 or return 'invalid echeck account@branch.bank';
1959 $payinfo = "$1\@$2.$3";
1960 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1961 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1962 $payinfo = "$1\@$2";
1964 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1965 $payinfo = "$1\@$2";
1967 $self->payinfo($payinfo);
1970 unless ( $ignore_banned_card ) {
1971 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1973 if ( $ban->bantype eq 'warn' ) {
1974 #or others depending on value of $ban->reason ?
1975 return '_duplicate_ach' unless $self->override_ban_warn;
1977 return 'Banned ACH account: banned on '.
1978 time2str('%a %h %o at %r', $ban->_date).
1979 ' by '. $ban->otaker.
1980 ' (ban# '. $ban->bannum. ')';
1985 } elsif ( $self->payby eq 'LECB' ) {
1987 my $payinfo = $self->payinfo;
1988 $payinfo =~ s/\D//g;
1989 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1991 $self->payinfo($payinfo);
1994 } elsif ( $self->payby eq 'BILL' ) {
1996 $error = $self->ut_textn('payinfo');
1997 return "Illegal P.O. number: ". $self->payinfo if $error;
2000 } elsif ( $self->payby eq 'COMP' ) {
2002 my $curuser = $FS::CurrentUser::CurrentUser;
2003 if ( ! $self->custnum
2004 && ! $curuser->access_right('Complimentary customer')
2007 return "You are not permitted to create complimentary accounts."
2010 $error = $self->ut_textn('payinfo');
2011 return "Illegal comp account issuer: ". $self->payinfo if $error;
2014 } elsif ( $self->payby eq 'PREPAY' ) {
2016 my $payinfo = $self->payinfo;
2017 $payinfo =~ s/\W//g; #anything else would just confuse things
2018 $self->payinfo($payinfo);
2019 $error = $self->ut_alpha('payinfo');
2020 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2021 return "Unknown prepayment identifier"
2022 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2027 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2028 return "Expiration date required"
2029 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2033 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2034 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2035 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2036 ( $m, $y ) = ( $2, "19$1" );
2037 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2038 ( $m, $y ) = ( $3, "20$2" );
2040 return "Illegal expiration date: ". $self->paydate;
2042 $m = sprintf('%02d',$m);
2043 $self->paydate("$y-$m-01");
2044 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2045 return gettext('expired_card')
2047 && !$ignore_expired_card
2048 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2051 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2052 ( ! $conf->exists('require_cardname')
2053 || $self->payby !~ /^(CARD|DCRD)$/ )
2055 $self->payname( $self->first. " ". $self->getfield('last') );
2057 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2058 or return gettext('illegal_name'). " payname: ". $self->payname;
2062 return "Please select an invoicing locale"
2065 && $conf->exists('cust_main-require_locale');
2067 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2068 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2072 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2074 warn "$me check AFTER: \n". $self->_dump
2077 $self->SUPER::check;
2082 Returns a list of fields which have ship_ duplicates.
2087 qw( last first company
2088 address1 address2 city county state zip country
2090 daytime night fax mobile
2094 =item has_ship_address
2096 Returns true if this customer record has a separate shipping address.
2100 sub has_ship_address {
2102 $self->bill_locationnum != $self->ship_locationnum;
2107 Returns a list of key/value pairs, with the following keys: address1,
2108 adddress2, city, county, state, zip, country, district, and geocode. The
2109 shipping address is used if present.
2115 $self->ship_location->location_hash;
2120 Returns all locations (see L<FS::cust_location>) for this customer.
2126 qsearch('cust_location', { 'custnum' => $self->custnum } );
2131 Returns all contacts (see L<FS::contact>) for this customer.
2135 #already used :/ sub contact {
2138 qsearch('contact', { 'custnum' => $self->custnum } );
2143 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2144 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2145 on success or a list of errors.
2151 grep { $_->unsuspend } $self->suspended_pkgs;
2156 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2158 Returns a list: an empty list on success or a list of errors.
2164 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2167 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2169 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2170 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2171 of a list of pkgparts; the hashref has the following keys:
2175 =item pkgparts - listref of pkgparts
2177 =item (other options are passed to the suspend method)
2182 Returns a list: an empty list on success or a list of errors.
2186 sub suspend_if_pkgpart {
2188 my (@pkgparts, %opt);
2189 if (ref($_[0]) eq 'HASH'){
2190 @pkgparts = @{$_[0]{pkgparts}};
2195 grep { $_->suspend(%opt) }
2196 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2197 $self->unsuspended_pkgs;
2200 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2202 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2203 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2204 instead of a list of pkgparts; the hashref has the following keys:
2208 =item pkgparts - listref of pkgparts
2210 =item (other options are passed to the suspend method)
2214 Returns a list: an empty list on success or a list of errors.
2218 sub suspend_unless_pkgpart {
2220 my (@pkgparts, %opt);
2221 if (ref($_[0]) eq 'HASH'){
2222 @pkgparts = @{$_[0]{pkgparts}};
2227 grep { $_->suspend(%opt) }
2228 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2229 $self->unsuspended_pkgs;
2232 =item cancel [ OPTION => VALUE ... ]
2234 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2236 Available options are:
2240 =item quiet - can be set true to supress email cancellation notices.
2242 =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.
2244 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2246 =item nobill - can be set true to skip billing if it might otherwise be done.
2250 Always returns a list: an empty list on success or a list of errors.
2254 # nb that dates are not specified as valid options to this method
2257 my( $self, %opt ) = @_;
2259 warn "$me cancel called on customer ". $self->custnum. " with options ".
2260 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2263 return ( 'access denied' )
2264 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2266 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2268 #should try decryption (we might have the private key)
2269 # and if not maybe queue a job for the server that does?
2270 return ( "Can't (yet) ban encrypted credit cards" )
2271 if $self->is_encrypted($self->payinfo);
2273 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2274 my $error = $ban->insert;
2275 return ( $error ) if $error;
2279 my @pkgs = $self->ncancelled_pkgs;
2281 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2283 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2284 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2288 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2289 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2292 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2295 sub _banned_pay_hashref {
2306 'payby' => $payby2ban{$self->payby},
2307 'payinfo' => $self->payinfo,
2308 #don't ever *search* on reason! #'reason' =>
2312 sub _new_banned_pay_hashref {
2314 my $hr = $self->_banned_pay_hashref;
2315 $hr->{payinfo} = md5_base64($hr->{payinfo});
2321 Returns all notes (see L<FS::cust_main_note>) for this customer.
2326 my($self,$orderby_classnum) = (shift,shift);
2327 my $orderby = "_DATE DESC";
2328 $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
2329 qsearch( 'cust_main_note',
2330 { 'custnum' => $self->custnum },
2332 "ORDER BY $orderby",
2338 Returns the agent (see L<FS::agent>) for this customer.
2344 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2349 Returns the agent name (see L<FS::agent>) for this customer.
2355 $self->agent->agent;
2360 Returns any tags associated with this customer, as FS::cust_tag objects,
2361 or an empty list if there are no tags.
2367 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2372 Returns any tags associated with this customer, as FS::part_tag objects,
2373 or an empty list if there are no tags.
2379 map $_->part_tag, $self->cust_tag;
2385 Returns the customer class, as an FS::cust_class object, or the empty string
2386 if there is no customer class.
2392 if ( $self->classnum ) {
2393 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2401 Returns the customer category name, or the empty string if there is no customer
2408 my $cust_class = $self->cust_class;
2410 ? $cust_class->categoryname
2416 Returns the customer class name, or the empty string if there is no customer
2423 my $cust_class = $self->cust_class;
2425 ? $cust_class->classname
2429 =item BILLING METHODS
2431 Documentation on billing methods has been moved to
2432 L<FS::cust_main::Billing>.
2434 =item REALTIME BILLING METHODS
2436 Documentation on realtime billing methods has been moved to
2437 L<FS::cust_main::Billing_Realtime>.
2441 Removes the I<paycvv> field from the database directly.
2443 If there is an error, returns the error, otherwise returns false.
2449 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2450 or return dbh->errstr;
2451 $sth->execute($self->custnum)
2452 or return $sth->errstr;
2457 =item batch_card OPTION => VALUE...
2459 Adds a payment for this invoice to the pending credit card batch (see
2460 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2461 runs the payment using a realtime gateway.
2466 my ($self, %options) = @_;
2469 if (exists($options{amount})) {
2470 $amount = $options{amount};
2472 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2474 return '' unless $amount > 0;
2476 my $invnum = delete $options{invnum};
2477 my $payby = $options{payby} || $self->payby; #still dubious
2479 if ($options{'realtime'}) {
2480 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2486 my $oldAutoCommit = $FS::UID::AutoCommit;
2487 local $FS::UID::AutoCommit = 0;
2490 #this needs to handle mysql as well as Pg, like svc_acct.pm
2491 #(make it into a common function if folks need to do batching with mysql)
2492 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2493 or return "Cannot lock pay_batch: " . $dbh->errstr;
2497 'payby' => FS::payby->payby2payment($payby),
2499 $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2501 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2503 unless ( $pay_batch ) {
2504 $pay_batch = new FS::pay_batch \%pay_batch;
2505 my $error = $pay_batch->insert;
2507 $dbh->rollback if $oldAutoCommit;
2508 die "error creating new batch: $error\n";
2512 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2513 'batchnum' => $pay_batch->batchnum,
2514 'custnum' => $self->custnum,
2517 foreach (qw( address1 address2 city state zip country latitude longitude
2518 payby payinfo paydate payname ))
2520 $options{$_} = '' unless exists($options{$_});
2523 my $loc = $self->bill_location;
2525 my $cust_pay_batch = new FS::cust_pay_batch ( {
2526 'batchnum' => $pay_batch->batchnum,
2527 'invnum' => $invnum || 0, # is there a better value?
2528 # this field should be
2530 # cust_bill_pay_batch now
2531 'custnum' => $self->custnum,
2532 'last' => $self->getfield('last'),
2533 'first' => $self->getfield('first'),
2534 'address1' => $options{address1} || $loc->address1,
2535 'address2' => $options{address2} || $loc->address2,
2536 'city' => $options{city} || $loc->city,
2537 'state' => $options{state} || $loc->state,
2538 'zip' => $options{zip} || $loc->zip,
2539 'country' => $options{country} || $loc->country,
2540 'payby' => $options{payby} || $loc->payby,
2541 'payinfo' => $options{payinfo} || $loc->payinfo,
2542 'exp' => $options{paydate} || $loc->paydate,
2543 'payname' => $options{payname} || $loc->payname,
2544 'amount' => $amount, # consolidating
2547 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2548 if $old_cust_pay_batch;
2551 if ($old_cust_pay_batch) {
2552 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2554 $error = $cust_pay_batch->insert;
2558 $dbh->rollback if $oldAutoCommit;
2562 my $unapplied = $self->total_unapplied_credits
2563 + $self->total_unapplied_payments
2564 + $self->in_transit_payments;
2565 foreach my $cust_bill ($self->open_cust_bill) {
2566 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2567 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2568 'invnum' => $cust_bill->invnum,
2569 'paybatchnum' => $cust_pay_batch->paybatchnum,
2570 'amount' => $cust_bill->owed,
2573 if ($unapplied >= $cust_bill_pay_batch->amount){
2574 $unapplied -= $cust_bill_pay_batch->amount;
2577 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2578 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2580 $error = $cust_bill_pay_batch->insert;
2582 $dbh->rollback if $oldAutoCommit;
2587 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2593 Returns the total owed for this customer on all invoices
2594 (see L<FS::cust_bill/owed>).
2600 $self->total_owed_date(2145859200); #12/31/2037
2603 =item total_owed_date TIME
2605 Returns the total owed for this customer on all invoices with date earlier than
2606 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2607 see L<Time::Local> and L<Date::Parse> for conversion functions.
2611 sub total_owed_date {
2615 my $custnum = $self->custnum;
2617 my $owed_sql = FS::cust_bill->owed_sql;
2620 SELECT SUM($owed_sql) FROM cust_bill
2621 WHERE custnum = $custnum
2625 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2629 =item total_owed_pkgnum PKGNUM
2631 Returns the total owed on all invoices for this customer's specific package
2632 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2636 sub total_owed_pkgnum {
2637 my( $self, $pkgnum ) = @_;
2638 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2641 =item total_owed_date_pkgnum TIME PKGNUM
2643 Returns the total owed for this customer's specific package when using
2644 experimental package balances on all invoices with date earlier than
2645 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2646 see L<Time::Local> and L<Date::Parse> for conversion functions.
2650 sub total_owed_date_pkgnum {
2651 my( $self, $time, $pkgnum ) = @_;
2654 foreach my $cust_bill (
2655 grep { $_->_date <= $time }
2656 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2658 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2660 sprintf( "%.2f", $total_bill );
2666 Returns the total amount of all payments.
2673 $total += $_->paid foreach $self->cust_pay;
2674 sprintf( "%.2f", $total );
2677 =item total_unapplied_credits
2679 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2680 customer. See L<FS::cust_credit/credited>.
2682 =item total_credited
2684 Old name for total_unapplied_credits. Don't use.
2688 sub total_credited {
2689 #carp "total_credited deprecated, use total_unapplied_credits";
2690 shift->total_unapplied_credits(@_);
2693 sub total_unapplied_credits {
2696 my $custnum = $self->custnum;
2698 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2701 SELECT SUM($unapplied_sql) FROM cust_credit
2702 WHERE custnum = $custnum
2705 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2709 =item total_unapplied_credits_pkgnum PKGNUM
2711 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2712 customer. See L<FS::cust_credit/credited>.
2716 sub total_unapplied_credits_pkgnum {
2717 my( $self, $pkgnum ) = @_;
2718 my $total_credit = 0;
2719 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2720 sprintf( "%.2f", $total_credit );
2724 =item total_unapplied_payments
2726 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2727 See L<FS::cust_pay/unapplied>.
2731 sub total_unapplied_payments {
2734 my $custnum = $self->custnum;
2736 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2739 SELECT SUM($unapplied_sql) FROM cust_pay
2740 WHERE custnum = $custnum
2743 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2747 =item total_unapplied_payments_pkgnum PKGNUM
2749 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2750 specific package when using experimental package balances. See
2751 L<FS::cust_pay/unapplied>.
2755 sub total_unapplied_payments_pkgnum {
2756 my( $self, $pkgnum ) = @_;
2757 my $total_unapplied = 0;
2758 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2759 sprintf( "%.2f", $total_unapplied );
2763 =item total_unapplied_refunds
2765 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2766 customer. See L<FS::cust_refund/unapplied>.
2770 sub total_unapplied_refunds {
2772 my $custnum = $self->custnum;
2774 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2777 SELECT SUM($unapplied_sql) FROM cust_refund
2778 WHERE custnum = $custnum
2781 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2787 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2788 total_unapplied_credits minus total_unapplied_payments).
2794 $self->balance_date_range;
2797 =item balance_date TIME
2799 Returns the balance for this customer, only considering invoices with date
2800 earlier than TIME (total_owed_date minus total_credited minus
2801 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2802 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2809 $self->balance_date_range(shift);
2812 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2814 Returns the balance for this customer, optionally considering invoices with
2815 date earlier than START_TIME, and not later than END_TIME
2816 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2818 Times are specified as SQL fragments or numeric
2819 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2820 L<Date::Parse> for conversion functions. The empty string can be passed
2821 to disable that time constraint completely.
2823 Available options are:
2827 =item unapplied_date
2829 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)
2835 sub balance_date_range {
2837 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2838 ') FROM cust_main WHERE custnum='. $self->custnum;
2839 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2842 =item balance_pkgnum PKGNUM
2844 Returns the balance for this customer's specific package when using
2845 experimental package balances (total_owed plus total_unrefunded, minus
2846 total_unapplied_credits minus total_unapplied_payments)
2850 sub balance_pkgnum {
2851 my( $self, $pkgnum ) = @_;
2854 $self->total_owed_pkgnum($pkgnum)
2855 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2856 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2857 - $self->total_unapplied_credits_pkgnum($pkgnum)
2858 - $self->total_unapplied_payments_pkgnum($pkgnum)
2862 =item in_transit_payments
2864 Returns the total of requests for payments for this customer pending in
2865 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
2869 sub in_transit_payments {
2871 my $in_transit_payments = 0;
2872 foreach my $pay_batch ( qsearch('pay_batch', {
2875 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2876 'batchnum' => $pay_batch->batchnum,
2877 'custnum' => $self->custnum,
2879 $in_transit_payments += $cust_pay_batch->amount;
2882 sprintf( "%.2f", $in_transit_payments );
2887 Returns a hash of useful information for making a payment.
2897 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2898 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2899 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2903 For credit card transactions:
2915 For electronic check transactions:
2930 $return{balance} = $self->balance;
2932 $return{payname} = $self->payname
2933 || ( $self->first. ' '. $self->get('last') );
2935 $return{$_} = $self->bill_location->$_
2936 for qw(address1 address2 city state zip);
2938 $return{payby} = $self->payby;
2939 $return{stateid_state} = $self->stateid_state;
2941 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2942 $return{card_type} = cardtype($self->payinfo);
2943 $return{payinfo} = $self->paymask;
2945 @return{'month', 'year'} = $self->paydate_monthyear;
2949 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2950 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2951 $return{payinfo1} = $payinfo1;
2952 $return{payinfo2} = $payinfo2;
2953 $return{paytype} = $self->paytype;
2954 $return{paystate} = $self->paystate;
2958 #doubleclick protection
2960 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2966 =item paydate_monthyear
2968 Returns a two-element list consisting of the month and year of this customer's
2969 paydate (credit card expiration date for CARD customers)
2973 sub paydate_monthyear {
2975 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2977 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2986 Returns the exact time in seconds corresponding to the payment method
2987 expiration date. For CARD/DCRD customers this is the end of the month;
2988 for others (COMP is the only other payby that uses paydate) it's the start.
2989 Returns 0 if the paydate is empty or set to the far future.
2995 my ($month, $year) = $self->paydate_monthyear;
2996 return 0 if !$year or $year >= 2037;
2997 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2999 if ( $month == 13 ) {
3003 return timelocal(0,0,0,1,$month-1,$year) - 1;
3006 return timelocal(0,0,0,1,$month-1,$year);
3010 =item paydate_epoch_sql
3012 Class method. Returns an SQL expression to obtain the payment expiration date
3013 as a number of seconds.
3017 # Special expiration date behavior for non-CARD/DCRD customers has been
3018 # carefully preserved. Do we really use that?
3019 sub paydate_epoch_sql {
3021 my $table = shift || 'cust_main';
3022 my ($case1, $case2);
3023 if ( driver_name eq 'Pg' ) {
3024 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3025 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3027 elsif ( lc(driver_name) eq 'mysql' ) {
3028 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3029 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3032 return "CASE WHEN $table.payby IN('CARD','DCRD')
3038 =item tax_exemption TAXNAME
3043 my( $self, $taxname ) = @_;
3045 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3046 'taxname' => $taxname,
3051 =item cust_main_exemption
3055 sub cust_main_exemption {
3057 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3060 =item invoicing_list [ ARRAYREF ]
3062 If an arguement is given, sets these email addresses as invoice recipients
3063 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3064 (except as warnings), so use check_invoicing_list first.
3066 Returns a list of email addresses (with svcnum entries expanded).
3068 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3069 check it without disturbing anything by passing nothing.
3071 This interface may change in the future.
3075 sub invoicing_list {
3076 my( $self, $arrayref ) = @_;
3079 my @cust_main_invoice;
3080 if ( $self->custnum ) {
3081 @cust_main_invoice =
3082 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3084 @cust_main_invoice = ();
3086 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3087 #warn $cust_main_invoice->destnum;
3088 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3089 #warn $cust_main_invoice->destnum;
3090 my $error = $cust_main_invoice->delete;
3091 warn $error if $error;
3094 if ( $self->custnum ) {
3095 @cust_main_invoice =
3096 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3098 @cust_main_invoice = ();
3100 my %seen = map { $_->address => 1 } @cust_main_invoice;
3101 foreach my $address ( @{$arrayref} ) {
3102 next if exists $seen{$address} && $seen{$address};
3103 $seen{$address} = 1;
3104 my $cust_main_invoice = new FS::cust_main_invoice ( {
3105 'custnum' => $self->custnum,
3108 my $error = $cust_main_invoice->insert;
3109 warn $error if $error;
3113 if ( $self->custnum ) {
3115 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3122 =item check_invoicing_list ARRAYREF
3124 Checks these arguements as valid input for the invoicing_list method. If there
3125 is an error, returns the error, otherwise returns false.
3129 sub check_invoicing_list {
3130 my( $self, $arrayref ) = @_;
3132 foreach my $address ( @$arrayref ) {
3134 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3135 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3138 my $cust_main_invoice = new FS::cust_main_invoice ( {
3139 'custnum' => $self->custnum,
3142 my $error = $self->custnum
3143 ? $cust_main_invoice->check
3144 : $cust_main_invoice->checkdest
3146 return $error if $error;
3150 return "Email address required"
3151 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3152 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3157 =item set_default_invoicing_list
3159 Sets the invoicing list to all accounts associated with this customer,
3160 overwriting any previous invoicing list.
3164 sub set_default_invoicing_list {
3166 $self->invoicing_list($self->all_emails);
3171 Returns the email addresses of all accounts provisioned for this customer.
3178 foreach my $cust_pkg ( $self->all_pkgs ) {
3179 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3181 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3182 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3184 $list{$_}=1 foreach map { $_->email } @svc_acct;
3189 =item invoicing_list_addpost
3191 Adds postal invoicing to this customer. If this customer is already configured
3192 to receive postal invoices, does nothing.
3196 sub invoicing_list_addpost {
3198 return if grep { $_ eq 'POST' } $self->invoicing_list;
3199 my @invoicing_list = $self->invoicing_list;
3200 push @invoicing_list, 'POST';
3201 $self->invoicing_list(\@invoicing_list);
3204 =item invoicing_list_emailonly
3206 Returns the list of email invoice recipients (invoicing_list without non-email
3207 destinations such as POST and FAX).
3211 sub invoicing_list_emailonly {
3213 warn "$me invoicing_list_emailonly called"
3215 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3218 =item invoicing_list_emailonly_scalar
3220 Returns the list of email invoice recipients (invoicing_list without non-email
3221 destinations such as POST and FAX) as a comma-separated scalar.
3225 sub invoicing_list_emailonly_scalar {
3227 warn "$me invoicing_list_emailonly_scalar called"
3229 join(', ', $self->invoicing_list_emailonly);
3232 =item referral_custnum_cust_main
3234 Returns the customer who referred this customer (or the empty string, if
3235 this customer was not referred).
3237 Note the difference with referral_cust_main method: This method,
3238 referral_custnum_cust_main returns the single customer (if any) who referred
3239 this customer, while referral_cust_main returns an array of customers referred
3244 sub referral_custnum_cust_main {
3246 return '' unless $self->referral_custnum;
3247 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3250 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3252 Returns an array of customers referred by this customer (referral_custnum set
3253 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3254 customers referred by customers referred by this customer and so on, inclusive.
3255 The default behavior is DEPTH 1 (no recursion).
3257 Note the difference with referral_custnum_cust_main method: This method,
3258 referral_cust_main, returns an array of customers referred BY this customer,
3259 while referral_custnum_cust_main returns the single customer (if any) who
3260 referred this customer.
3264 sub referral_cust_main {
3266 my $depth = @_ ? shift : 1;
3267 my $exclude = @_ ? shift : {};
3270 map { $exclude->{$_->custnum}++; $_; }
3271 grep { ! $exclude->{ $_->custnum } }
3272 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3276 map { $_->referral_cust_main($depth-1, $exclude) }
3283 =item referral_cust_main_ncancelled
3285 Same as referral_cust_main, except only returns customers with uncancelled
3290 sub referral_cust_main_ncancelled {
3292 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3295 =item referral_cust_pkg [ DEPTH ]
3297 Like referral_cust_main, except returns a flat list of all unsuspended (and
3298 uncancelled) packages for each customer. The number of items in this list may
3299 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3303 sub referral_cust_pkg {
3305 my $depth = @_ ? shift : 1;
3307 map { $_->unsuspended_pkgs }
3308 grep { $_->unsuspended_pkgs }
3309 $self->referral_cust_main($depth);
3312 =item referring_cust_main
3314 Returns the single cust_main record for the customer who referred this customer
3315 (referral_custnum), or false.
3319 sub referring_cust_main {
3321 return '' unless $self->referral_custnum;
3322 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3325 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3327 Applies a credit to this customer. If there is an error, returns the error,
3328 otherwise returns false.
3330 REASON can be a text string, an FS::reason object, or a scalar reference to
3331 a reasonnum. If a text string, it will be automatically inserted as a new
3332 reason, and a 'reason_type' option must be passed to indicate the
3333 FS::reason_type for the new reason.
3335 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3337 Any other options are passed to FS::cust_credit::insert.
3342 my( $self, $amount, $reason, %options ) = @_;
3344 my $cust_credit = new FS::cust_credit {
3345 'custnum' => $self->custnum,
3346 'amount' => $amount,
3349 if ( ref($reason) ) {
3351 if ( ref($reason) eq 'SCALAR' ) {
3352 $cust_credit->reasonnum( $$reason );
3354 $cust_credit->reasonnum( $reason->reasonnum );
3358 $cust_credit->set('reason', $reason)
3361 for (qw( addlinfo eventnum )) {
3362 $cust_credit->$_( delete $options{$_} )
3363 if exists($options{$_});
3366 $cust_credit->insert(%options);
3370 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3372 Creates a one-time charge for this customer. If there is an error, returns
3373 the error, otherwise returns false.
3375 New-style, with a hashref of options:
3377 my $error = $cust_main->charge(
3381 'start_date' => str2time('7/4/2009'),
3382 'pkg' => 'Description',
3383 'comment' => 'Comment',
3384 'additional' => [], #extra invoice detail
3385 'classnum' => 1, #pkg_class
3387 'setuptax' => '', # or 'Y' for tax exempt
3390 'taxclass' => 'Tax class',
3393 'taxproduct' => 2, #part_pkg_taxproduct
3394 'override' => {}, #XXX describe
3396 #will be filled in with the new object
3397 'cust_pkg_ref' => \$cust_pkg,
3399 #generate an invoice immediately
3401 'invoice_terms' => '', #with these terms
3407 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3413 my ( $amount, $quantity, $start_date, $classnum );
3414 my ( $pkg, $comment, $additional );
3415 my ( $setuptax, $taxclass ); #internal taxes
3416 my ( $taxproduct, $override ); #vendor (CCH) taxes
3418 my $cust_pkg_ref = '';
3419 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3420 if ( ref( $_[0] ) ) {
3421 $amount = $_[0]->{amount};
3422 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3423 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3424 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3425 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3426 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3427 : '$'. sprintf("%.2f",$amount);
3428 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3429 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3430 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3431 $additional = $_[0]->{additional} || [];
3432 $taxproduct = $_[0]->{taxproductnum};
3433 $override = { '' => $_[0]->{tax_override} };
3434 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3435 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3436 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3441 $pkg = @_ ? shift : 'One-time charge';
3442 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3444 $taxclass = @_ ? shift : '';
3448 local $SIG{HUP} = 'IGNORE';
3449 local $SIG{INT} = 'IGNORE';
3450 local $SIG{QUIT} = 'IGNORE';
3451 local $SIG{TERM} = 'IGNORE';
3452 local $SIG{TSTP} = 'IGNORE';
3453 local $SIG{PIPE} = 'IGNORE';
3455 my $oldAutoCommit = $FS::UID::AutoCommit;
3456 local $FS::UID::AutoCommit = 0;
3459 my $part_pkg = new FS::part_pkg ( {
3461 'comment' => $comment,
3465 'classnum' => ( $classnum ? $classnum : '' ),
3466 'setuptax' => $setuptax,
3467 'taxclass' => $taxclass,
3468 'taxproductnum' => $taxproduct,
3471 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3472 ( 0 .. @$additional - 1 )
3474 'additional_count' => scalar(@$additional),
3475 'setup_fee' => $amount,
3478 my $error = $part_pkg->insert( options => \%options,
3479 tax_overrides => $override,
3482 $dbh->rollback if $oldAutoCommit;
3486 my $pkgpart = $part_pkg->pkgpart;
3487 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3488 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3489 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3490 $error = $type_pkgs->insert;
3492 $dbh->rollback if $oldAutoCommit;
3497 my $cust_pkg = new FS::cust_pkg ( {
3498 'custnum' => $self->custnum,
3499 'pkgpart' => $pkgpart,
3500 'quantity' => $quantity,
3501 'start_date' => $start_date,
3502 'no_auto' => $no_auto,
3505 $error = $cust_pkg->insert;
3507 $dbh->rollback if $oldAutoCommit;
3509 } elsif ( $cust_pkg_ref ) {
3510 ${$cust_pkg_ref} = $cust_pkg;
3514 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3515 'pkg_list' => [ $cust_pkg ],
3518 $dbh->rollback if $oldAutoCommit;
3523 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3528 #=item charge_postal_fee
3530 #Applies a one time charge this customer. If there is an error,
3531 #returns the error, returns the cust_pkg charge object or false
3532 #if there was no charge.
3536 # This should be a customer event. For that to work requires that bill
3537 # also be a customer event.
3539 sub charge_postal_fee {
3542 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3543 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3545 my $cust_pkg = new FS::cust_pkg ( {
3546 'custnum' => $self->custnum,
3547 'pkgpart' => $pkgpart,
3551 my $error = $cust_pkg->insert;
3552 $error ? $error : $cust_pkg;
3555 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3557 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3559 Optionally, a list or hashref of additional arguments to the qsearch call can
3566 my $opt = ref($_[0]) ? shift : { @_ };
3568 #return $self->num_cust_bill unless wantarray || keys %$opt;
3570 $opt->{'table'} = 'cust_bill';
3571 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3572 $opt->{'hashref'}{'custnum'} = $self->custnum;
3573 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3575 map { $_ } #behavior of sort undefined in scalar context
3576 sort { $a->_date <=> $b->_date }
3580 =item open_cust_bill
3582 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3587 sub open_cust_bill {
3591 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3597 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3599 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3603 sub legacy_cust_bill {
3606 #return $self->num_legacy_cust_bill unless wantarray;
3608 map { $_ } #behavior of sort undefined in scalar context
3609 sort { $a->_date <=> $b->_date }
3610 qsearch({ 'table' => 'legacy_cust_bill',
3611 'hashref' => { 'custnum' => $self->custnum, },
3612 'order_by' => 'ORDER BY _date ASC',
3616 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3618 Returns all the statements (see L<FS::cust_statement>) for this customer.
3620 Optionally, a list or hashref of additional arguments to the qsearch call can
3625 sub cust_statement {
3627 my $opt = ref($_[0]) ? shift : { @_ };
3629 #return $self->num_cust_statement unless wantarray || keys %$opt;
3631 $opt->{'table'} = 'cust_statement';
3632 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3633 $opt->{'hashref'}{'custnum'} = $self->custnum;
3634 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3636 map { $_ } #behavior of sort undefined in scalar context
3637 sort { $a->_date <=> $b->_date }
3641 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3643 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3645 Optionally, a list or hashref of additional arguments to the qsearch call can
3646 be passed following the SVCDB.
3653 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3654 warn "$me svc_x requires a svcdb";
3657 my $opt = ref($_[0]) ? shift : { @_ };
3659 $opt->{'table'} = $svcdb;
3660 $opt->{'addl_from'} =
3661 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3662 ($opt->{'addl_from'} || '');
3664 my $custnum = $self->custnum;
3665 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3666 my $where = "cust_pkg.custnum = $custnum";
3668 my $extra_sql = $opt->{'extra_sql'} || '';
3669 if ( keys %{ $opt->{'hashref'} } ) {
3670 $extra_sql = " AND $where $extra_sql";
3673 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3674 $extra_sql = "WHERE $where AND $1";
3677 $extra_sql = "WHERE $where $extra_sql";
3680 $opt->{'extra_sql'} = $extra_sql;
3685 # required for use as an eventtable;
3688 $self->svc_x('svc_acct', @_);
3693 Returns all the credits (see L<FS::cust_credit>) for this customer.
3699 map { $_ } #return $self->num_cust_credit unless wantarray;
3700 sort { $a->_date <=> $b->_date }
3701 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3704 =item cust_credit_pkgnum
3706 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3707 package when using experimental package balances.
3711 sub cust_credit_pkgnum {
3712 my( $self, $pkgnum ) = @_;
3713 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3714 sort { $a->_date <=> $b->_date }
3715 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3716 'pkgnum' => $pkgnum,
3723 Returns all the payments (see L<FS::cust_pay>) for this customer.
3729 return $self->num_cust_pay unless wantarray;
3730 sort { $a->_date <=> $b->_date }
3731 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3736 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3737 called automatically when the cust_pay method is used in a scalar context.
3743 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3744 my $sth = dbh->prepare($sql) or die dbh->errstr;
3745 $sth->execute($self->custnum) or die $sth->errstr;
3746 $sth->fetchrow_arrayref->[0];
3749 =item cust_pay_pkgnum
3751 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3752 package when using experimental package balances.
3756 sub cust_pay_pkgnum {
3757 my( $self, $pkgnum ) = @_;
3758 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3759 sort { $a->_date <=> $b->_date }
3760 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3761 'pkgnum' => $pkgnum,
3768 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3774 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3775 sort { $a->_date <=> $b->_date }
3776 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3779 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3781 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3783 Optionally, a list or hashref of additional arguments to the qsearch call can
3788 sub cust_pay_batch {
3790 my $opt = ref($_[0]) ? shift : { @_ };
3792 #return $self->num_cust_statement unless wantarray || keys %$opt;
3794 $opt->{'table'} = 'cust_pay_batch';
3795 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3796 $opt->{'hashref'}{'custnum'} = $self->custnum;
3797 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3799 map { $_ } #behavior of sort undefined in scalar context
3800 sort { $a->paybatchnum <=> $b->paybatchnum }
3804 =item cust_pay_pending
3806 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3807 (without status "done").
3811 sub cust_pay_pending {
3813 return $self->num_cust_pay_pending unless wantarray;
3814 sort { $a->_date <=> $b->_date }
3815 qsearch( 'cust_pay_pending', {
3816 'custnum' => $self->custnum,
3817 'status' => { op=>'!=', value=>'done' },
3822 =item cust_pay_pending_attempt
3824 Returns all payment attempts / declined payments for this customer, as pending
3825 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3826 a corresponding payment (see L<FS::cust_pay>).
3830 sub cust_pay_pending_attempt {
3832 return $self->num_cust_pay_pending_attempt unless wantarray;
3833 sort { $a->_date <=> $b->_date }
3834 qsearch( 'cust_pay_pending', {
3835 'custnum' => $self->custnum,
3842 =item num_cust_pay_pending
3844 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3845 customer (without status "done"). Also called automatically when the
3846 cust_pay_pending method is used in a scalar context.
3850 sub num_cust_pay_pending {
3853 " SELECT COUNT(*) FROM cust_pay_pending ".
3854 " WHERE custnum = ? AND status != 'done' ",
3859 =item num_cust_pay_pending_attempt
3861 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3862 customer, with status "done" but without a corresp. Also called automatically when the
3863 cust_pay_pending method is used in a scalar context.
3867 sub num_cust_pay_pending_attempt {
3870 " SELECT COUNT(*) FROM cust_pay_pending ".
3871 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3878 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3884 map { $_ } #return $self->num_cust_refund unless wantarray;
3885 sort { $a->_date <=> $b->_date }
3886 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3889 =item display_custnum
3891 Returns the displayed customer number for this customer: agent_custid if
3892 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3896 sub display_custnum {
3899 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3900 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3901 if ( $special eq 'CoStAg' ) {
3902 $prefix = uc( join('',
3904 ($self->state =~ /^(..)/),
3905 $prefix || ($self->agent->agent =~ /^(..)/)
3908 elsif ( $special eq 'CoStCl' ) {
3909 $prefix = uc( join('',
3911 ($self->state =~ /^(..)/),
3912 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3915 # add any others here if needed
3918 my $length = $conf->config('cust_main-custnum-display_length');
3919 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3920 return $self->agent_custid;
3921 } elsif ( $prefix ) {
3922 $length = 8 if !defined($length);
3924 sprintf('%0'.$length.'d', $self->custnum)
3925 } elsif ( $length ) {
3926 return sprintf('%0'.$length.'d', $self->custnum);
3928 return $self->custnum;
3934 Returns a name string for this customer, either "Company (Last, First)" or
3941 my $name = $self->contact;
3942 $name = $self->company. " ($name)" if $self->company;
3946 =item service_contact
3948 Returns the L<FS::contact> object for this customer that has the 'Service'
3949 contact class, or undef if there is no such contact. Deprecated; don't use
3954 sub service_contact {
3956 if ( !exists($self->{service_contact}) ) {
3957 my $classnum = $self->scalar_sql(
3958 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3959 ) || 0; #if it's zero, qsearchs will return nothing
3960 $self->{service_contact} = qsearchs('contact', {
3961 'classnum' => $classnum, 'custnum' => $self->custnum
3964 $self->{service_contact};
3969 Returns a name string for this (service/shipping) contact, either
3970 "Company (Last, First)" or "Last, First".
3977 my $name = $self->ship_contact;
3978 $name = $self->company. " ($name)" if $self->company;
3984 Returns a name string for this customer, either "Company" or "First Last".
3990 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3993 =item ship_name_short
3995 Returns a name string for this (service/shipping) contact, either "Company"
4000 sub ship_name_short {
4002 $self->service_contact
4003 ? $self->ship_contact_firstlast
4004 : $self->name_company_or_firstlast;
4009 Returns this customer's full (billing) contact name only, "Last, First"
4015 $self->get('last'). ', '. $self->first;
4020 Returns this customer's full (shipping) contact name only, "Last, First"
4026 my $contact = $self->service_contact || $self;
4027 $contact->get('last') . ', ' . $contact->get('first');
4030 =item contact_firstlast
4032 Returns this customers full (billing) contact name only, "First Last".
4036 sub contact_firstlast {
4038 $self->first. ' '. $self->get('last');
4041 =item ship_contact_firstlast
4043 Returns this customer's full (shipping) contact name only, "First Last".
4047 sub ship_contact_firstlast {
4049 my $contact = $self->service_contact || $self;
4050 $contact->get('first') . ' '. $contact->get('last');
4055 Returns this customer's full country name
4061 code2country($self->country);
4064 =item geocode DATA_VENDOR
4066 Returns a value for the customer location as encoded by DATA_VENDOR.
4067 Currently this only makes sense for "CCH" as DATA_VENDOR.
4075 Returns a status string for this customer, currently:
4079 =item prospect - No packages have ever been ordered
4081 =item ordered - Recurring packages all are new (not yet billed).
4083 =item active - One or more recurring packages is active
4085 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4087 =item suspended - All non-cancelled recurring packages are suspended
4089 =item cancelled - All recurring packages are cancelled
4093 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4094 cust_main-status_module configuration option.
4098 sub status { shift->cust_status(@_); }
4102 for my $status ( FS::cust_main->statuses() ) {
4103 my $method = $status.'_sql';
4104 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4105 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4106 $sth->execute( ($self->custnum) x $numnum )
4107 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4108 return $status if $sth->fetchrow_arrayref->[0];
4112 =item ucfirst_cust_status
4114 =item ucfirst_status
4116 Returns the status with the first character capitalized.
4120 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4122 sub ucfirst_cust_status {
4124 ucfirst($self->cust_status);
4129 Returns a hex triplet color string for this customer's status.
4133 sub statuscolor { shift->cust_statuscolor(@_); }
4135 sub cust_statuscolor {
4137 __PACKAGE__->statuscolors->{$self->cust_status};
4142 Returns an array of hashes representing the customer's RT tickets.
4149 my $num = $conf->config('cust_main-max_tickets') || 10;
4152 if ( $conf->config('ticket_system') ) {
4153 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4155 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4159 foreach my $priority (
4160 $conf->config('ticket_system-custom_priority_field-values'), ''
4162 last if scalar(@tickets) >= $num;
4164 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4165 $num - scalar(@tickets),
4175 # Return services representing svc_accts in customer support packages
4176 sub support_services {
4178 my %packages = map { $_ => 1 } $conf->config('support_packages');
4180 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4181 grep { $_->part_svc->svcdb eq 'svc_acct' }
4182 map { $_->cust_svc }
4183 grep { exists $packages{ $_->pkgpart } }
4184 $self->ncancelled_pkgs;
4188 # Return a list of latitude/longitude for one of the services (if any)
4189 sub service_coordinates {
4193 grep { $_->latitude && $_->longitude }
4195 map { $_->cust_svc }
4196 $self->ncancelled_pkgs;
4198 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4203 Returns a masked version of the named field
4208 my ($self,$field) = @_;
4212 'x'x(length($self->getfield($field))-4).
4213 substr($self->getfield($field), (length($self->getfield($field))-4));
4219 =head1 CLASS METHODS
4225 Class method that returns the list of possible status strings for customers
4226 (see L<the status method|/status>). For example:
4228 @statuses = FS::cust_main->statuses();
4234 keys %{ $self->statuscolors };
4237 =item cust_status_sql
4239 Returns an SQL fragment to determine the status of a cust_main record, as a
4244 sub cust_status_sql {
4246 for my $status ( FS::cust_main->statuses() ) {
4247 my $method = $status.'_sql';
4248 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4257 Returns an SQL expression identifying prospective cust_main records (customers
4258 with no packages ever ordered)
4262 use vars qw($select_count_pkgs);
4263 $select_count_pkgs =
4264 "SELECT COUNT(*) FROM cust_pkg
4265 WHERE cust_pkg.custnum = cust_main.custnum";
4267 sub select_count_pkgs_sql {
4272 " 0 = ( $select_count_pkgs ) ";
4277 Returns an SQL expression identifying ordered cust_main records (customers with
4278 no active packages, but recurring packages not yet setup or one time charges
4284 FS::cust_main->none_active_sql.
4285 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4290 Returns an SQL expression identifying active cust_main records (customers with
4291 active recurring packages).
4296 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4299 =item none_active_sql
4301 Returns an SQL expression identifying cust_main records with no active
4302 recurring packages. This includes customers of status prospect, ordered,
4303 inactive, and suspended.
4307 sub none_active_sql {
4308 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4313 Returns an SQL expression identifying inactive cust_main records (customers with
4314 no active recurring packages, but otherwise unsuspended/uncancelled).
4319 FS::cust_main->none_active_sql.
4320 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4326 Returns an SQL expression identifying suspended cust_main records.
4331 sub suspended_sql { susp_sql(@_); }
4333 FS::cust_main->none_active_sql.
4334 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4340 Returns an SQL expression identifying cancelled cust_main records.
4344 sub cancel_sql { shift->cancelled_sql(@_); }
4347 =item uncancelled_sql
4349 Returns an SQL expression identifying un-cancelled cust_main records.
4353 sub uncancelled_sql { uncancel_sql(@_); }
4354 sub uncancel_sql { "
4355 ( 0 < ( $select_count_pkgs
4356 AND ( cust_pkg.cancel IS NULL
4357 OR cust_pkg.cancel = 0
4360 OR 0 = ( $select_count_pkgs )
4366 Returns an SQL fragment to retreive the balance.
4371 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4372 WHERE cust_bill.custnum = cust_main.custnum )
4373 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4374 WHERE cust_pay.custnum = cust_main.custnum )
4375 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4376 WHERE cust_credit.custnum = cust_main.custnum )
4377 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4378 WHERE cust_refund.custnum = cust_main.custnum )
4381 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4383 Returns an SQL fragment to retreive the balance for this customer, optionally
4384 considering invoices with date earlier than START_TIME, and not
4385 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4386 total_unapplied_payments).
4388 Times are specified as SQL fragments or numeric
4389 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4390 L<Date::Parse> for conversion functions. The empty string can be passed
4391 to disable that time constraint completely.
4393 Available options are:
4397 =item unapplied_date
4399 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)
4404 set to true to remove all customer comparison clauses, for totals
4409 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4414 JOIN clause (typically used with the total option)
4418 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4419 time will be ignored. Note that START_TIME and END_TIME only limit the date
4420 range for invoices and I<unapplied> payments, credits, and refunds.
4426 sub balance_date_sql {
4427 my( $class, $start, $end, %opt ) = @_;
4429 my $cutoff = $opt{'cutoff'};
4431 my $owed = FS::cust_bill->owed_sql($cutoff);
4432 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4433 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4434 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4436 my $j = $opt{'join'} || '';
4438 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4439 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4440 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4441 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4443 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4444 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4445 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4446 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4451 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4453 Returns an SQL fragment to retreive the total unapplied payments for this
4454 customer, only considering payments with date earlier than START_TIME, and
4455 optionally not later than END_TIME.
4457 Times are specified as SQL fragments or numeric
4458 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4459 L<Date::Parse> for conversion functions. The empty string can be passed
4460 to disable that time constraint completely.
4462 Available options are:
4466 sub unapplied_payments_date_sql {
4467 my( $class, $start, $end, %opt ) = @_;
4469 my $cutoff = $opt{'cutoff'};
4471 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4473 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4474 'unapplied_date'=>1 );
4476 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4479 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4481 Helper method for balance_date_sql; name (and usage) subject to change
4482 (suggestions welcome).
4484 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4485 cust_refund, cust_credit or cust_pay).
4487 If TABLE is "cust_bill" or the unapplied_date option is true, only
4488 considers records with date earlier than START_TIME, and optionally not
4489 later than END_TIME .
4493 sub _money_table_where {
4494 my( $class, $table, $start, $end, %opt ) = @_;
4497 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4498 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4499 push @where, "$table._date <= $start" if defined($start) && length($start);
4500 push @where, "$table._date > $end" if defined($end) && length($end);
4502 push @where, @{$opt{'where'}} if $opt{'where'};
4503 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4509 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4510 use FS::cust_main::Search;
4513 FS::cust_main::Search->search(@_);
4528 #warn join('-',keys %$param);
4529 my $fh = $param->{filehandle};
4530 my $agentnum = $param->{agentnum};
4531 my $format = $param->{format};
4533 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4536 if ( $format eq 'simple' ) {
4537 @fields = qw( custnum agent_custid amount pkg );
4539 die "unknown format $format";
4542 eval "use Text::CSV_XS;";
4545 my $csv = new Text::CSV_XS;
4552 local $SIG{HUP} = 'IGNORE';
4553 local $SIG{INT} = 'IGNORE';
4554 local $SIG{QUIT} = 'IGNORE';
4555 local $SIG{TERM} = 'IGNORE';
4556 local $SIG{TSTP} = 'IGNORE';
4557 local $SIG{PIPE} = 'IGNORE';
4559 my $oldAutoCommit = $FS::UID::AutoCommit;
4560 local $FS::UID::AutoCommit = 0;
4563 #while ( $columns = $csv->getline($fh) ) {
4565 while ( defined($line=<$fh>) ) {
4567 $csv->parse($line) or do {
4568 $dbh->rollback if $oldAutoCommit;
4569 return "can't parse: ". $csv->error_input();
4572 my @columns = $csv->fields();
4573 #warn join('-',@columns);
4576 foreach my $field ( @fields ) {
4577 $row{$field} = shift @columns;
4580 if ( $row{custnum} && $row{agent_custid} ) {
4581 dbh->rollback if $oldAutoCommit;
4582 return "can't specify custnum with agent_custid $row{agent_custid}";
4586 if ( $row{agent_custid} && $agentnum ) {
4587 %hash = ( 'agent_custid' => $row{agent_custid},
4588 'agentnum' => $agentnum,
4592 if ( $row{custnum} ) {
4593 %hash = ( 'custnum' => $row{custnum} );
4596 unless ( scalar(keys %hash) ) {
4597 $dbh->rollback if $oldAutoCommit;
4598 return "can't find customer without custnum or agent_custid and agentnum";
4601 my $cust_main = qsearchs('cust_main', { %hash } );
4602 unless ( $cust_main ) {
4603 $dbh->rollback if $oldAutoCommit;
4604 my $custnum = $row{custnum} || $row{agent_custid};
4605 return "unknown custnum $custnum";
4608 if ( $row{'amount'} > 0 ) {
4609 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4611 $dbh->rollback if $oldAutoCommit;
4615 } elsif ( $row{'amount'} < 0 ) {
4616 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4619 $dbh->rollback if $oldAutoCommit;
4629 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4631 return "Empty file!" unless $imported;
4637 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4639 Deprecated. Use event notification and message templates
4640 (L<FS::msg_template>) instead.
4642 Sends a templated email notification to the customer (see L<Text::Template>).
4644 OPTIONS is a hash and may include
4646 I<from> - the email sender (default is invoice_from)
4648 I<to> - comma-separated scalar or arrayref of recipients
4649 (default is invoicing_list)
4651 I<subject> - The subject line of the sent email notification
4652 (default is "Notice from company_name")
4654 I<extra_fields> - a hashref of name/value pairs which will be substituted
4657 The following variables are vavailable in the template.
4659 I<$first> - the customer first name
4660 I<$last> - the customer last name
4661 I<$company> - the customer company
4662 I<$payby> - a description of the method of payment for the customer
4663 # would be nice to use FS::payby::shortname
4664 I<$payinfo> - the account information used to collect for this customer
4665 I<$expdate> - the expiration of the customer payment in seconds from epoch
4670 my ($self, $template, %options) = @_;
4672 return unless $conf->exists($template);
4674 my $from = $conf->config('invoice_from', $self->agentnum)
4675 if $conf->exists('invoice_from', $self->agentnum);
4676 $from = $options{from} if exists($options{from});
4678 my $to = join(',', $self->invoicing_list_emailonly);
4679 $to = $options{to} if exists($options{to});
4681 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4682 if $conf->exists('company_name', $self->agentnum);
4683 $subject = $options{subject} if exists($options{subject});
4685 my $notify_template = new Text::Template (TYPE => 'ARRAY',
4686 SOURCE => [ map "$_\n",
4687 $conf->config($template)]
4689 or die "can't create new Text::Template object: Text::Template::ERROR";
4690 $notify_template->compile()
4691 or die "can't compile template: Text::Template::ERROR";
4693 $FS::notify_template::_template::company_name =
4694 $conf->config('company_name', $self->agentnum);
4695 $FS::notify_template::_template::company_address =
4696 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4698 my $paydate = $self->paydate || '2037-12-31';
4699 $FS::notify_template::_template::first = $self->first;
4700 $FS::notify_template::_template::last = $self->last;
4701 $FS::notify_template::_template::company = $self->company;
4702 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4703 my $payby = $self->payby;
4704 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4705 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4707 #credit cards expire at the end of the month/year of their exp date
4708 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4709 $FS::notify_template::_template::payby = 'credit card';
4710 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4711 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4713 }elsif ($payby eq 'COMP') {
4714 $FS::notify_template::_template::payby = 'complimentary account';
4716 $FS::notify_template::_template::payby = 'current method';
4718 $FS::notify_template::_template::expdate = $expire_time;
4720 for (keys %{$options{extra_fields}}){
4722 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4725 send_email(from => $from,
4727 subject => $subject,
4728 body => $notify_template->fill_in( PACKAGE =>
4729 'FS::notify_template::_template' ),
4734 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4736 Generates a templated notification to the customer (see L<Text::Template>).
4738 OPTIONS is a hash and may include
4740 I<extra_fields> - a hashref of name/value pairs which will be substituted
4741 into the template. These values may override values mentioned below
4742 and those from the customer record.
4744 The following variables are available in the template instead of or in addition
4745 to the fields of the customer record.
4747 I<$payby> - a description of the method of payment for the customer
4748 # would be nice to use FS::payby::shortname
4749 I<$payinfo> - the masked account information used to collect for this customer
4750 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4751 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4755 # a lot like cust_bill::print_latex
4756 sub generate_letter {
4757 my ($self, $template, %options) = @_;
4759 return unless $conf->exists($template);
4761 my $letter_template = new Text::Template
4763 SOURCE => [ map "$_\n", $conf->config($template)],
4764 DELIMITERS => [ '[@--', '--@]' ],
4766 or die "can't create new Text::Template object: Text::Template::ERROR";
4768 $letter_template->compile()
4769 or die "can't compile template: Text::Template::ERROR";
4771 my %letter_data = map { $_ => $self->$_ } $self->fields;
4772 $letter_data{payinfo} = $self->mask_payinfo;
4774 #my $paydate = $self->paydate || '2037-12-31';
4775 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4777 my $payby = $self->payby;
4778 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4779 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4781 #credit cards expire at the end of the month/year of their exp date
4782 if ($payby eq 'CARD' || $payby eq 'DCRD') {
4783 $letter_data{payby} = 'credit card';
4784 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4785 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4787 }elsif ($payby eq 'COMP') {
4788 $letter_data{payby} = 'complimentary account';
4790 $letter_data{payby} = 'current method';
4792 $letter_data{expdate} = $expire_time;
4794 for (keys %{$options{extra_fields}}){
4795 $letter_data{$_} = $options{extra_fields}->{$_};
4798 unless(exists($letter_data{returnaddress})){
4799 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4800 $self->agent_template)
4802 if ( length($retadd) ) {
4803 $letter_data{returnaddress} = $retadd;
4804 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4805 $letter_data{returnaddress} =
4806 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4810 ( $conf->config('company_name', $self->agentnum),
4811 $conf->config('company_address', $self->agentnum),
4815 $letter_data{returnaddress} = '~';
4819 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4821 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4823 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4825 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4829 ) or die "can't open temp file: $!\n";
4830 print $lh $conf->config_binary('logo.eps', $self->agentnum)
4831 or die "can't write temp file: $!\n";
4833 $letter_data{'logo_file'} = $lh->filename;
4835 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4839 ) or die "can't open temp file: $!\n";
4841 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4843 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4844 return ($1, $letter_data{'logo_file'});
4848 =item print_ps TEMPLATE
4850 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4856 my($file, $lfile) = $self->generate_letter(@_);
4857 my $ps = FS::Misc::generate_ps($file);
4858 unlink($file.'.tex');
4864 =item print TEMPLATE
4866 Prints the filled in template.
4868 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4872 sub queueable_print {
4875 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4876 or die "invalid customer number: " . $opt{custvnum};
4878 my $error = $self->print( $opt{template} );
4879 die $error if $error;
4883 my ($self, $template) = (shift, shift);
4884 do_print [ $self->print_ps($template) ];
4887 #these three subs should just go away once agent stuff is all config overrides
4889 sub agent_template {
4891 $self->_agent_plandata('agent_templatename');
4894 sub agent_invoice_from {
4896 $self->_agent_plandata('agent_invoice_from');
4899 sub _agent_plandata {
4900 my( $self, $option ) = @_;
4902 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
4903 #agent-specific Conf
4905 use FS::part_event::Condition;
4907 my $agentnum = $self->agentnum;
4909 my $regexp = regexp_sql();
4911 my $part_event_option =
4913 'select' => 'part_event_option.*',
4914 'table' => 'part_event_option',
4916 LEFT JOIN part_event USING ( eventpart )
4917 LEFT JOIN part_event_option AS peo_agentnum
4918 ON ( part_event.eventpart = peo_agentnum.eventpart
4919 AND peo_agentnum.optionname = 'agentnum'
4920 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4922 LEFT JOIN part_event_condition
4923 ON ( part_event.eventpart = part_event_condition.eventpart
4924 AND part_event_condition.conditionname = 'cust_bill_age'
4926 LEFT JOIN part_event_condition_option
4927 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4928 AND part_event_condition_option.optionname = 'age'
4931 #'hashref' => { 'optionname' => $option },
4932 #'hashref' => { 'part_event_option.optionname' => $option },
4934 " WHERE part_event_option.optionname = ". dbh->quote($option).
4935 " AND action = 'cust_bill_send_agent' ".
4936 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4937 " AND peo_agentnum.optionname = 'agentnum' ".
4938 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4940 CASE WHEN part_event_condition_option.optionname IS NULL
4942 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4944 , part_event.weight".
4948 unless ( $part_event_option ) {
4949 return $self->agent->invoice_template || ''
4950 if $option eq 'agent_templatename';
4954 $part_event_option->optionvalue;
4958 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4960 Subroutine (not a method), designed to be called from the queue.
4962 Takes a list of options and values.
4964 Pulls up the customer record via the custnum option and calls bill_and_collect.
4969 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4971 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4972 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4974 $cust_main->bill_and_collect( %args );
4977 sub process_bill_and_collect {
4979 my $param = thaw(decode_base64(shift));
4980 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4981 or die "custnum '$param->{custnum}' not found!\n";
4982 $param->{'job'} = $job;
4983 $param->{'fatal'} = 1; # runs from job queue, will be caught
4984 $param->{'retry'} = 1;
4986 $cust_main->bill_and_collect( %$param );
4989 =item process_censustract_update CUSTNUM
4991 Queueable function to update the census tract to the current year (as set in
4992 the 'census_year' configuration variable) and retrieve the new tract code.
4996 sub process_censustract_update {
4997 eval "use FS::Misc::Geo qw(get_censustract)";
4999 my $custnum = shift;
5000 my $cust_main = qsearchs( 'cust_main', { custnum => $custnum })
5001 or die "custnum '$custnum' not found!\n";
5003 my $new_year = $conf->config('census_year') or return;
5004 my $new_tract = get_censustract({ $cust_main->location_hash }, $new_year);
5005 if ( $new_tract =~ /^\d/ ) {
5006 # then it's a tract code
5007 $cust_main->set('censustract', $new_tract);
5008 $cust_main->set('censusyear', $new_year);
5010 local($ignore_expired_card) = 1;
5011 local($ignore_illegal_zip) = 1;
5012 local($ignore_banned_card) = 1;
5013 local($skip_fuzzyfiles) = 1;
5014 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5015 my $error = $cust_main->replace;
5016 die $error if $error;
5019 # it's an error message
5025 #starting to take quite a while for big dbs
5026 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5027 # - seq scan of cust_main on signupdate... index signupdate? will that help?
5028 # - seq scan of cust_main on paydate... index on substrings? maybe set an
5029 # upgrade journal flag now that we have that, yyyy-m-dd paydates are ancient
5030 # - seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5031 # upgrade journal again? this is also an ancient problem
5032 # - otaker upgrade? journal and call it good? (double check to make sure
5033 # we're not still setting otaker here)
5035 #only going to get worse with new location stuff...
5037 sub _upgrade_data { #class method
5038 my ($class, %opts) = @_;
5041 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5042 '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',
5044 # fix yyyy-m-dd formatted paydates
5045 if ( driver_name =~ /^mysql/i ) {
5047 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5049 else { # the SQL standard
5051 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5054 push @statements, #fix the weird BILL with a cc# in payinfo problem
5056 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5058 foreach my $sql ( @statements ) {
5059 my $sth = dbh->prepare($sql) or die dbh->errstr;
5060 $sth->execute or die $sth->errstr;
5063 local($ignore_expired_card) = 1;
5064 local($ignore_banned_card) = 1;
5065 local($skip_fuzzyfiles) = 1;
5066 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5067 $class->_upgrade_otaker(%opts);
5069 FS::cust_main::Location->_upgrade_data(%opts);
5079 The delete method should possibly take an FS::cust_main object reference
5080 instead of a scalar customer number.
5082 Bill and collect options should probably be passed as references instead of a
5085 There should probably be a configuration file with a list of allowed credit
5088 No multiple currency support (probably a larger project than just this module).
5090 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5092 Birthdates rely on negative epoch values.
5094 The payby for card/check batches is broken. With mixed batching, bad
5097 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5101 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5102 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5103 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.