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