5 use base qw( FS::cust_main::Packages FS::cust_main::Status
6 FS::cust_main::NationalID
7 FS::cust_main::Billing FS::cust_main::Billing_Realtime
8 FS::cust_main::Billing_Discount
9 FS::cust_main::Billing_ThirdParty
10 FS::cust_main::Location
11 FS::cust_main::Credit_Limit
12 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
13 FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin
17 use vars qw( $DEBUG $me $conf
20 $ignore_expired_card $ignore_banned_card $ignore_illegal_zip
25 use Scalar::Util qw( blessed );
26 use Time::Local qw(timelocal);
27 use Storable qw(thaw);
31 use Digest::MD5 qw(md5_base64);
34 use File::Temp; #qw( tempfile );
35 use Business::CreditCard 0.28;
36 use FS::UID qw( getotaker 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 money_pretty );
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::cust_main_invoice;
64 use FS::prepay_credit;
70 use FS::payment_gateway;
71 use FS::agent_payment_gateway;
73 use FS::cust_main_note;
74 use FS::cust_attachment;
77 use FS::upgrade_journal;
79 # 1 is mostly method/subroutine entry and options
80 # 2 traces progress of some operations
81 # 3 is even more information including possibly sensitive data
83 $me = '[FS::cust_main]';
86 $ignore_expired_card = 0;
87 $ignore_banned_card = 0;
91 @encrypted_fields = ('payinfo', 'paycvv');
92 sub nohistory_fields { ('payinfo', 'paycvv'); }
94 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
96 #ask FS::UID to run this stuff for us later
97 #$FS::UID::callback{'FS::cust_main'} = sub {
98 install_callback FS::UID sub {
100 #yes, need it for stuff below (prolly should be cached)
105 my ( $hashref, $cache ) = @_;
106 if ( exists $hashref->{'pkgnum'} ) {
107 #@{ $self->{'_pkgnum'} } = ();
108 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
109 $self->{'_pkgnum'} = $subcache;
110 #push @{ $self->{'_pkgnum'} },
111 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
117 FS::cust_main - Object methods for cust_main records
123 $record = new FS::cust_main \%hash;
124 $record = new FS::cust_main { 'column' => 'value' };
126 $error = $record->insert;
128 $error = $new_record->replace($old_record);
130 $error = $record->delete;
132 $error = $record->check;
134 @cust_pkg = $record->all_pkgs;
136 @cust_pkg = $record->ncancelled_pkgs;
138 @cust_pkg = $record->suspended_pkgs;
140 $error = $record->bill;
141 $error = $record->bill %options;
142 $error = $record->bill 'time' => $time;
144 $error = $record->collect;
145 $error = $record->collect %options;
146 $error = $record->collect 'invoice_time' => $time,
151 An FS::cust_main object represents a customer. FS::cust_main inherits from
152 FS::Record. The following fields are currently supported:
158 Primary key (assigned automatically for new customers)
162 Agent (see L<FS::agent>)
166 Advertising source (see L<FS::part_referral>)
178 Cocial security number (optional)
202 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
206 Payment Information (See L<FS::payinfo_Mixin> for data format)
210 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
214 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
218 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
222 Start date month (maestro/solo cards only)
226 Start date year (maestro/solo cards only)
230 Issue number (maestro/solo cards only)
234 Name on card or billing name
238 IP address from which payment information was received
242 Tax exempt, empty or `Y'
246 Order taker (see L<FS::access_user>)
252 =item referral_custnum
254 Referring customer number
258 Enable individual CDR spooling, empty or `Y'
262 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
266 Discourage individual CDR printing, empty or `Y'
270 Allow self-service editing of ticket subjects, empty or 'Y'
272 =item calling_list_exempt
274 Do not call, empty or 'Y'
276 =item invoice_ship_address
278 Display ship_address ("Service address") on invoices for this customer, empty or 'Y'
288 Creates a new customer. To add the customer to the database, see L<"insert">.
290 Note that this stores the hash reference, not a distinct copy of the hash it
291 points to. You can ask the object for a copy with the I<hash> method.
295 sub table { 'cust_main'; }
297 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
299 Adds this customer to the database. If there is an error, returns the error,
300 otherwise returns false.
302 Usually the customer's location will not yet exist in the database, and
303 the C<bill_location> and C<ship_location> pseudo-fields must be set to
304 uninserted L<FS::cust_location> objects. These will be inserted and linked
305 (in both directions) to the new customer record. If they're references
306 to the same object, they will become the same location.
308 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
309 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
310 are inserted atomicly, or the transaction is rolled back. Passing an empty
311 hash reference is equivalent to not supplying this parameter. There should be
312 a better explanation of this, but until then, here's an example:
315 tie %hash, 'Tie::RefHash'; #this part is important
317 $cust_pkg => [ $svc_acct ],
320 $cust_main->insert( \%hash );
322 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
323 be set as the invoicing list (see L<"invoicing_list">). Errors return as
324 expected and rollback the entire transaction; it is not necessary to call
325 check_invoicing_list first. The invoicing_list is set after the records in the
326 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
327 invoicing_list destination to the newly-created svc_acct. Here's an example:
329 $cust_main->insert( {}, [ $email, 'POST' ] );
331 Currently available options are: I<depend_jobnum>, I<noexport>,
332 I<tax_exemption> and I<prospectnum>.
334 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
335 on the supplied jobnum (they will not run until the specific job completes).
336 This can be used to defer provisioning until some action completes (such
337 as running the customer's credit card successfully).
339 The I<noexport> option is deprecated. If I<noexport> is set true, no
340 provisioning jobs (exports) are scheduled. (You can schedule them later with
341 the B<reexport> method.)
343 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
344 of tax names and exemption numbers. FS::cust_main_exemption records will be
345 created and inserted.
347 If I<prospectnum> is set, moves contacts and locations from that prospect.
353 my $cust_pkgs = @_ ? shift : {};
354 my $invoicing_list = @_ ? shift : '';
356 warn "$me insert called with options ".
357 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
360 local $SIG{HUP} = 'IGNORE';
361 local $SIG{INT} = 'IGNORE';
362 local $SIG{QUIT} = 'IGNORE';
363 local $SIG{TERM} = 'IGNORE';
364 local $SIG{TSTP} = 'IGNORE';
365 local $SIG{PIPE} = 'IGNORE';
367 my $oldAutoCommit = $FS::UID::AutoCommit;
368 local $FS::UID::AutoCommit = 0;
371 my $prepay_identifier = '';
372 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
374 if ( $self->payby eq 'PREPAY' ) {
376 $self->payby('BILL');
377 $prepay_identifier = $self->payinfo;
380 warn " looking up prepaid card $prepay_identifier\n"
383 my $error = $self->get_prepay( $prepay_identifier,
384 'amount_ref' => \$amount,
385 'seconds_ref' => \$seconds,
386 'upbytes_ref' => \$upbytes,
387 'downbytes_ref' => \$downbytes,
388 'totalbytes_ref' => \$totalbytes,
391 $dbh->rollback if $oldAutoCommit;
392 #return "error applying prepaid card (transaction rolled back): $error";
396 $payby = 'PREP' if $amount;
398 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD|MCHK|PPAL)$/ ) {
401 $self->payby('BILL');
402 $amount = $self->paid;
407 foreach my $l (qw(bill_location ship_location)) {
409 my $loc = delete $self->hashref->{$l} or return "$l not set";
411 if ( !$loc->locationnum ) {
412 # warn the location that we're going to insert it with no custnum
413 $loc->set(custnum_pending => 1);
414 warn " inserting $l\n"
416 my $error = $loc->insert;
418 $dbh->rollback if $oldAutoCommit;
419 my $label = $l eq 'ship_location' ? 'service' : 'billing';
420 return "$error (in $label location)";
423 } elsif ( $loc->prospectnum ) {
425 $loc->prospectnum('');
426 $loc->set(custnum_pending => 1);
427 my $error = $loc->replace;
429 $dbh->rollback if $oldAutoCommit;
430 my $label = $l eq 'ship_location' ? 'service' : 'billing';
431 return "$error (moving $label location)";
434 } elsif ( ($loc->custnum || 0) > 0 ) {
435 # then it somehow belongs to another customer--shouldn't happen
436 $dbh->rollback if $oldAutoCommit;
437 return "$l belongs to customer ".$loc->custnum;
439 # else it already belongs to this customer
440 # (happens when ship_location is identical to bill_location)
442 $self->set($l.'num', $loc->locationnum);
444 if ( $self->get($l.'num') eq '' ) {
445 $dbh->rollback if $oldAutoCommit;
450 warn " inserting $self\n"
453 $self->signupdate(time) unless $self->signupdate;
455 $self->auto_agent_custid()
456 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
458 my $error = $self->SUPER::insert;
460 $dbh->rollback if $oldAutoCommit;
461 #return "inserting cust_main record (transaction rolled back): $error";
465 # now set cust_location.custnum
466 foreach my $l (qw(bill_location ship_location)) {
467 warn " setting $l.custnum\n"
470 unless ( $loc->custnum ) {
471 $loc->set(custnum => $self->custnum);
472 $error ||= $loc->replace;
476 $dbh->rollback if $oldAutoCommit;
477 return "error setting $l custnum: $error";
481 warn " setting invoicing list\n"
484 if ( $invoicing_list ) {
485 $error = $self->check_invoicing_list( $invoicing_list );
487 $dbh->rollback if $oldAutoCommit;
488 #return "checking invoicing_list (transaction rolled back): $error";
491 $self->invoicing_list( $invoicing_list );
494 warn " setting customer tags\n"
497 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
498 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
499 'custnum' => $self->custnum };
500 my $error = $cust_tag->insert;
502 $dbh->rollback if $oldAutoCommit;
507 my $prospectnum = delete $options{'prospectnum'};
508 if ( $prospectnum ) {
510 warn " moving contacts and locations from prospect $prospectnum\n"
514 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
515 unless ( $prospect_main ) {
516 $dbh->rollback if $oldAutoCommit;
517 return "Unknown prospectnum $prospectnum";
519 $prospect_main->custnum($self->custnum);
520 $prospect_main->disabled('Y');
521 my $error = $prospect_main->replace;
523 $dbh->rollback if $oldAutoCommit;
527 my @contact = $prospect_main->contact;
528 my @cust_location = $prospect_main->cust_location;
529 my @qual = $prospect_main->qual;
531 foreach my $r ( @contact, @cust_location, @qual ) {
533 $r->custnum($self->custnum);
534 my $error = $r->replace;
536 $dbh->rollback if $oldAutoCommit;
543 warn " setting contacts\n"
546 if ( my $contact = delete $options{'contact'} ) {
548 foreach my $c ( @$contact ) {
549 $c->custnum($self->custnum);
550 my $error = $c->insert;
552 $dbh->rollback if $oldAutoCommit;
558 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
560 my $error = $self->process_o2m( 'table' => 'contact',
561 'fields' => FS::contact->cgi_contact_fields,
562 'params' => $contact_params,
565 $dbh->rollback if $oldAutoCommit;
570 warn " setting cust_main_exemption\n"
573 my $tax_exemption = delete $options{'tax_exemption'};
574 if ( $tax_exemption ) {
576 $tax_exemption = { map { $_ => '' } @$tax_exemption }
577 if ref($tax_exemption) eq 'ARRAY';
579 foreach my $taxname ( keys %$tax_exemption ) {
580 my $cust_main_exemption = new FS::cust_main_exemption {
581 'custnum' => $self->custnum,
582 'taxname' => $taxname,
583 'exempt_number' => $tax_exemption->{$taxname},
585 my $error = $cust_main_exemption->insert;
587 $dbh->rollback if $oldAutoCommit;
588 return "inserting cust_main_exemption (transaction rolled back): $error";
593 warn " ordering packages\n"
596 $error = $self->order_pkgs( $cust_pkgs,
598 'seconds_ref' => \$seconds,
599 'upbytes_ref' => \$upbytes,
600 'downbytes_ref' => \$downbytes,
601 'totalbytes_ref' => \$totalbytes,
604 $dbh->rollback if $oldAutoCommit;
609 $dbh->rollback if $oldAutoCommit;
610 return "No svc_acct record to apply pre-paid time";
612 if ( $upbytes || $downbytes || $totalbytes ) {
613 $dbh->rollback if $oldAutoCommit;
614 return "No svc_acct record to apply pre-paid data";
618 warn " inserting initial $payby payment of $amount\n"
620 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
622 $dbh->rollback if $oldAutoCommit;
623 return "inserting payment (transaction rolled back): $error";
627 unless ( $import || $skip_fuzzyfiles ) {
628 warn " queueing fuzzyfiles update\n"
630 $error = $self->queue_fuzzyfiles_update;
632 $dbh->rollback if $oldAutoCommit;
633 return "updating fuzzy search cache: $error";
637 # FS::geocode_Mixin::after_insert or something?
638 if ( $conf->config('tax_district_method') and !$import ) {
639 # if anything non-empty, try to look it up
640 my $queue = new FS::queue {
641 'job' => 'FS::geocode_Mixin::process_district_update',
642 'custnum' => $self->custnum,
644 my $error = $queue->insert( ref($self), $self->custnum );
646 $dbh->rollback if $oldAutoCommit;
647 return "queueing tax district update: $error";
652 warn " exporting\n" if $DEBUG > 1;
654 my $export_args = $options{'export_args'} || [];
657 map qsearch( 'part_export', {exportnum=>$_} ),
658 $conf->config('cust_main-exports'); #, $agentnum
660 foreach my $part_export ( @part_export ) {
661 my $error = $part_export->export_insert($self, @$export_args);
663 $dbh->rollback if $oldAutoCommit;
664 return "exporting to ". $part_export->exporttype.
665 " (transaction rolled back): $error";
669 #foreach my $depend_jobnum ( @$depend_jobnums ) {
670 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
672 # foreach my $jobnum ( @jobnums ) {
673 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
674 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
676 # my $error = $queue->depend_insert($depend_jobnum);
678 # $dbh->rollback if $oldAutoCommit;
679 # return "error queuing job dependancy: $error";
686 #if ( exists $options{'jobnums'} ) {
687 # push @{ $options{'jobnums'} }, @jobnums;
690 warn " insert complete; committing transaction\n"
693 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
698 use File::CounterFile;
699 sub auto_agent_custid {
702 my $format = $conf->config('cust_main-auto_agent_custid');
704 if ( $format eq '1YMMXXXXXXXX' ) {
706 my $counter = new File::CounterFile 'cust_main.agent_custid';
709 my $ym = 100000000000 + time2str('%y%m00000000', time);
710 if ( $ym > $counter->value ) {
711 $counter->{'value'} = $agent_custid = $ym;
712 $counter->{'updated'} = 1;
714 $agent_custid = $counter->inc;
720 die "Unknown cust_main-auto_agent_custid format: $format";
723 $self->agent_custid($agent_custid);
727 =item PACKAGE METHODS
729 Documentation on customer package methods has been moved to
730 L<FS::cust_main::Packages>.
732 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
734 Recharges this (existing) customer with the specified prepaid card (see
735 L<FS::prepay_credit>), specified either by I<identifier> or as an
736 FS::prepay_credit object. If there is an error, returns the error, otherwise
739 Optionally, five scalar references can be passed as well. They will have their
740 values filled in with the amount, number of seconds, and number of upload,
741 download, and total bytes applied by this prepaid card.
745 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
746 #the only place that uses these args
747 sub recharge_prepay {
748 my( $self, $prepay_credit, $amountref, $secondsref,
749 $upbytesref, $downbytesref, $totalbytesref ) = @_;
751 local $SIG{HUP} = 'IGNORE';
752 local $SIG{INT} = 'IGNORE';
753 local $SIG{QUIT} = 'IGNORE';
754 local $SIG{TERM} = 'IGNORE';
755 local $SIG{TSTP} = 'IGNORE';
756 local $SIG{PIPE} = 'IGNORE';
758 my $oldAutoCommit = $FS::UID::AutoCommit;
759 local $FS::UID::AutoCommit = 0;
762 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
764 my $error = $self->get_prepay( $prepay_credit,
765 'amount_ref' => \$amount,
766 'seconds_ref' => \$seconds,
767 'upbytes_ref' => \$upbytes,
768 'downbytes_ref' => \$downbytes,
769 'totalbytes_ref' => \$totalbytes,
771 || $self->increment_seconds($seconds)
772 || $self->increment_upbytes($upbytes)
773 || $self->increment_downbytes($downbytes)
774 || $self->increment_totalbytes($totalbytes)
775 || $self->insert_cust_pay_prepay( $amount,
777 ? $prepay_credit->identifier
782 $dbh->rollback if $oldAutoCommit;
786 if ( defined($amountref) ) { $$amountref = $amount; }
787 if ( defined($secondsref) ) { $$secondsref = $seconds; }
788 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
789 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
790 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
792 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
797 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
799 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
800 specified either by I<identifier> or as an FS::prepay_credit object.
802 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
803 incremented by the values of the prepaid card.
805 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
806 check or set this customer's I<agentnum>.
808 If there is an error, returns the error, otherwise returns false.
814 my( $self, $prepay_credit, %opt ) = @_;
816 local $SIG{HUP} = 'IGNORE';
817 local $SIG{INT} = 'IGNORE';
818 local $SIG{QUIT} = 'IGNORE';
819 local $SIG{TERM} = 'IGNORE';
820 local $SIG{TSTP} = 'IGNORE';
821 local $SIG{PIPE} = 'IGNORE';
823 my $oldAutoCommit = $FS::UID::AutoCommit;
824 local $FS::UID::AutoCommit = 0;
827 unless ( ref($prepay_credit) ) {
829 my $identifier = $prepay_credit;
831 $prepay_credit = qsearchs(
833 { 'identifier' => $identifier },
838 unless ( $prepay_credit ) {
839 $dbh->rollback if $oldAutoCommit;
840 return "Invalid prepaid card: ". $identifier;
845 if ( $prepay_credit->agentnum ) {
846 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
847 $dbh->rollback if $oldAutoCommit;
848 return "prepaid card not valid for agent ". $self->agentnum;
850 $self->agentnum($prepay_credit->agentnum);
853 my $error = $prepay_credit->delete;
855 $dbh->rollback if $oldAutoCommit;
856 return "removing prepay_credit (transaction rolled back): $error";
859 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
860 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
862 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
867 =item increment_upbytes SECONDS
869 Updates this customer's single or primary account (see L<FS::svc_acct>) by
870 the specified number of upbytes. If there is an error, returns the error,
871 otherwise returns false.
875 sub increment_upbytes {
876 _increment_column( shift, 'upbytes', @_);
879 =item increment_downbytes SECONDS
881 Updates this customer's single or primary account (see L<FS::svc_acct>) by
882 the specified number of downbytes. If there is an error, returns the error,
883 otherwise returns false.
887 sub increment_downbytes {
888 _increment_column( shift, 'downbytes', @_);
891 =item increment_totalbytes SECONDS
893 Updates this customer's single or primary account (see L<FS::svc_acct>) by
894 the specified number of totalbytes. If there is an error, returns the error,
895 otherwise returns false.
899 sub increment_totalbytes {
900 _increment_column( shift, 'totalbytes', @_);
903 =item increment_seconds SECONDS
905 Updates this customer's single or primary account (see L<FS::svc_acct>) by
906 the specified number of seconds. If there is an error, returns the error,
907 otherwise returns false.
911 sub increment_seconds {
912 _increment_column( shift, 'seconds', @_);
915 =item _increment_column AMOUNT
917 Updates this customer's single or primary account (see L<FS::svc_acct>) by
918 the specified number of seconds or bytes. If there is an error, returns
919 the error, otherwise returns false.
923 sub _increment_column {
924 my( $self, $column, $amount ) = @_;
925 warn "$me increment_column called: $column, $amount\n"
928 return '' unless $amount;
930 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
931 $self->ncancelled_pkgs;
934 return 'No packages with primary or single services found'.
935 ' to apply pre-paid time';
936 } elsif ( scalar(@cust_pkg) > 1 ) {
937 #maybe have a way to specify the package/account?
938 return 'Multiple packages found to apply pre-paid time';
941 my $cust_pkg = $cust_pkg[0];
942 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
946 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
949 return 'No account found to apply pre-paid time';
950 } elsif ( scalar(@cust_svc) > 1 ) {
951 return 'Multiple accounts found to apply pre-paid time';
954 my $svc_acct = $cust_svc[0]->svc_x;
955 warn " found service svcnum ". $svc_acct->pkgnum.
956 ' ('. $svc_acct->email. ")\n"
959 $column = "increment_$column";
960 $svc_acct->$column($amount);
964 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
966 Inserts a prepayment in the specified amount for this customer. An optional
967 second argument can specify the prepayment identifier for tracking purposes.
968 If there is an error, returns the error, otherwise returns false.
972 sub insert_cust_pay_prepay {
973 shift->insert_cust_pay('PREP', @_);
976 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
978 Inserts a cash payment in the specified amount for this customer. An optional
979 second argument can specify the payment identifier for tracking purposes.
980 If there is an error, returns the error, otherwise returns false.
984 sub insert_cust_pay_cash {
985 shift->insert_cust_pay('CASH', @_);
988 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
990 Inserts a Western Union payment in the specified amount for this customer. An
991 optional second argument can specify the prepayment identifier for tracking
992 purposes. If there is an error, returns the error, otherwise returns false.
996 sub insert_cust_pay_west {
997 shift->insert_cust_pay('WEST', @_);
1000 sub insert_cust_pay {
1001 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1002 my $payinfo = scalar(@_) ? shift : '';
1004 my $cust_pay = new FS::cust_pay {
1005 'custnum' => $self->custnum,
1006 'paid' => sprintf('%.2f', $amount),
1007 #'_date' => #date the prepaid card was purchased???
1009 'payinfo' => $payinfo,
1017 This method is deprecated. See the I<depend_jobnum> option to the insert and
1018 order_pkgs methods for a better way to defer provisioning.
1020 Re-schedules all exports by calling the B<reexport> method of all associated
1021 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1022 otherwise returns false.
1029 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1030 "use the depend_jobnum option to insert or order_pkgs to delay export";
1032 local $SIG{HUP} = 'IGNORE';
1033 local $SIG{INT} = 'IGNORE';
1034 local $SIG{QUIT} = 'IGNORE';
1035 local $SIG{TERM} = 'IGNORE';
1036 local $SIG{TSTP} = 'IGNORE';
1037 local $SIG{PIPE} = 'IGNORE';
1039 my $oldAutoCommit = $FS::UID::AutoCommit;
1040 local $FS::UID::AutoCommit = 0;
1043 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1044 my $error = $cust_pkg->reexport;
1046 $dbh->rollback if $oldAutoCommit;
1051 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1056 =item delete [ OPTION => VALUE ... ]
1058 This deletes the customer. If there is an error, returns the error, otherwise
1061 This will completely remove all traces of the customer record. This is not
1062 what you want when a customer cancels service; for that, cancel all of the
1063 customer's packages (see L</cancel>).
1065 If the customer has any uncancelled packages, you need to pass a new (valid)
1066 customer number for those packages to be transferred to, as the "new_customer"
1067 option. Cancelled packages will be deleted. Did I mention that this is NOT
1068 what you want when a customer cancels service and that you really should be
1069 looking at L<FS::cust_pkg/cancel>?
1071 You can't delete a customer with invoices (see L<FS::cust_bill>),
1072 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1073 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1074 set the "delete_financials" option to a true value.
1079 my( $self, %opt ) = @_;
1081 local $SIG{HUP} = 'IGNORE';
1082 local $SIG{INT} = 'IGNORE';
1083 local $SIG{QUIT} = 'IGNORE';
1084 local $SIG{TERM} = 'IGNORE';
1085 local $SIG{TSTP} = 'IGNORE';
1086 local $SIG{PIPE} = 'IGNORE';
1088 my $oldAutoCommit = $FS::UID::AutoCommit;
1089 local $FS::UID::AutoCommit = 0;
1092 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1093 $dbh->rollback if $oldAutoCommit;
1094 return "Can't delete a master agent customer";
1097 #use FS::access_user
1098 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1099 $dbh->rollback if $oldAutoCommit;
1100 return "Can't delete a master employee customer";
1103 tie my %financial_tables, 'Tie::IxHash',
1104 'cust_bill' => 'invoices',
1105 'cust_statement' => 'statements',
1106 'cust_credit' => 'credits',
1107 'cust_pay' => 'payments',
1108 'cust_refund' => 'refunds',
1111 foreach my $table ( keys %financial_tables ) {
1113 my @records = $self->$table();
1115 if ( @records && ! $opt{'delete_financials'} ) {
1116 $dbh->rollback if $oldAutoCommit;
1117 return "Can't delete a customer with ". $financial_tables{$table};
1120 foreach my $record ( @records ) {
1121 my $error = $record->delete;
1123 $dbh->rollback if $oldAutoCommit;
1124 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1130 my @cust_pkg = $self->ncancelled_pkgs;
1132 my $new_custnum = $opt{'new_custnum'};
1133 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1134 $dbh->rollback if $oldAutoCommit;
1135 return "Invalid new customer number: $new_custnum";
1137 foreach my $cust_pkg ( @cust_pkg ) {
1138 my %hash = $cust_pkg->hash;
1139 $hash{'custnum'} = $new_custnum;
1140 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1141 my $error = $new_cust_pkg->replace($cust_pkg,
1142 options => { $cust_pkg->options },
1145 $dbh->rollback if $oldAutoCommit;
1150 my @cancelled_cust_pkg = $self->all_pkgs;
1151 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1152 my $error = $cust_pkg->delete;
1154 $dbh->rollback if $oldAutoCommit;
1159 #cust_tax_adjustment in financials?
1160 #cust_pay_pending? ouch
1162 foreach my $table (qw(
1163 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1164 cust_location cust_main_note cust_tax_adjustment
1165 cust_pay_void cust_pay_batch queue cust_tax_exempt
1167 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1168 my $error = $record->delete;
1170 $dbh->rollback if $oldAutoCommit;
1176 my $sth = $dbh->prepare(
1177 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1179 my $errstr = $dbh->errstr;
1180 $dbh->rollback if $oldAutoCommit;
1183 $sth->execute($self->custnum) or do {
1184 my $errstr = $sth->errstr;
1185 $dbh->rollback if $oldAutoCommit;
1191 my $ticket_dbh = '';
1192 if ($conf->config('ticket_system') eq 'RT_Internal') {
1194 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1195 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1196 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1197 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1200 if ( $ticket_dbh ) {
1202 my $ticket_sth = $ticket_dbh->prepare(
1203 'DELETE FROM Links WHERE Target = ?'
1205 my $errstr = $ticket_dbh->errstr;
1206 $dbh->rollback if $oldAutoCommit;
1209 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1211 my $errstr = $ticket_sth->errstr;
1212 $dbh->rollback if $oldAutoCommit;
1216 #check and see if the customer is the only link on the ticket, and
1217 #if so, set the ticket to deleted status in RT?
1218 #maybe someday, for now this will at least fix tickets not displaying
1222 #delete the customer record
1224 my $error = $self->SUPER::delete;
1226 $dbh->rollback if $oldAutoCommit;
1230 # cust_main exports!
1232 #my $export_args = $options{'export_args'} || [];
1235 map qsearch( 'part_export', {exportnum=>$_} ),
1236 $conf->config('cust_main-exports'); #, $agentnum
1238 foreach my $part_export ( @part_export ) {
1239 my $error = $part_export->export_delete( $self ); #, @$export_args);
1241 $dbh->rollback if $oldAutoCommit;
1242 return "exporting to ". $part_export->exporttype.
1243 " (transaction rolled back): $error";
1247 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1252 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1254 This merges this customer into the provided new custnum, and then deletes the
1255 customer. If there is an error, returns the error, otherwise returns false.
1257 The source customer's name, company name, phone numbers, agent,
1258 referring customer, customer class, advertising source, order taker, and
1259 billing information (except balance) are discarded.
1261 All packages are moved to the target customer. Packages with package locations
1262 are preserved. Packages without package locations are moved to a new package
1263 location with the source customer's service/shipping address.
1265 All invoices, statements, payments, credits and refunds are moved to the target
1266 customer. The source customer's balance is added to the target customer.
1268 All notes, attachments, tickets and customer tags are moved to the target
1271 Change history is not currently moved.
1276 my( $self, $new_custnum, %opt ) = @_;
1278 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1280 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
1281 or return "Invalid new customer number: $new_custnum";
1283 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
1284 if $self->agentnum != $new_cust_main->agentnum
1285 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
1287 local $SIG{HUP} = 'IGNORE';
1288 local $SIG{INT} = 'IGNORE';
1289 local $SIG{QUIT} = 'IGNORE';
1290 local $SIG{TERM} = 'IGNORE';
1291 local $SIG{TSTP} = 'IGNORE';
1292 local $SIG{PIPE} = 'IGNORE';
1294 my $oldAutoCommit = $FS::UID::AutoCommit;
1295 local $FS::UID::AutoCommit = 0;
1298 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1299 $dbh->rollback if $oldAutoCommit;
1300 return "Can't merge a master agent customer";
1303 #use FS::access_user
1304 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1305 $dbh->rollback if $oldAutoCommit;
1306 return "Can't merge a master employee customer";
1309 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1310 'status' => { op=>'!=', value=>'done' },
1314 $dbh->rollback if $oldAutoCommit;
1315 return "Can't merge a customer with pending payments";
1318 tie my %financial_tables, 'Tie::IxHash',
1319 'cust_bill' => 'invoices',
1320 'cust_bill_void' => 'voided invoices',
1321 'cust_statement' => 'statements',
1322 'cust_credit' => 'credits',
1323 'cust_credit_void' => 'voided credits',
1324 'cust_pay' => 'payments',
1325 'cust_pay_void' => 'voided payments',
1326 'cust_refund' => 'refunds',
1329 foreach my $table ( keys %financial_tables ) {
1331 my @records = $self->$table();
1333 foreach my $record ( @records ) {
1334 $record->custnum($new_custnum);
1335 my $error = $record->replace;
1337 $dbh->rollback if $oldAutoCommit;
1338 return "Error merging ". $financial_tables{$table}. ": $error\n";
1344 my $name = $self->ship_name; #?
1346 my $locationnum = '';
1347 foreach my $cust_pkg ( $self->all_pkgs ) {
1348 $cust_pkg->custnum($new_custnum);
1350 unless ( $cust_pkg->locationnum ) {
1351 unless ( $locationnum ) {
1352 my $cust_location = new FS::cust_location {
1353 $self->location_hash,
1354 'custnum' => $new_custnum,
1356 my $error = $cust_location->insert;
1358 $dbh->rollback if $oldAutoCommit;
1361 $locationnum = $cust_location->locationnum;
1363 $cust_pkg->locationnum($locationnum);
1366 my $error = $cust_pkg->replace;
1368 $dbh->rollback if $oldAutoCommit;
1372 # add customer (ship) name to svc_phone.phone_name if blank
1373 my @cust_svc = $cust_pkg->cust_svc;
1374 foreach my $cust_svc (@cust_svc) {
1375 my($label, $value, $svcdb) = $cust_svc->label;
1376 next unless $svcdb eq 'svc_phone';
1377 my $svc_phone = $cust_svc->svc_x;
1378 next if $svc_phone->phone_name;
1379 $svc_phone->phone_name($name);
1380 my $error = $svc_phone->replace;
1382 $dbh->rollback if $oldAutoCommit;
1390 # cust_tax_exempt (texas tax exemptions)
1391 # cust_recon (some sort of not-well understood thing for OnPac)
1393 #these are moved over
1394 foreach my $table (qw(
1395 cust_tag cust_location contact cust_attachment cust_main_note
1396 cust_tax_adjustment cust_pay_batch queue
1398 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1399 $record->custnum($new_custnum);
1400 my $error = $record->replace;
1402 $dbh->rollback if $oldAutoCommit;
1408 #these aren't preserved
1409 foreach my $table (qw(
1410 cust_main_exemption cust_main_invoice
1412 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1413 my $error = $record->delete;
1415 $dbh->rollback if $oldAutoCommit;
1422 my $sth = $dbh->prepare(
1423 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1425 my $errstr = $dbh->errstr;
1426 $dbh->rollback if $oldAutoCommit;
1429 $sth->execute($new_custnum, $self->custnum) or do {
1430 my $errstr = $sth->errstr;
1431 $dbh->rollback if $oldAutoCommit;
1437 my $ticket_dbh = '';
1438 if ($conf->config('ticket_system') eq 'RT_Internal') {
1440 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1441 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1442 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1443 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1446 if ( $ticket_dbh ) {
1448 my $ticket_sth = $ticket_dbh->prepare(
1449 'UPDATE Links SET Target = ? WHERE Target = ?'
1451 my $errstr = $ticket_dbh->errstr;
1452 $dbh->rollback if $oldAutoCommit;
1455 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1456 'freeside://freeside/cust_main/'.$self->custnum)
1458 my $errstr = $ticket_sth->errstr;
1459 $dbh->rollback if $oldAutoCommit;
1465 #delete the customer record
1467 my $error = $self->delete;
1469 $dbh->rollback if $oldAutoCommit;
1473 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1478 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1480 Replaces the OLD_RECORD with this one in the database. If there is an error,
1481 returns the error, otherwise returns false.
1483 To change the customer's address, set the pseudo-fields C<bill_location> and
1484 C<ship_location>. The address will still only change if at least one of the
1485 address fields differs from the existing values.
1487 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1488 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1489 expected and rollback the entire transaction; it is not necessary to call
1490 check_invoicing_list first. Here's an example:
1492 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1494 Currently available options are: I<tax_exemption>.
1496 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1497 of tax names and exemption numbers. FS::cust_main_exemption records will be
1498 deleted and inserted as appropriate.
1505 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1507 : $self->replace_old;
1511 warn "$me replace called\n"
1514 my $curuser = $FS::CurrentUser::CurrentUser;
1515 if ( $self->payby eq 'COMP'
1516 && $self->payby ne $old->payby
1517 && ! $curuser->access_right('Complimentary customer')
1520 return "You are not permitted to create complimentary accounts.";
1523 local($ignore_expired_card) = 1
1524 if $old->payby =~ /^(CARD|DCRD)$/
1525 && $self->payby =~ /^(CARD|DCRD)$/
1526 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1528 local($ignore_banned_card) = 1
1529 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1530 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1531 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1533 return "Invoicing locale is required"
1536 && $conf->exists('cust_main-require_locale');
1538 local $SIG{HUP} = 'IGNORE';
1539 local $SIG{INT} = 'IGNORE';
1540 local $SIG{QUIT} = 'IGNORE';
1541 local $SIG{TERM} = 'IGNORE';
1542 local $SIG{TSTP} = 'IGNORE';
1543 local $SIG{PIPE} = 'IGNORE';
1545 my $oldAutoCommit = $FS::UID::AutoCommit;
1546 local $FS::UID::AutoCommit = 0;
1549 for my $l (qw(bill_location ship_location)) {
1550 my $old_loc = $old->$l;
1551 my $new_loc = $self->$l;
1553 # find the existing location if there is one
1554 $new_loc->set('custnum' => $self->custnum);
1555 my $error = $new_loc->find_or_insert;
1557 $dbh->rollback if $oldAutoCommit;
1560 $self->set($l.'num', $new_loc->locationnum);
1563 # replace the customer record
1564 my $error = $self->SUPER::replace($old);
1567 $dbh->rollback if $oldAutoCommit;
1571 # now move packages to the new service location
1572 $self->set('ship_location', ''); #flush cache
1573 if ( $old->ship_locationnum and # should only be null during upgrade...
1574 $old->ship_locationnum != $self->ship_locationnum ) {
1575 $error = $old->ship_location->move_to($self->ship_location);
1577 $dbh->rollback if $oldAutoCommit;
1581 # don't move packages based on the billing location, but
1582 # disable it if it's no longer in use
1583 if ( $old->bill_locationnum and
1584 $old->bill_locationnum != $self->bill_locationnum ) {
1585 $error = $old->bill_location->disable_if_unused;
1587 $dbh->rollback if $oldAutoCommit;
1592 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1593 my $invoicing_list = shift @param;
1594 $error = $self->check_invoicing_list( $invoicing_list );
1596 $dbh->rollback if $oldAutoCommit;
1599 $self->invoicing_list( $invoicing_list );
1602 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1604 #this could be more efficient than deleting and re-inserting, if it matters
1605 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1606 my $error = $cust_tag->delete;
1608 $dbh->rollback if $oldAutoCommit;
1612 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1613 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1614 'custnum' => $self->custnum };
1615 my $error = $cust_tag->insert;
1617 $dbh->rollback if $oldAutoCommit;
1624 my %options = @param;
1626 my $tax_exemption = delete $options{'tax_exemption'};
1627 if ( $tax_exemption ) {
1629 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1630 if ref($tax_exemption) eq 'ARRAY';
1632 my %cust_main_exemption =
1633 map { $_->taxname => $_ }
1634 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1636 foreach my $taxname ( keys %$tax_exemption ) {
1638 if ( $cust_main_exemption{$taxname} &&
1639 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1642 delete $cust_main_exemption{$taxname};
1646 my $cust_main_exemption = new FS::cust_main_exemption {
1647 'custnum' => $self->custnum,
1648 'taxname' => $taxname,
1649 'exempt_number' => $tax_exemption->{$taxname},
1651 my $error = $cust_main_exemption->insert;
1653 $dbh->rollback if $oldAutoCommit;
1654 return "inserting cust_main_exemption (transaction rolled back): $error";
1658 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1659 my $error = $cust_main_exemption->delete;
1661 $dbh->rollback if $oldAutoCommit;
1662 return "deleting cust_main_exemption (transaction rolled back): $error";
1668 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1669 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1670 && $self->get('payinfo') !~ /^99\d{14}$/
1672 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1677 # card/check/lec info has changed, want to retry realtime_ invoice events
1678 my $error = $self->retry_realtime;
1680 $dbh->rollback if $oldAutoCommit;
1685 unless ( $import || $skip_fuzzyfiles ) {
1686 $error = $self->queue_fuzzyfiles_update;
1688 $dbh->rollback if $oldAutoCommit;
1689 return "updating fuzzy search cache: $error";
1693 # tax district update in cust_location
1695 # cust_main exports!
1697 my $export_args = $options{'export_args'} || [];
1700 map qsearch( 'part_export', {exportnum=>$_} ),
1701 $conf->config('cust_main-exports'); #, $agentnum
1703 foreach my $part_export ( @part_export ) {
1704 my $error = $part_export->export_replace( $self, $old, @$export_args);
1706 $dbh->rollback if $oldAutoCommit;
1707 return "exporting to ". $part_export->exporttype.
1708 " (transaction rolled back): $error";
1712 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1717 =item queue_fuzzyfiles_update
1719 Used by insert & replace to update the fuzzy search cache
1723 use FS::cust_main::Search;
1724 sub queue_fuzzyfiles_update {
1727 local $SIG{HUP} = 'IGNORE';
1728 local $SIG{INT} = 'IGNORE';
1729 local $SIG{QUIT} = 'IGNORE';
1730 local $SIG{TERM} = 'IGNORE';
1731 local $SIG{TSTP} = 'IGNORE';
1732 local $SIG{PIPE} = 'IGNORE';
1734 my $oldAutoCommit = $FS::UID::AutoCommit;
1735 local $FS::UID::AutoCommit = 0;
1738 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1739 my $queue = new FS::queue {
1740 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1742 my @args = "cust_main.$field", $self->get($field);
1743 my $error = $queue->insert( @args );
1745 $dbh->rollback if $oldAutoCommit;
1746 return "queueing job (transaction rolled back): $error";
1750 my @locations = $self->bill_location;
1751 push @locations, $self->ship_location if $self->has_ship_address;
1752 foreach my $location (@locations) {
1753 my $queue = new FS::queue {
1754 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1756 my @args = 'cust_location.address1', $location->address1;
1757 my $error = $queue->insert( @args );
1759 $dbh->rollback if $oldAutoCommit;
1760 return "queueing job (transaction rolled back): $error";
1764 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1771 Checks all fields to make sure this is a valid customer record. If there is
1772 an error, returns the error, otherwise returns false. Called by the insert
1773 and replace methods.
1780 warn "$me check BEFORE: \n". $self->_dump
1784 $self->ut_numbern('custnum')
1785 || $self->ut_number('agentnum')
1786 || $self->ut_textn('agent_custid')
1787 || $self->ut_number('refnum')
1788 || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
1789 || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
1790 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1791 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1792 || $self->ut_textn('custbatch')
1793 || $self->ut_name('last')
1794 || $self->ut_name('first')
1795 || $self->ut_snumbern('signupdate')
1796 || $self->ut_snumbern('birthdate')
1797 || $self->ut_namen('spouse_last')
1798 || $self->ut_namen('spouse_first')
1799 || $self->ut_snumbern('spouse_birthdate')
1800 || $self->ut_snumbern('anniversary_date')
1801 || $self->ut_textn('company')
1802 || $self->ut_textn('ship_company')
1803 || $self->ut_anything('comments')
1804 || $self->ut_numbern('referral_custnum')
1805 || $self->ut_textn('stateid')
1806 || $self->ut_textn('stateid_state')
1807 || $self->ut_textn('invoice_terms')
1808 || $self->ut_floatn('cdr_termination_percentage')
1809 || $self->ut_floatn('credit_limit')
1810 || $self->ut_numbern('billday')
1811 || $self->ut_numbern('prorate_day')
1812 || $self->ut_flag('edit_subject')
1813 || $self->ut_flag('calling_list_exempt')
1814 || $self->ut_flag('invoice_noemail')
1815 || $self->ut_flag('message_noemail')
1816 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1817 || $self->ut_flag('invoice_ship_address')
1820 foreach (qw(company ship_company)) {
1821 my $company = $self->get($_);
1822 $company =~ s/^\s+//;
1823 $company =~ s/\s+$//;
1824 $company =~ s/\s+/ /g;
1825 $self->set($_, $company);
1828 #barf. need message catalogs. i18n. etc.
1829 $error .= "Please select an advertising source."
1830 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1831 return $error if $error;
1833 return "Unknown agent"
1834 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1836 return "Unknown refnum"
1837 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1839 return "Unknown referring custnum: ". $self->referral_custnum
1840 unless ! $self->referral_custnum
1841 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1843 if ( $self->ss eq '' ) {
1848 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1849 or return "Illegal social security number: ". $self->ss;
1850 $self->ss("$1-$2-$3");
1853 #turn off invoice_ship_address if ship & bill are the same
1854 if ($self->bill_locationnum eq $self->ship_locationnum) {
1855 $self->invoice_ship_address('');
1858 # cust_main_county verification now handled by cust_location check
1861 $self->ut_phonen('daytime', $self->country)
1862 || $self->ut_phonen('night', $self->country)
1863 || $self->ut_phonen('fax', $self->country)
1864 || $self->ut_phonen('mobile', $self->country)
1866 return $error if $error;
1868 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1870 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1873 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1875 : FS::Msgcat::_gettext('daytime');
1876 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1878 : FS::Msgcat::_gettext('night');
1880 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1882 : FS::Msgcat::_gettext('mobile');
1884 return "$daytime_label, $night_label or $mobile_label is required"
1888 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1889 # or return "Illegal payby: ". $self->payby;
1891 FS::payby->can_payby($self->table, $self->payby)
1892 or return "Illegal payby: ". $self->payby;
1894 $error = $self->ut_numbern('paystart_month')
1895 || $self->ut_numbern('paystart_year')
1896 || $self->ut_numbern('payissue')
1897 || $self->ut_textn('paytype')
1899 return $error if $error;
1901 if ( $self->payip eq '' ) {
1904 $error = $self->ut_ip('payip');
1905 return $error if $error;
1908 # If it is encrypted and the private key is not availaible then we can't
1909 # check the credit card.
1910 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1912 # Need some kind of global flag to accept invalid cards, for testing
1914 if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1916 my $payinfo = $self->payinfo;
1917 $payinfo =~ s/\D//g;
1918 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1919 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1921 $self->payinfo($payinfo);
1923 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1925 return gettext('unknown_card_type')
1926 if $self->payinfo !~ /^99\d{14}$/ #token
1927 && cardtype($self->payinfo) eq "Unknown";
1929 unless ( $ignore_banned_card ) {
1930 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1932 if ( $ban->bantype eq 'warn' ) {
1933 #or others depending on value of $ban->reason ?
1934 return '_duplicate_card'.
1935 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1936 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1937 ' (ban# '. $ban->bannum. ')'
1938 unless $self->override_ban_warn;
1940 return 'Banned credit card: banned on '.
1941 time2str('%a %h %o at %r', $ban->_date).
1942 ' by '. $ban->otaker.
1943 ' (ban# '. $ban->bannum. ')';
1948 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1949 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1950 $self->paycvv =~ /^(\d{4})$/
1951 or return "CVV2 (CID) for American Express cards is four digits.";
1954 $self->paycvv =~ /^(\d{3})$/
1955 or return "CVV2 (CVC2/CID) is three digits.";
1962 my $cardtype = cardtype($payinfo);
1963 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1965 return "Start date or issue number is required for $cardtype cards"
1966 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1968 return "Start month must be between 1 and 12"
1969 if $self->paystart_month
1970 and $self->paystart_month < 1 || $self->paystart_month > 12;
1972 return "Start year must be 1990 or later"
1973 if $self->paystart_year
1974 and $self->paystart_year < 1990;
1976 return "Issue number must be beween 1 and 99"
1978 and $self->payissue < 1 || $self->payissue > 99;
1981 $self->paystart_month('');
1982 $self->paystart_year('');
1983 $self->payissue('');
1986 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1988 my $payinfo = $self->payinfo;
1989 $payinfo =~ s/[^\d\@\.]//g;
1990 if ( $conf->config('echeck-country') eq 'CA' ) {
1991 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1992 or return 'invalid echeck account@branch.bank';
1993 $payinfo = "$1\@$2.$3";
1994 } elsif ( $conf->config('echeck-country') eq 'US' ) {
1995 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1996 $payinfo = "$1\@$2";
1998 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1999 $payinfo = "$1\@$2";
2001 $self->payinfo($payinfo);
2004 unless ( $ignore_banned_card ) {
2005 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
2007 if ( $ban->bantype eq 'warn' ) {
2008 #or others depending on value of $ban->reason ?
2009 return '_duplicate_ach' unless $self->override_ban_warn;
2011 return 'Banned ACH account: banned on '.
2012 time2str('%a %h %o at %r', $ban->_date).
2013 ' by '. $ban->otaker.
2014 ' (ban# '. $ban->bannum. ')';
2019 } elsif ( $self->payby eq 'LECB' ) {
2021 my $payinfo = $self->payinfo;
2022 $payinfo =~ s/\D//g;
2023 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2025 $self->payinfo($payinfo);
2028 } elsif ( $self->payby eq 'BILL' ) {
2030 $error = $self->ut_textn('payinfo');
2031 return "Illegal P.O. number: ". $self->payinfo if $error;
2034 } elsif ( $self->payby eq 'COMP' ) {
2036 my $curuser = $FS::CurrentUser::CurrentUser;
2037 if ( ! $self->custnum
2038 && ! $curuser->access_right('Complimentary customer')
2041 return "You are not permitted to create complimentary accounts."
2044 $error = $self->ut_textn('payinfo');
2045 return "Illegal comp account issuer: ". $self->payinfo if $error;
2048 } elsif ( $self->payby eq 'PREPAY' ) {
2050 my $payinfo = $self->payinfo;
2051 $payinfo =~ s/\W//g; #anything else would just confuse things
2052 $self->payinfo($payinfo);
2053 $error = $self->ut_alpha('payinfo');
2054 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2055 return "Unknown prepayment identifier"
2056 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2061 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2062 return "Expiration date required"
2063 # shouldn't payinfo_check do this?
2064 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
2068 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2069 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2070 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2071 ( $m, $y ) = ( $2, "19$1" );
2072 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2073 ( $m, $y ) = ( $3, "20$2" );
2075 return "Illegal expiration date: ". $self->paydate;
2077 $m = sprintf('%02d',$m);
2078 $self->paydate("$y-$m-01");
2079 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2080 return gettext('expired_card')
2082 && !$ignore_expired_card
2083 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2086 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2087 ( ! $conf->exists('require_cardname')
2088 || $self->payby !~ /^(CARD|DCRD)$/ )
2090 $self->payname( $self->first. " ". $self->getfield('last') );
2093 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2094 $self->payname =~ /^([\w \,\.\-\']*)$/
2095 or return gettext('illegal_name'). " payname: ". $self->payname;
2098 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
2099 or return gettext('illegal_name'). " payname: ". $self->payname;
2105 return "Please select an invoicing locale"
2108 && $conf->exists('cust_main-require_locale');
2110 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2111 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2115 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2117 warn "$me check AFTER: \n". $self->_dump
2120 $self->SUPER::check;
2125 Additional checks for replace only.
2130 my ($new,$old) = @_;
2131 #preserve old value if global config is set
2132 if ($old && $conf->exists('invoice-ship_address')) {
2133 $new->invoice_ship_address($old->invoice_ship_address);
2140 Returns a list of fields which have ship_ duplicates.
2145 qw( last first company
2147 address1 address2 city county state zip country
2149 daytime night fax mobile
2153 =item has_ship_address
2155 Returns true if this customer record has a separate shipping address.
2159 sub has_ship_address {
2161 $self->bill_locationnum != $self->ship_locationnum;
2166 Returns a list of key/value pairs, with the following keys: address1,
2167 adddress2, city, county, state, zip, country, district, and geocode. The
2168 shipping address is used if present.
2174 $self->ship_location->location_hash;
2179 Returns all locations (see L<FS::cust_location>) for this customer.
2185 qsearch('cust_location', { 'custnum' => $self->custnum,
2186 'prospectnum' => '' } );
2191 Returns all contacts (see L<FS::contact>) for this customer.
2195 #already used :/ sub contact {
2198 qsearch('contact', { 'custnum' => $self->custnum } );
2203 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2204 and L<FS::cust_pkg>) for this customer, except those on hold.
2206 Returns a list: an empty list on success or a list of errors.
2212 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2217 Unsuspends all suspended packages in the on-hold state (those without setup
2218 dates) for this customer.
2224 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2229 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2231 Returns a list: an empty list on success or a list of errors.
2237 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2240 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2242 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2243 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2244 of a list of pkgparts; the hashref has the following keys:
2248 =item pkgparts - listref of pkgparts
2250 =item (other options are passed to the suspend method)
2255 Returns a list: an empty list on success or a list of errors.
2259 sub suspend_if_pkgpart {
2261 my (@pkgparts, %opt);
2262 if (ref($_[0]) eq 'HASH'){
2263 @pkgparts = @{$_[0]{pkgparts}};
2268 grep { $_->suspend(%opt) }
2269 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2270 $self->unsuspended_pkgs;
2273 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2275 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2276 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2277 instead of a list of pkgparts; the hashref has the following keys:
2281 =item pkgparts - listref of pkgparts
2283 =item (other options are passed to the suspend method)
2287 Returns a list: an empty list on success or a list of errors.
2291 sub suspend_unless_pkgpart {
2293 my (@pkgparts, %opt);
2294 if (ref($_[0]) eq 'HASH'){
2295 @pkgparts = @{$_[0]{pkgparts}};
2300 grep { $_->suspend(%opt) }
2301 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2302 $self->unsuspended_pkgs;
2305 =item cancel [ OPTION => VALUE ... ]
2307 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2309 Available options are:
2313 =item quiet - can be set true to supress email cancellation notices.
2315 =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.
2317 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2319 =item nobill - can be set true to skip billing if it might otherwise be done.
2323 Always returns a list: an empty list on success or a list of errors.
2327 # nb that dates are not specified as valid options to this method
2330 my( $self, %opt ) = @_;
2332 warn "$me cancel called on customer ". $self->custnum. " with options ".
2333 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2336 return ( 'access denied' )
2337 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2339 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2341 #should try decryption (we might have the private key)
2342 # and if not maybe queue a job for the server that does?
2343 return ( "Can't (yet) ban encrypted credit cards" )
2344 if $self->is_encrypted($self->payinfo);
2346 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2347 my $error = $ban->insert;
2348 return ( $error ) if $error;
2352 my @pkgs = $self->ncancelled_pkgs;
2354 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2356 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2357 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2361 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2362 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2365 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2368 sub _banned_pay_hashref {
2379 'payby' => $payby2ban{$self->payby},
2380 'payinfo' => $self->payinfo,
2381 #don't ever *search* on reason! #'reason' =>
2385 sub _new_banned_pay_hashref {
2387 my $hr = $self->_banned_pay_hashref;
2388 $hr->{payinfo} = md5_base64($hr->{payinfo});
2394 Returns all notes (see L<FS::cust_main_note>) for this customer.
2399 my($self,$orderby_classnum) = (shift,shift);
2400 my $orderby = "sticky DESC, _date DESC";
2401 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2402 qsearch( 'cust_main_note',
2403 { 'custnum' => $self->custnum },
2405 "ORDER BY $orderby",
2411 Returns the agent (see L<FS::agent>) for this customer.
2417 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2422 Returns the agent name (see L<FS::agent>) for this customer.
2428 $self->agent->agent;
2433 Returns any tags associated with this customer, as FS::cust_tag objects,
2434 or an empty list if there are no tags.
2440 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2445 Returns any tags associated with this customer, as FS::part_tag objects,
2446 or an empty list if there are no tags.
2452 map $_->part_tag, $self->cust_tag;
2458 Returns the customer class, as an FS::cust_class object, or the empty string
2459 if there is no customer class.
2465 if ( $self->classnum ) {
2466 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2474 Returns the customer category name, or the empty string if there is no customer
2481 my $cust_class = $self->cust_class;
2483 ? $cust_class->categoryname
2489 Returns the customer class name, or the empty string if there is no customer
2496 my $cust_class = $self->cust_class;
2498 ? $cust_class->classname
2502 =item BILLING METHODS
2504 Documentation on billing methods has been moved to
2505 L<FS::cust_main::Billing>.
2507 =item REALTIME BILLING METHODS
2509 Documentation on realtime billing methods has been moved to
2510 L<FS::cust_main::Billing_Realtime>.
2514 Removes the I<paycvv> field from the database directly.
2516 If there is an error, returns the error, otherwise returns false.
2522 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2523 or return dbh->errstr;
2524 $sth->execute($self->custnum)
2525 or return $sth->errstr;
2530 =item batch_card OPTION => VALUE...
2532 Adds a payment for this invoice to the pending credit card batch (see
2533 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2534 runs the payment using a realtime gateway.
2536 Options may include:
2538 B<amount>: the amount to be paid; defaults to the customer's balance minus
2539 any payments in transit.
2541 B<payby>: the payment method; defaults to cust_main.payby
2543 B<realtime>: runs this as a realtime payment instead of adding it to a
2546 B<invnum>: sets cust_pay_batch.invnum.
2548 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2549 the billing address for the payment; defaults to the customer's billing
2552 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2553 date, and name; defaults to those fields in cust_main.
2558 my ($self, %options) = @_;
2561 if (exists($options{amount})) {
2562 $amount = $options{amount};
2564 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2567 warn(sprintf("Customer balance %.2f - in transit amount %.2f is <= 0.\n",
2569 $self->in_transit_payments
2574 my $invnum = delete $options{invnum};
2575 my $payby = $options{payby} || $self->payby; #still dubious
2577 if ($options{'realtime'}) {
2578 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2584 my $oldAutoCommit = $FS::UID::AutoCommit;
2585 local $FS::UID::AutoCommit = 0;
2588 #this needs to handle mysql as well as Pg, like svc_acct.pm
2589 #(make it into a common function if folks need to do batching with mysql)
2590 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2591 or return "Cannot lock pay_batch: " . $dbh->errstr;
2595 'payby' => FS::payby->payby2payment($payby),
2597 $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2599 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2601 unless ( $pay_batch ) {
2602 $pay_batch = new FS::pay_batch \%pay_batch;
2603 my $error = $pay_batch->insert;
2605 $dbh->rollback if $oldAutoCommit;
2606 die "error creating new batch: $error\n";
2610 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2611 'batchnum' => $pay_batch->batchnum,
2612 'custnum' => $self->custnum,
2615 foreach (qw( address1 address2 city state zip country latitude longitude
2616 payby payinfo paydate payname ))
2618 $options{$_} = '' unless exists($options{$_});
2621 my $loc = $self->bill_location;
2623 my $cust_pay_batch = new FS::cust_pay_batch ( {
2624 'batchnum' => $pay_batch->batchnum,
2625 'invnum' => $invnum || 0, # is there a better value?
2626 # this field should be
2628 # cust_bill_pay_batch now
2629 'custnum' => $self->custnum,
2630 'last' => $self->getfield('last'),
2631 'first' => $self->getfield('first'),
2632 'address1' => $options{address1} || $loc->address1,
2633 'address2' => $options{address2} || $loc->address2,
2634 'city' => $options{city} || $loc->city,
2635 'state' => $options{state} || $loc->state,
2636 'zip' => $options{zip} || $loc->zip,
2637 'country' => $options{country} || $loc->country,
2638 'payby' => $options{payby} || $self->payby,
2639 'payinfo' => $options{payinfo} || $self->payinfo,
2640 'exp' => $options{paydate} || $self->paydate,
2641 'payname' => $options{payname} || $self->payname,
2642 'amount' => $amount, # consolidating
2645 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2646 if $old_cust_pay_batch;
2649 if ($old_cust_pay_batch) {
2650 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2652 $error = $cust_pay_batch->insert;
2656 $dbh->rollback if $oldAutoCommit;
2660 my $unapplied = $self->total_unapplied_credits
2661 + $self->total_unapplied_payments
2662 + $self->in_transit_payments;
2663 foreach my $cust_bill ($self->open_cust_bill) {
2664 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2665 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2666 'invnum' => $cust_bill->invnum,
2667 'paybatchnum' => $cust_pay_batch->paybatchnum,
2668 'amount' => $cust_bill->owed,
2671 if ($unapplied >= $cust_bill_pay_batch->amount){
2672 $unapplied -= $cust_bill_pay_batch->amount;
2675 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2676 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2678 $error = $cust_bill_pay_batch->insert;
2680 $dbh->rollback if $oldAutoCommit;
2685 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2691 Returns the total owed for this customer on all invoices
2692 (see L<FS::cust_bill/owed>).
2698 $self->total_owed_date(2145859200); #12/31/2037
2701 =item total_owed_date TIME
2703 Returns the total owed for this customer on all invoices with date earlier than
2704 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2705 see L<Time::Local> and L<Date::Parse> for conversion functions.
2709 sub total_owed_date {
2713 my $custnum = $self->custnum;
2715 my $owed_sql = FS::cust_bill->owed_sql;
2718 SELECT SUM($owed_sql) FROM cust_bill
2719 WHERE custnum = $custnum
2723 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2727 =item total_owed_pkgnum PKGNUM
2729 Returns the total owed on all invoices for this customer's specific package
2730 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2734 sub total_owed_pkgnum {
2735 my( $self, $pkgnum ) = @_;
2736 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2739 =item total_owed_date_pkgnum TIME PKGNUM
2741 Returns the total owed for this customer's specific package when using
2742 experimental package balances on all invoices with date earlier than
2743 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2744 see L<Time::Local> and L<Date::Parse> for conversion functions.
2748 sub total_owed_date_pkgnum {
2749 my( $self, $time, $pkgnum ) = @_;
2752 foreach my $cust_bill (
2753 grep { $_->_date <= $time }
2754 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2756 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2758 sprintf( "%.2f", $total_bill );
2764 Returns the total amount of all payments.
2771 $total += $_->paid foreach $self->cust_pay;
2772 sprintf( "%.2f", $total );
2775 =item total_unapplied_credits
2777 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2778 customer. See L<FS::cust_credit/credited>.
2780 =item total_credited
2782 Old name for total_unapplied_credits. Don't use.
2786 sub total_credited {
2787 #carp "total_credited deprecated, use total_unapplied_credits";
2788 shift->total_unapplied_credits(@_);
2791 sub total_unapplied_credits {
2794 my $custnum = $self->custnum;
2796 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2799 SELECT SUM($unapplied_sql) FROM cust_credit
2800 WHERE custnum = $custnum
2803 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2807 =item total_unapplied_credits_pkgnum PKGNUM
2809 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2810 customer. See L<FS::cust_credit/credited>.
2814 sub total_unapplied_credits_pkgnum {
2815 my( $self, $pkgnum ) = @_;
2816 my $total_credit = 0;
2817 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2818 sprintf( "%.2f", $total_credit );
2822 =item total_unapplied_payments
2824 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2825 See L<FS::cust_pay/unapplied>.
2829 sub total_unapplied_payments {
2832 my $custnum = $self->custnum;
2834 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2837 SELECT SUM($unapplied_sql) FROM cust_pay
2838 WHERE custnum = $custnum
2841 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2845 =item total_unapplied_payments_pkgnum PKGNUM
2847 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2848 specific package when using experimental package balances. See
2849 L<FS::cust_pay/unapplied>.
2853 sub total_unapplied_payments_pkgnum {
2854 my( $self, $pkgnum ) = @_;
2855 my $total_unapplied = 0;
2856 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2857 sprintf( "%.2f", $total_unapplied );
2861 =item total_unapplied_refunds
2863 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2864 customer. See L<FS::cust_refund/unapplied>.
2868 sub total_unapplied_refunds {
2870 my $custnum = $self->custnum;
2872 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2875 SELECT SUM($unapplied_sql) FROM cust_refund
2876 WHERE custnum = $custnum
2879 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2885 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2886 total_unapplied_credits minus total_unapplied_payments).
2892 $self->balance_date_range;
2895 =item balance_date TIME
2897 Returns the balance for this customer, only considering invoices with date
2898 earlier than TIME (total_owed_date minus total_credited minus
2899 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2900 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2907 $self->balance_date_range(shift);
2910 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2912 Returns the balance for this customer, optionally considering invoices with
2913 date earlier than START_TIME, and not later than END_TIME
2914 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2916 Times are specified as SQL fragments or numeric
2917 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2918 L<Date::Parse> for conversion functions. The empty string can be passed
2919 to disable that time constraint completely.
2921 Accepts the same options as L<balance_date_sql>:
2925 =item unapplied_date
2927 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)
2931 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2932 time will be ignored. Note that START_TIME and END_TIME only limit the date
2933 range for invoices and I<unapplied> payments, credits, and refunds.
2939 sub balance_date_range {
2941 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2942 ') FROM cust_main WHERE custnum='. $self->custnum;
2943 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2946 =item balance_pkgnum PKGNUM
2948 Returns the balance for this customer's specific package when using
2949 experimental package balances (total_owed plus total_unrefunded, minus
2950 total_unapplied_credits minus total_unapplied_payments)
2954 sub balance_pkgnum {
2955 my( $self, $pkgnum ) = @_;
2958 $self->total_owed_pkgnum($pkgnum)
2959 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2960 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2961 - $self->total_unapplied_credits_pkgnum($pkgnum)
2962 - $self->total_unapplied_payments_pkgnum($pkgnum)
2966 =item in_transit_payments
2968 Returns the total of requests for payments for this customer pending in
2969 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
2973 sub in_transit_payments {
2975 my $in_transit_payments = 0;
2976 foreach my $pay_batch ( qsearch('pay_batch', {
2979 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2980 'batchnum' => $pay_batch->batchnum,
2981 'custnum' => $self->custnum,
2984 $in_transit_payments += $cust_pay_batch->amount;
2987 sprintf( "%.2f", $in_transit_payments );
2992 Returns a hash of useful information for making a payment.
3002 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3003 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3004 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3008 For credit card transactions:
3020 For electronic check transactions:
3035 $return{balance} = $self->balance;
3037 $return{payname} = $self->payname
3038 || ( $self->first. ' '. $self->get('last') );
3040 $return{$_} = $self->bill_location->$_
3041 for qw(address1 address2 city state zip);
3043 $return{payby} = $self->payby;
3044 $return{stateid_state} = $self->stateid_state;
3046 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3047 $return{card_type} = cardtype($self->payinfo);
3048 $return{payinfo} = $self->paymask;
3050 @return{'month', 'year'} = $self->paydate_monthyear;
3054 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3055 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3056 $return{payinfo1} = $payinfo1;
3057 $return{payinfo2} = $payinfo2;
3058 $return{paytype} = $self->paytype;
3059 $return{paystate} = $self->paystate;
3063 #doubleclick protection
3065 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3071 =item paydate_monthyear
3073 Returns a two-element list consisting of the month and year of this customer's
3074 paydate (credit card expiration date for CARD customers)
3078 sub paydate_monthyear {
3080 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3082 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3091 Returns the exact time in seconds corresponding to the payment method
3092 expiration date. For CARD/DCRD customers this is the end of the month;
3093 for others (COMP is the only other payby that uses paydate) it's the start.
3094 Returns 0 if the paydate is empty or set to the far future.
3100 my ($month, $year) = $self->paydate_monthyear;
3101 return 0 if !$year or $year >= 2037;
3102 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3104 if ( $month == 13 ) {
3108 return timelocal(0,0,0,1,$month-1,$year) - 1;
3111 return timelocal(0,0,0,1,$month-1,$year);
3115 =item paydate_epoch_sql
3117 Class method. Returns an SQL expression to obtain the payment expiration date
3118 as a number of seconds.
3122 # Special expiration date behavior for non-CARD/DCRD customers has been
3123 # carefully preserved. Do we really use that?
3124 sub paydate_epoch_sql {
3126 my $table = shift || 'cust_main';
3127 my ($case1, $case2);
3128 if ( driver_name eq 'Pg' ) {
3129 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3130 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3132 elsif ( lc(driver_name) eq 'mysql' ) {
3133 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3134 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3137 return "CASE WHEN $table.payby IN('CARD','DCRD')
3143 =item tax_exemption TAXNAME
3148 my( $self, $taxname ) = @_;
3150 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3151 'taxname' => $taxname,
3156 =item cust_main_exemption
3160 sub cust_main_exemption {
3162 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3165 =item invoicing_list [ ARRAYREF ]
3167 If an arguement is given, sets these email addresses as invoice recipients
3168 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3169 (except as warnings), so use check_invoicing_list first.
3171 Returns a list of email addresses (with svcnum entries expanded).
3173 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3174 check it without disturbing anything by passing nothing.
3176 This interface may change in the future.
3180 sub invoicing_list {
3181 my( $self, $arrayref ) = @_;
3184 my @cust_main_invoice;
3185 if ( $self->custnum ) {
3186 @cust_main_invoice =
3187 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3189 @cust_main_invoice = ();
3191 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3192 #warn $cust_main_invoice->destnum;
3193 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3194 #warn $cust_main_invoice->destnum;
3195 my $error = $cust_main_invoice->delete;
3196 warn $error if $error;
3199 if ( $self->custnum ) {
3200 @cust_main_invoice =
3201 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3203 @cust_main_invoice = ();
3205 my %seen = map { $_->address => 1 } @cust_main_invoice;
3206 foreach my $address ( @{$arrayref} ) {
3207 next if exists $seen{$address} && $seen{$address};
3208 $seen{$address} = 1;
3209 my $cust_main_invoice = new FS::cust_main_invoice ( {
3210 'custnum' => $self->custnum,
3213 my $error = $cust_main_invoice->insert;
3214 warn $error if $error;
3218 if ( $self->custnum ) {
3220 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3227 =item check_invoicing_list ARRAYREF
3229 Checks these arguements as valid input for the invoicing_list method. If there
3230 is an error, returns the error, otherwise returns false.
3234 sub check_invoicing_list {
3235 my( $self, $arrayref ) = @_;
3237 foreach my $address ( @$arrayref ) {
3239 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3240 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3243 my $cust_main_invoice = new FS::cust_main_invoice ( {
3244 'custnum' => $self->custnum,
3247 my $error = $self->custnum
3248 ? $cust_main_invoice->check
3249 : $cust_main_invoice->checkdest
3251 return $error if $error;
3255 return "Email address required"
3256 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3257 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3262 =item set_default_invoicing_list
3264 Sets the invoicing list to all accounts associated with this customer,
3265 overwriting any previous invoicing list.
3269 sub set_default_invoicing_list {
3271 $self->invoicing_list($self->all_emails);
3276 Returns the email addresses of all accounts provisioned for this customer.
3283 foreach my $cust_pkg ( $self->all_pkgs ) {
3284 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3286 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3287 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3289 $list{$_}=1 foreach map { $_->email } @svc_acct;
3294 =item invoicing_list_addpost
3296 Adds postal invoicing to this customer. If this customer is already configured
3297 to receive postal invoices, does nothing.
3301 sub invoicing_list_addpost {
3303 return if grep { $_ eq 'POST' } $self->invoicing_list;
3304 my @invoicing_list = $self->invoicing_list;
3305 push @invoicing_list, 'POST';
3306 $self->invoicing_list(\@invoicing_list);
3309 =item invoicing_list_emailonly
3311 Returns the list of email invoice recipients (invoicing_list without non-email
3312 destinations such as POST and FAX).
3316 sub invoicing_list_emailonly {
3318 warn "$me invoicing_list_emailonly called"
3320 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3323 =item invoicing_list_emailonly_scalar
3325 Returns the list of email invoice recipients (invoicing_list without non-email
3326 destinations such as POST and FAX) as a comma-separated scalar.
3330 sub invoicing_list_emailonly_scalar {
3332 warn "$me invoicing_list_emailonly_scalar called"
3334 join(', ', $self->invoicing_list_emailonly);
3337 =item referral_custnum_cust_main
3339 Returns the customer who referred this customer (or the empty string, if
3340 this customer was not referred).
3342 Note the difference with referral_cust_main method: This method,
3343 referral_custnum_cust_main returns the single customer (if any) who referred
3344 this customer, while referral_cust_main returns an array of customers referred
3349 sub referral_custnum_cust_main {
3351 return '' unless $self->referral_custnum;
3352 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3355 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3357 Returns an array of customers referred by this customer (referral_custnum set
3358 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3359 customers referred by customers referred by this customer and so on, inclusive.
3360 The default behavior is DEPTH 1 (no recursion).
3362 Note the difference with referral_custnum_cust_main method: This method,
3363 referral_cust_main, returns an array of customers referred BY this customer,
3364 while referral_custnum_cust_main returns the single customer (if any) who
3365 referred this customer.
3369 sub referral_cust_main {
3371 my $depth = @_ ? shift : 1;
3372 my $exclude = @_ ? shift : {};
3375 map { $exclude->{$_->custnum}++; $_; }
3376 grep { ! $exclude->{ $_->custnum } }
3377 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3381 map { $_->referral_cust_main($depth-1, $exclude) }
3388 =item referral_cust_main_ncancelled
3390 Same as referral_cust_main, except only returns customers with uncancelled
3395 sub referral_cust_main_ncancelled {
3397 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3400 =item referral_cust_pkg [ DEPTH ]
3402 Like referral_cust_main, except returns a flat list of all unsuspended (and
3403 uncancelled) packages for each customer. The number of items in this list may
3404 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3408 sub referral_cust_pkg {
3410 my $depth = @_ ? shift : 1;
3412 map { $_->unsuspended_pkgs }
3413 grep { $_->unsuspended_pkgs }
3414 $self->referral_cust_main($depth);
3417 =item referring_cust_main
3419 Returns the single cust_main record for the customer who referred this customer
3420 (referral_custnum), or false.
3424 sub referring_cust_main {
3426 return '' unless $self->referral_custnum;
3427 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3430 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3432 Applies a credit to this customer. If there is an error, returns the error,
3433 otherwise returns false.
3435 REASON can be a text string, an FS::reason object, or a scalar reference to
3436 a reasonnum. If a text string, it will be automatically inserted as a new
3437 reason, and a 'reason_type' option must be passed to indicate the
3438 FS::reason_type for the new reason.
3440 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3441 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3442 I<commission_pkgnum>.
3444 Any other options are passed to FS::cust_credit::insert.
3449 my( $self, $amount, $reason, %options ) = @_;
3451 my $cust_credit = new FS::cust_credit {
3452 'custnum' => $self->custnum,
3453 'amount' => $amount,
3456 if ( ref($reason) ) {
3458 if ( ref($reason) eq 'SCALAR' ) {
3459 $cust_credit->reasonnum( $$reason );
3461 $cust_credit->reasonnum( $reason->reasonnum );
3465 $cust_credit->set('reason', $reason)
3468 $cust_credit->$_( delete $options{$_} )
3469 foreach grep exists($options{$_}),
3470 qw( addlinfo eventnum ),
3471 map "commission_$_", qw( agentnum salesnum pkgnum );
3473 $cust_credit->insert(%options);
3477 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3479 Creates a one-time charge for this customer. If there is an error, returns
3480 the error, otherwise returns false.
3482 New-style, with a hashref of options:
3484 my $error = $cust_main->charge(
3488 'start_date' => str2time('7/4/2009'),
3489 'pkg' => 'Description',
3490 'comment' => 'Comment',
3491 'additional' => [], #extra invoice detail
3492 'classnum' => 1, #pkg_class
3494 'setuptax' => '', # or 'Y' for tax exempt
3496 'locationnum'=> 1234, # optional
3499 'taxclass' => 'Tax class',
3502 'taxproduct' => 2, #part_pkg_taxproduct
3503 'override' => {}, #XXX describe
3505 #will be filled in with the new object
3506 'cust_pkg_ref' => \$cust_pkg,
3508 #generate an invoice immediately
3510 'invoice_terms' => '', #with these terms
3516 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3520 #super false laziness w/quotation::charge
3523 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3524 my ( $pkg, $comment, $additional );
3525 my ( $setuptax, $taxclass ); #internal taxes
3526 my ( $taxproduct, $override ); #vendor (CCH) taxes
3528 my $separate_bill = '';
3529 my $cust_pkg_ref = '';
3530 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3532 if ( ref( $_[0] ) ) {
3533 $amount = $_[0]->{amount};
3534 $setup_cost = $_[0]->{setup_cost};
3535 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3536 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3537 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3538 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3539 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3540 : '$'. sprintf("%.2f",$amount);
3541 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3542 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3543 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3544 $additional = $_[0]->{additional} || [];
3545 $taxproduct = $_[0]->{taxproductnum};
3546 $override = { '' => $_[0]->{tax_override} };
3547 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3548 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3549 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3550 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3551 $separate_bill = $_[0]->{separate_bill} || '';
3557 $pkg = @_ ? shift : 'One-time charge';
3558 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3560 $taxclass = @_ ? shift : '';
3564 local $SIG{HUP} = 'IGNORE';
3565 local $SIG{INT} = 'IGNORE';
3566 local $SIG{QUIT} = 'IGNORE';
3567 local $SIG{TERM} = 'IGNORE';
3568 local $SIG{TSTP} = 'IGNORE';
3569 local $SIG{PIPE} = 'IGNORE';
3571 my $oldAutoCommit = $FS::UID::AutoCommit;
3572 local $FS::UID::AutoCommit = 0;
3575 my $part_pkg = new FS::part_pkg ( {
3577 'comment' => $comment,
3581 'classnum' => ( $classnum ? $classnum : '' ),
3582 'setuptax' => $setuptax,
3583 'taxclass' => $taxclass,
3584 'taxproductnum' => $taxproduct,
3585 'setup_cost' => $setup_cost,
3588 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3589 ( 0 .. @$additional - 1 )
3591 'additional_count' => scalar(@$additional),
3592 'setup_fee' => $amount,
3595 my $error = $part_pkg->insert( options => \%options,
3596 tax_overrides => $override,
3599 $dbh->rollback if $oldAutoCommit;
3603 my $pkgpart = $part_pkg->pkgpart;
3604 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3605 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3606 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3607 $error = $type_pkgs->insert;
3609 $dbh->rollback if $oldAutoCommit;
3614 my $cust_pkg = new FS::cust_pkg ( {
3615 'custnum' => $self->custnum,
3616 'pkgpart' => $pkgpart,
3617 'quantity' => $quantity,
3618 'start_date' => $start_date,
3619 'no_auto' => $no_auto,
3620 'separate_bill' => $separate_bill,
3621 'locationnum'=> $locationnum,
3624 $error = $cust_pkg->insert;
3626 $dbh->rollback if $oldAutoCommit;
3628 } elsif ( $cust_pkg_ref ) {
3629 ${$cust_pkg_ref} = $cust_pkg;
3633 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3634 'pkg_list' => [ $cust_pkg ],
3637 $dbh->rollback if $oldAutoCommit;
3642 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3647 #=item charge_postal_fee
3649 #Applies a one time charge this customer. If there is an error,
3650 #returns the error, returns the cust_pkg charge object or false
3651 #if there was no charge.
3655 # This should be a customer event. For that to work requires that bill
3656 # also be a customer event.
3658 sub charge_postal_fee {
3661 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3662 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3664 my $cust_pkg = new FS::cust_pkg ( {
3665 'custnum' => $self->custnum,
3666 'pkgpart' => $pkgpart,
3670 my $error = $cust_pkg->insert;
3671 $error ? $error : $cust_pkg;
3674 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3676 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3678 Optionally, a list or hashref of additional arguments to the qsearch call can
3685 my $opt = ref($_[0]) ? shift : { @_ };
3687 #return $self->num_cust_bill unless wantarray || keys %$opt;
3689 $opt->{'table'} = 'cust_bill';
3690 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3691 $opt->{'hashref'}{'custnum'} = $self->custnum;
3692 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3694 map { $_ } #behavior of sort undefined in scalar context
3695 sort { $a->_date <=> $b->_date }
3699 =item open_cust_bill
3701 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3706 sub open_cust_bill {
3710 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3716 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3718 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3722 sub legacy_cust_bill {
3725 #return $self->num_legacy_cust_bill unless wantarray;
3727 map { $_ } #behavior of sort undefined in scalar context
3728 sort { $a->_date <=> $b->_date }
3729 qsearch({ 'table' => 'legacy_cust_bill',
3730 'hashref' => { 'custnum' => $self->custnum, },
3731 'order_by' => 'ORDER BY _date ASC',
3735 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3737 Returns all the statements (see L<FS::cust_statement>) for this customer.
3739 Optionally, a list or hashref of additional arguments to the qsearch call can
3744 =item cust_bill_void
3746 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3750 sub cust_bill_void {
3753 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3754 sort { $a->_date <=> $b->_date }
3755 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3758 sub cust_statement {
3760 my $opt = ref($_[0]) ? shift : { @_ };
3762 #return $self->num_cust_statement unless wantarray || keys %$opt;
3764 $opt->{'table'} = 'cust_statement';
3765 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3766 $opt->{'hashref'}{'custnum'} = $self->custnum;
3767 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3769 map { $_ } #behavior of sort undefined in scalar context
3770 sort { $a->_date <=> $b->_date }
3774 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3776 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3778 Optionally, a list or hashref of additional arguments to the qsearch call can
3779 be passed following the SVCDB.
3786 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3787 warn "$me svc_x requires a svcdb";
3790 my $opt = ref($_[0]) ? shift : { @_ };
3792 $opt->{'table'} = $svcdb;
3793 $opt->{'addl_from'} =
3794 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3795 ($opt->{'addl_from'} || '');
3797 my $custnum = $self->custnum;
3798 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3799 my $where = "cust_pkg.custnum = $custnum";
3801 my $extra_sql = $opt->{'extra_sql'} || '';
3802 if ( keys %{ $opt->{'hashref'} } ) {
3803 $extra_sql = " AND $where $extra_sql";
3806 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3807 $extra_sql = "WHERE $where AND $1";
3810 $extra_sql = "WHERE $where $extra_sql";
3813 $opt->{'extra_sql'} = $extra_sql;
3818 # required for use as an eventtable;
3821 $self->svc_x('svc_acct', @_);
3826 Returns all the credits (see L<FS::cust_credit>) for this customer.
3832 map { $_ } #return $self->num_cust_credit unless wantarray;
3833 sort { $a->_date <=> $b->_date }
3834 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3837 =item cust_credit_pkgnum
3839 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3840 package when using experimental package balances.
3844 sub cust_credit_pkgnum {
3845 my( $self, $pkgnum ) = @_;
3846 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3847 sort { $a->_date <=> $b->_date }
3848 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3849 'pkgnum' => $pkgnum,
3854 =item cust_credit_void
3856 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3860 sub cust_credit_void {
3863 sort { $a->_date <=> $b->_date }
3864 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3869 Returns all the payments (see L<FS::cust_pay>) for this customer.
3875 my $opt = ref($_[0]) ? shift : { @_ };
3877 return $self->num_cust_pay unless wantarray || keys %$opt;
3879 $opt->{'table'} = 'cust_pay';
3880 $opt->{'hashref'}{'custnum'} = $self->custnum;
3882 map { $_ } #behavior of sort undefined in scalar context
3883 sort { $a->_date <=> $b->_date }
3890 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3891 called automatically when the cust_pay method is used in a scalar context.
3897 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3898 my $sth = dbh->prepare($sql) or die dbh->errstr;
3899 $sth->execute($self->custnum) or die $sth->errstr;
3900 $sth->fetchrow_arrayref->[0];
3903 =item unapplied_cust_pay
3905 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3909 sub unapplied_cust_pay {
3913 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3919 =item cust_pay_pkgnum
3921 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3922 package when using experimental package balances.
3926 sub cust_pay_pkgnum {
3927 my( $self, $pkgnum ) = @_;
3928 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3929 sort { $a->_date <=> $b->_date }
3930 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3931 'pkgnum' => $pkgnum,
3938 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3944 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3945 sort { $a->_date <=> $b->_date }
3946 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3949 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3951 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3953 Optionally, a list or hashref of additional arguments to the qsearch call can
3958 sub cust_pay_batch {
3960 my $opt = ref($_[0]) ? shift : { @_ };
3962 #return $self->num_cust_statement unless wantarray || keys %$opt;
3964 $opt->{'table'} = 'cust_pay_batch';
3965 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3966 $opt->{'hashref'}{'custnum'} = $self->custnum;
3967 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3969 map { $_ } #behavior of sort undefined in scalar context
3970 sort { $a->paybatchnum <=> $b->paybatchnum }
3974 =item cust_pay_pending
3976 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3977 (without status "done").
3981 sub cust_pay_pending {
3983 return $self->num_cust_pay_pending unless wantarray;
3984 sort { $a->_date <=> $b->_date }
3985 qsearch( 'cust_pay_pending', {
3986 'custnum' => $self->custnum,
3987 'status' => { op=>'!=', value=>'done' },
3992 =item cust_pay_pending_attempt
3994 Returns all payment attempts / declined payments for this customer, as pending
3995 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3996 a corresponding payment (see L<FS::cust_pay>).
4000 sub cust_pay_pending_attempt {
4002 return $self->num_cust_pay_pending_attempt unless wantarray;
4003 sort { $a->_date <=> $b->_date }
4004 qsearch( 'cust_pay_pending', {
4005 'custnum' => $self->custnum,
4012 =item num_cust_pay_pending
4014 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4015 customer (without status "done"). Also called automatically when the
4016 cust_pay_pending method is used in a scalar context.
4020 sub num_cust_pay_pending {
4023 " SELECT COUNT(*) FROM cust_pay_pending ".
4024 " WHERE custnum = ? AND status != 'done' ",
4029 =item num_cust_pay_pending_attempt
4031 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4032 customer, with status "done" but without a corresp. Also called automatically when the
4033 cust_pay_pending method is used in a scalar context.
4037 sub num_cust_pay_pending_attempt {
4040 " SELECT COUNT(*) FROM cust_pay_pending ".
4041 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4048 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4054 map { $_ } #return $self->num_cust_refund unless wantarray;
4055 sort { $a->_date <=> $b->_date }
4056 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4059 =item display_custnum
4061 Returns the displayed customer number for this customer: agent_custid if
4062 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4066 sub display_custnum {
4069 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
4070 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
4071 if ( $special eq 'CoStAg' ) {
4072 $prefix = uc( join('',
4074 ($self->state =~ /^(..)/),
4075 $prefix || ($self->agent->agent =~ /^(..)/)
4078 elsif ( $special eq 'CoStCl' ) {
4079 $prefix = uc( join('',
4081 ($self->state =~ /^(..)/),
4082 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
4085 # add any others here if needed
4088 my $length = $conf->config('cust_main-custnum-display_length');
4089 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4090 return $self->agent_custid;
4091 } elsif ( $prefix ) {
4092 $length = 8 if !defined($length);
4094 sprintf('%0'.$length.'d', $self->custnum)
4095 } elsif ( $length ) {
4096 return sprintf('%0'.$length.'d', $self->custnum);
4098 return $self->custnum;
4104 Returns a name string for this customer, either "Company (Last, First)" or
4111 my $name = $self->contact;
4112 $name = $self->company. " ($name)" if $self->company;
4116 =item service_contact
4118 Returns the L<FS::contact> object for this customer that has the 'Service'
4119 contact class, or undef if there is no such contact. Deprecated; don't use
4124 sub service_contact {
4126 if ( !exists($self->{service_contact}) ) {
4127 my $classnum = $self->scalar_sql(
4128 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4129 ) || 0; #if it's zero, qsearchs will return nothing
4130 $self->{service_contact} = qsearchs('contact', {
4131 'classnum' => $classnum, 'custnum' => $self->custnum
4134 $self->{service_contact};
4139 Returns a name string for this (service/shipping) contact, either
4140 "Company (Last, First)" or "Last, First".
4147 my $name = $self->ship_contact;
4148 $name = $self->company. " ($name)" if $self->company;
4154 Returns a name string for this customer, either "Company" or "First Last".
4160 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4163 =item ship_name_short
4165 Returns a name string for this (service/shipping) contact, either "Company"
4170 sub ship_name_short {
4172 $self->service_contact
4173 ? $self->ship_contact_firstlast
4179 Returns this customer's full (billing) contact name only, "Last, First"
4185 $self->get('last'). ', '. $self->first;
4190 Returns this customer's full (shipping) contact name only, "Last, First"
4196 my $contact = $self->service_contact || $self;
4197 $contact->get('last') . ', ' . $contact->get('first');
4200 =item contact_firstlast
4202 Returns this customers full (billing) contact name only, "First Last".
4206 sub contact_firstlast {
4208 $self->first. ' '. $self->get('last');
4211 =item ship_contact_firstlast
4213 Returns this customer's full (shipping) contact name only, "First Last".
4217 sub ship_contact_firstlast {
4219 my $contact = $self->service_contact || $self;
4220 $contact->get('first') . ' '. $contact->get('last');
4223 sub bill_country_full {
4225 $self->bill_location->country_full;
4228 sub ship_country_full {
4230 $self->ship_location->country_full;
4233 =item county_state_county [ PREFIX ]
4235 Returns a string consisting of just the county, state and country.
4239 sub county_state_country {
4242 if ( @_ && $_[0] && $self->has_ship_address ) {
4243 $locationnum = $self->ship_locationnum;
4245 $locationnum = $self->bill_locationnum;
4247 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4248 $cust_location->county_state_country;
4251 =item geocode DATA_VENDOR
4253 Returns a value for the customer location as encoded by DATA_VENDOR.
4254 Currently this only makes sense for "CCH" as DATA_VENDOR.
4262 Returns a status string for this customer, currently:
4266 =item prospect - No packages have ever been ordered
4268 =item ordered - Recurring packages all are new (not yet billed).
4270 =item active - One or more recurring packages is active
4272 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4274 =item suspended - All non-cancelled recurring packages are suspended
4276 =item cancelled - All recurring packages are cancelled
4280 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4281 cust_main-status_module configuration option.
4285 sub status { shift->cust_status(@_); }
4289 for my $status ( FS::cust_main->statuses() ) {
4290 my $method = $status.'_sql';
4291 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4292 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4293 $sth->execute( ($self->custnum) x $numnum )
4294 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4295 return $status if $sth->fetchrow_arrayref->[0];
4299 =item is_status_delay_cancel
4301 Returns true if customer status is 'suspended'
4302 and all suspended cust_pkg return true for
4303 cust_pkg->is_status_delay_cancel.
4305 This is not a real status, this only meant for hacking display
4306 values, because otherwise treating the customer as suspended is
4307 really the whole point of the delay_cancel option.
4311 sub is_status_delay_cancel {
4313 return 0 unless $self->status eq 'suspended';
4314 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4315 return 0 unless $cust_pkg->is_status_delay_cancel;
4320 =item ucfirst_cust_status
4322 =item ucfirst_status
4324 Returns the status with the first character capitalized.
4328 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4330 sub ucfirst_cust_status {
4332 ucfirst($self->cust_status);
4337 Returns a hex triplet color string for this customer's status.
4341 sub statuscolor { shift->cust_statuscolor(@_); }
4343 sub cust_statuscolor {
4345 __PACKAGE__->statuscolors->{$self->cust_status};
4348 =item tickets [ STATUS ]
4350 Returns an array of hashes representing the customer's RT tickets.
4352 An optional status (or arrayref or hashref of statuses) may be specified.
4358 my $status = ( @_ && $_[0] ) ? shift : '';
4360 my $num = $conf->config('cust_main-max_tickets') || 10;
4363 if ( $conf->config('ticket_system') ) {
4364 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4366 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4375 foreach my $priority (
4376 $conf->config('ticket_system-custom_priority_field-values'), ''
4378 last if scalar(@tickets) >= $num;
4380 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4381 $num - scalar(@tickets),
4392 # Return services representing svc_accts in customer support packages
4393 sub support_services {
4395 my %packages = map { $_ => 1 } $conf->config('support_packages');
4397 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4398 grep { $_->part_svc->svcdb eq 'svc_acct' }
4399 map { $_->cust_svc }
4400 grep { exists $packages{ $_->pkgpart } }
4401 $self->ncancelled_pkgs;
4405 # Return a list of latitude/longitude for one of the services (if any)
4406 sub service_coordinates {
4410 grep { $_->latitude && $_->longitude }
4412 map { $_->cust_svc }
4413 $self->ncancelled_pkgs;
4415 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4420 Returns a masked version of the named field
4425 my ($self,$field) = @_;
4429 'x'x(length($self->getfield($field))-4).
4430 substr($self->getfield($field), (length($self->getfield($field))-4));
4434 =item payment_history
4436 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4437 cust_credit and cust_refund objects. Each hashref has the following fields:
4439 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4441 I<date> - value of _date field, unix timestamp
4443 I<date_pretty> - user-friendly date
4445 I<description> - user-friendly description of item
4447 I<amount> - impact of item on user's balance
4448 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4449 Not to be confused with the native 'amount' field in cust_credit, see below.
4451 I<amount_pretty> - includes money char
4453 I<balance> - customer balance, chronologically as of this item
4455 I<balance_pretty> - includes money char
4457 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4459 I<paid> - amount paid for cust_pay records, undef for other types
4461 I<credit> - amount credited for cust_credit records, undef for other types.
4462 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4464 I<refund> - amount refunded for cust_refund records, undef for other types
4466 The four table-specific keys always have positive values, whether they reflect charges or payments.
4468 The following options may be passed to this method:
4470 I<line_items> - if true, returns charges ('Line item') rather than invoices
4472 I<start_date> - unix timestamp, only include records on or after.
4473 If specified, an item of type 'Previous' will also be included.
4474 It does not have table-specific fields.
4476 I<end_date> - unix timestamp, only include records before
4478 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4480 I<conf> - optional already-loaded FS::Conf object.
4484 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4485 # and also for sending customer statements, which should both be kept customer-friendly.
4486 # If you add anything that shouldn't be passed on through the API or exposed
4487 # to customers, add a new option to include it, don't include it by default
4488 sub payment_history {
4490 my $opt = ref($_[0]) ? $_[0] : { @_ };
4492 my $conf = $$opt{'conf'} || new FS::Conf;
4493 my $money_char = $conf->config("money_char") || '$',
4495 #first load entire history,
4496 #need previous to calculate previous balance
4497 #loading after end_date shouldn't hurt too much?
4499 if ( $$opt{'line_items'} ) {
4501 foreach my $cust_bill ( $self->cust_bill ) {
4504 'type' => 'Line item',
4505 'description' => $_->desc( $self->locale ).
4506 ( $_->sdate && $_->edate
4507 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4508 ' To '. time2str('%d-%b-%Y', $_->edate)
4511 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4512 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4513 'date' => $cust_bill->_date,
4514 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4516 foreach $cust_bill->cust_bill_pkg;
4523 'type' => 'Invoice',
4524 'description' => 'Invoice #'. $_->display_invnum,
4525 'amount' => sprintf('%.2f', $_->charged ),
4526 'charged' => sprintf('%.2f', $_->charged ),
4527 'date' => $_->_date,
4528 'date_pretty' => $self->time2str_local('short', $_->_date ),
4530 foreach $self->cust_bill;
4535 'type' => 'Payment',
4536 'description' => 'Payment', #XXX type
4537 'amount' => sprintf('%.2f', 0 - $_->paid ),
4538 'paid' => sprintf('%.2f', $_->paid ),
4539 'date' => $_->_date,
4540 'date_pretty' => $self->time2str_local('short', $_->_date ),
4542 foreach $self->cust_pay;
4546 'description' => 'Credit', #more info?
4547 'amount' => sprintf('%.2f', 0 -$_->amount ),
4548 'credit' => sprintf('%.2f', $_->amount ),
4549 'date' => $_->_date,
4550 'date_pretty' => $self->time2str_local('short', $_->_date ),
4552 foreach $self->cust_credit;
4556 'description' => 'Refund', #more info? type, like payment?
4557 'amount' => $_->refund,
4558 'refund' => $_->refund,
4559 'date' => $_->_date,
4560 'date_pretty' => $self->time2str_local('short', $_->_date ),
4562 foreach $self->cust_refund;
4564 #put it all in chronological order
4565 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4567 #calculate balance, filter items outside date range
4571 foreach my $item (@history) {
4572 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4573 $balance += $$item{'amount'};
4574 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4575 $previous += $$item{'amount'};
4578 $$item{'balance'} = sprintf("%.2f",$balance);
4579 foreach my $key ( qw(amount balance) ) {
4580 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4585 # start with previous balance, if there was one
4588 'type' => 'Previous',
4589 'description' => 'Previous balance',
4590 'amount' => sprintf("%.2f",$previous),
4591 'balance' => sprintf("%.2f",$previous),
4592 'date' => $$opt{'start_date'},
4593 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4595 #false laziness with above
4596 foreach my $key ( qw(amount balance) ) {
4597 $$item{$key.'_pretty'} = $$item{$key};
4598 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4600 unshift(@out,$item);
4603 @out = reverse @history if $$opt{'reverse_sort'};
4610 =head1 CLASS METHODS
4616 Class method that returns the list of possible status strings for customers
4617 (see L<the status method|/status>). For example:
4619 @statuses = FS::cust_main->statuses();
4625 keys %{ $self->statuscolors };
4628 =item cust_status_sql
4630 Returns an SQL fragment to determine the status of a cust_main record, as a
4635 sub cust_status_sql {
4637 for my $status ( FS::cust_main->statuses() ) {
4638 my $method = $status.'_sql';
4639 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4648 Returns an SQL expression identifying prospective cust_main records (customers
4649 with no packages ever ordered)
4653 use vars qw($select_count_pkgs);
4654 $select_count_pkgs =
4655 "SELECT COUNT(*) FROM cust_pkg
4656 WHERE cust_pkg.custnum = cust_main.custnum";
4658 sub select_count_pkgs_sql {
4663 " 0 = ( $select_count_pkgs ) ";
4668 Returns an SQL expression identifying ordered cust_main records (customers with
4669 no active packages, but recurring packages not yet setup or one time charges
4675 FS::cust_main->none_active_sql.
4676 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4681 Returns an SQL expression identifying active cust_main records (customers with
4682 active recurring packages).
4687 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4690 =item none_active_sql
4692 Returns an SQL expression identifying cust_main records with no active
4693 recurring packages. This includes customers of status prospect, ordered,
4694 inactive, and suspended.
4698 sub none_active_sql {
4699 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4704 Returns an SQL expression identifying inactive cust_main records (customers with
4705 no active recurring packages, but otherwise unsuspended/uncancelled).
4710 FS::cust_main->none_active_sql.
4711 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4717 Returns an SQL expression identifying suspended cust_main records.
4722 sub suspended_sql { susp_sql(@_); }
4724 FS::cust_main->none_active_sql.
4725 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4731 Returns an SQL expression identifying cancelled cust_main records.
4735 sub cancel_sql { shift->cancelled_sql(@_); }
4738 =item uncancelled_sql
4740 Returns an SQL expression identifying un-cancelled cust_main records.
4744 sub uncancelled_sql { uncancel_sql(@_); }
4745 sub uncancel_sql { "
4746 ( 0 < ( $select_count_pkgs
4747 AND ( cust_pkg.cancel IS NULL
4748 OR cust_pkg.cancel = 0
4751 OR 0 = ( $select_count_pkgs )
4757 Returns an SQL fragment to retreive the balance.
4762 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4763 WHERE cust_bill.custnum = cust_main.custnum )
4764 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4765 WHERE cust_pay.custnum = cust_main.custnum )
4766 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4767 WHERE cust_credit.custnum = cust_main.custnum )
4768 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4769 WHERE cust_refund.custnum = cust_main.custnum )
4772 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4774 Returns an SQL fragment to retreive the balance for this customer, optionally
4775 considering invoices with date earlier than START_TIME, and not
4776 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4777 total_unapplied_payments).
4779 Times are specified as SQL fragments or numeric
4780 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4781 L<Date::Parse> for conversion functions. The empty string can be passed
4782 to disable that time constraint completely.
4784 Available options are:
4788 =item unapplied_date
4790 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)
4795 set to true to remove all customer comparison clauses, for totals
4800 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4805 JOIN clause (typically used with the total option)
4809 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4810 time will be ignored. Note that START_TIME and END_TIME only limit the date
4811 range for invoices and I<unapplied> payments, credits, and refunds.
4817 sub balance_date_sql {
4818 my( $class, $start, $end, %opt ) = @_;
4820 my $cutoff = $opt{'cutoff'};
4822 my $owed = FS::cust_bill->owed_sql($cutoff);
4823 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4824 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4825 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4827 my $j = $opt{'join'} || '';
4829 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4830 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4831 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4832 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4834 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4835 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4836 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4837 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4842 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4844 Returns an SQL fragment to retreive the total unapplied payments for this
4845 customer, only considering payments with date earlier than START_TIME, and
4846 optionally not later than END_TIME.
4848 Times are specified as SQL fragments or numeric
4849 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4850 L<Date::Parse> for conversion functions. The empty string can be passed
4851 to disable that time constraint completely.
4853 Available options are:
4857 sub unapplied_payments_date_sql {
4858 my( $class, $start, $end, %opt ) = @_;
4860 my $cutoff = $opt{'cutoff'};
4862 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4864 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4865 'unapplied_date'=>1 );
4867 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4870 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4872 Helper method for balance_date_sql; name (and usage) subject to change
4873 (suggestions welcome).
4875 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4876 cust_refund, cust_credit or cust_pay).
4878 If TABLE is "cust_bill" or the unapplied_date option is true, only
4879 considers records with date earlier than START_TIME, and optionally not
4880 later than END_TIME .
4884 sub _money_table_where {
4885 my( $class, $table, $start, $end, %opt ) = @_;
4888 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4889 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4890 push @where, "$table._date <= $start" if defined($start) && length($start);
4891 push @where, "$table._date > $end" if defined($end) && length($end);
4893 push @where, @{$opt{'where'}} if $opt{'where'};
4894 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4900 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4901 use FS::cust_main::Search;
4904 FS::cust_main::Search->search(@_);
4919 #warn join('-',keys %$param);
4920 my $fh = $param->{filehandle};
4921 my $agentnum = $param->{agentnum};
4922 my $format = $param->{format};
4924 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4927 if ( $format eq 'simple' ) {
4928 @fields = qw( custnum agent_custid amount pkg );
4930 die "unknown format $format";
4933 eval "use Text::CSV_XS;";
4936 my $csv = new Text::CSV_XS;
4943 local $SIG{HUP} = 'IGNORE';
4944 local $SIG{INT} = 'IGNORE';
4945 local $SIG{QUIT} = 'IGNORE';
4946 local $SIG{TERM} = 'IGNORE';
4947 local $SIG{TSTP} = 'IGNORE';
4948 local $SIG{PIPE} = 'IGNORE';
4950 my $oldAutoCommit = $FS::UID::AutoCommit;
4951 local $FS::UID::AutoCommit = 0;
4954 #while ( $columns = $csv->getline($fh) ) {
4956 while ( defined($line=<$fh>) ) {
4958 $csv->parse($line) or do {
4959 $dbh->rollback if $oldAutoCommit;
4960 return "can't parse: ". $csv->error_input();
4963 my @columns = $csv->fields();
4964 #warn join('-',@columns);
4967 foreach my $field ( @fields ) {
4968 $row{$field} = shift @columns;
4971 if ( $row{custnum} && $row{agent_custid} ) {
4972 dbh->rollback if $oldAutoCommit;
4973 return "can't specify custnum with agent_custid $row{agent_custid}";
4977 if ( $row{agent_custid} && $agentnum ) {
4978 %hash = ( 'agent_custid' => $row{agent_custid},
4979 'agentnum' => $agentnum,
4983 if ( $row{custnum} ) {
4984 %hash = ( 'custnum' => $row{custnum} );
4987 unless ( scalar(keys %hash) ) {
4988 $dbh->rollback if $oldAutoCommit;
4989 return "can't find customer without custnum or agent_custid and agentnum";
4992 my $cust_main = qsearchs('cust_main', { %hash } );
4993 unless ( $cust_main ) {
4994 $dbh->rollback if $oldAutoCommit;
4995 my $custnum = $row{custnum} || $row{agent_custid};
4996 return "unknown custnum $custnum";
4999 if ( $row{'amount'} > 0 ) {
5000 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5002 $dbh->rollback if $oldAutoCommit;
5006 } elsif ( $row{'amount'} < 0 ) {
5007 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5010 $dbh->rollback if $oldAutoCommit;
5020 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5022 return "Empty file!" unless $imported;
5028 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5030 Deprecated. Use event notification and message templates
5031 (L<FS::msg_template>) instead.
5033 Sends a templated email notification to the customer (see L<Text::Template>).
5035 OPTIONS is a hash and may include
5037 I<from> - the email sender (default is invoice_from)
5039 I<to> - comma-separated scalar or arrayref of recipients
5040 (default is invoicing_list)
5042 I<subject> - The subject line of the sent email notification
5043 (default is "Notice from company_name")
5045 I<extra_fields> - a hashref of name/value pairs which will be substituted
5048 The following variables are vavailable in the template.
5050 I<$first> - the customer first name
5051 I<$last> - the customer last name
5052 I<$company> - the customer company
5053 I<$payby> - a description of the method of payment for the customer
5054 # would be nice to use FS::payby::shortname
5055 I<$payinfo> - the account information used to collect for this customer
5056 I<$expdate> - the expiration of the customer payment in seconds from epoch
5061 my ($self, $template, %options) = @_;
5063 return unless $conf->exists($template);
5065 my $from = $conf->invoice_from_full($self->agentnum)
5066 if $conf->exists('invoice_from', $self->agentnum);
5067 $from = $options{from} if exists($options{from});
5069 my $to = join(',', $self->invoicing_list_emailonly);
5070 $to = $options{to} if exists($options{to});
5072 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5073 if $conf->exists('company_name', $self->agentnum);
5074 $subject = $options{subject} if exists($options{subject});
5076 my $notify_template = new Text::Template (TYPE => 'ARRAY',
5077 SOURCE => [ map "$_\n",
5078 $conf->config($template)]
5080 or die "can't create new Text::Template object: Text::Template::ERROR";
5081 $notify_template->compile()
5082 or die "can't compile template: Text::Template::ERROR";
5084 $FS::notify_template::_template::company_name =
5085 $conf->config('company_name', $self->agentnum);
5086 $FS::notify_template::_template::company_address =
5087 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5089 my $paydate = $self->paydate || '2037-12-31';
5090 $FS::notify_template::_template::first = $self->first;
5091 $FS::notify_template::_template::last = $self->last;
5092 $FS::notify_template::_template::company = $self->company;
5093 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5094 my $payby = $self->payby;
5095 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5096 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5098 #credit cards expire at the end of the month/year of their exp date
5099 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5100 $FS::notify_template::_template::payby = 'credit card';
5101 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5102 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5104 }elsif ($payby eq 'COMP') {
5105 $FS::notify_template::_template::payby = 'complimentary account';
5107 $FS::notify_template::_template::payby = 'current method';
5109 $FS::notify_template::_template::expdate = $expire_time;
5111 for (keys %{$options{extra_fields}}){
5113 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5116 send_email(from => $from,
5118 subject => $subject,
5119 body => $notify_template->fill_in( PACKAGE =>
5120 'FS::notify_template::_template' ),
5125 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5127 Generates a templated notification to the customer (see L<Text::Template>).
5129 OPTIONS is a hash and may include
5131 I<extra_fields> - a hashref of name/value pairs which will be substituted
5132 into the template. These values may override values mentioned below
5133 and those from the customer record.
5135 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5137 The following variables are available in the template instead of or in addition
5138 to the fields of the customer record.
5140 I<$payby> - a description of the method of payment for the customer
5141 # would be nice to use FS::payby::shortname
5142 I<$payinfo> - the masked account information used to collect for this customer
5143 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5144 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5148 # a lot like cust_bill::print_latex
5149 sub generate_letter {
5150 my ($self, $template, %options) = @_;
5152 warn "Template $template does not exist" && return
5153 unless $conf->exists($template) || $options{'template_text'};
5155 my $template_source = $options{'template_text'}
5156 ? [ $options{'template_text'} ]
5157 : [ map "$_\n", $conf->config($template) ];
5159 my $letter_template = new Text::Template
5161 SOURCE => $template_source,
5162 DELIMITERS => [ '[@--', '--@]' ],
5164 or die "can't create new Text::Template object: Text::Template::ERROR";
5166 $letter_template->compile()
5167 or die "can't compile template: Text::Template::ERROR";
5169 my %letter_data = map { $_ => $self->$_ } $self->fields;
5170 $letter_data{payinfo} = $self->mask_payinfo;
5172 #my $paydate = $self->paydate || '2037-12-31';
5173 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5175 my $payby = $self->payby;
5176 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5177 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5179 #credit cards expire at the end of the month/year of their exp date
5180 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5181 $letter_data{payby} = 'credit card';
5182 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5183 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5185 }elsif ($payby eq 'COMP') {
5186 $letter_data{payby} = 'complimentary account';
5188 $letter_data{payby} = 'current method';
5190 $letter_data{expdate} = $expire_time;
5192 for (keys %{$options{extra_fields}}){
5193 $letter_data{$_} = $options{extra_fields}->{$_};
5196 unless(exists($letter_data{returnaddress})){
5197 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5198 $self->agent_template)
5200 if ( length($retadd) ) {
5201 $letter_data{returnaddress} = $retadd;
5202 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5203 $letter_data{returnaddress} =
5204 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5208 ( $conf->config('company_name', $self->agentnum),
5209 $conf->config('company_address', $self->agentnum),
5213 $letter_data{returnaddress} = '~';
5217 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5219 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5221 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5223 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5227 ) or die "can't open temp file: $!\n";
5228 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5229 or die "can't write temp file: $!\n";
5231 $letter_data{'logo_file'} = $lh->filename;
5233 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5237 ) or die "can't open temp file: $!\n";
5239 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5241 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5242 return ($1, $letter_data{'logo_file'});
5246 =item print_ps TEMPLATE
5248 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5254 my($file, $lfile) = $self->generate_letter(@_);
5255 my $ps = FS::Misc::generate_ps($file);
5256 unlink($file.'.tex');
5262 =item print TEMPLATE
5264 Prints the filled in template.
5266 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5270 sub queueable_print {
5273 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5274 or die "invalid customer number: " . $opt{custnum};
5276 my $error = $self->print( { 'template' => $opt{template} } );
5277 die $error if $error;
5281 my ($self, $template) = (shift, shift);
5283 [ $self->print_ps($template) ],
5284 'agentnum' => $self->agentnum,
5288 #these three subs should just go away once agent stuff is all config overrides
5290 sub agent_template {
5292 $self->_agent_plandata('agent_templatename');
5295 sub agent_invoice_from {
5297 $self->_agent_plandata('agent_invoice_from');
5300 sub _agent_plandata {
5301 my( $self, $option ) = @_;
5303 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5304 #agent-specific Conf
5306 use FS::part_event::Condition;
5308 my $agentnum = $self->agentnum;
5310 my $regexp = regexp_sql();
5312 my $part_event_option =
5314 'select' => 'part_event_option.*',
5315 'table' => 'part_event_option',
5317 LEFT JOIN part_event USING ( eventpart )
5318 LEFT JOIN part_event_option AS peo_agentnum
5319 ON ( part_event.eventpart = peo_agentnum.eventpart
5320 AND peo_agentnum.optionname = 'agentnum'
5321 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5323 LEFT JOIN part_event_condition
5324 ON ( part_event.eventpart = part_event_condition.eventpart
5325 AND part_event_condition.conditionname = 'cust_bill_age'
5327 LEFT JOIN part_event_condition_option
5328 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5329 AND part_event_condition_option.optionname = 'age'
5332 #'hashref' => { 'optionname' => $option },
5333 #'hashref' => { 'part_event_option.optionname' => $option },
5335 " WHERE part_event_option.optionname = ". dbh->quote($option).
5336 " AND action = 'cust_bill_send_agent' ".
5337 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5338 " AND peo_agentnum.optionname = 'agentnum' ".
5339 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5341 CASE WHEN part_event_condition_option.optionname IS NULL
5343 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5345 , part_event.weight".
5349 unless ( $part_event_option ) {
5350 return $self->agent->invoice_template || ''
5351 if $option eq 'agent_templatename';
5355 $part_event_option->optionvalue;
5359 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5361 Subroutine (not a method), designed to be called from the queue.
5363 Takes a list of options and values.
5365 Pulls up the customer record via the custnum option and calls bill_and_collect.
5370 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5372 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5373 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5375 #without this errors don't get rolled back
5376 $args{'fatal'} = 1; # runs from job queue, will be caught
5378 $cust_main->bill_and_collect( %args );
5381 sub process_bill_and_collect {
5383 my $param = thaw(decode_base64(shift));
5384 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5385 or die "custnum '$param->{custnum}' not found!\n";
5386 $param->{'job'} = $job;
5387 $param->{'fatal'} = 1; # runs from job queue, will be caught
5388 $param->{'retry'} = 1;
5390 $cust_main->bill_and_collect( %$param );
5393 #starting to take quite a while for big dbs
5394 # (JRNL: journaled so it only happens once per database)
5395 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5396 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5397 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5398 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5399 # JRNL leading/trailing spaces in first, last, company
5400 # - otaker upgrade? journal and call it good? (double check to make sure
5401 # we're not still setting otaker here)
5403 #only going to get worse with new location stuff...
5405 sub _upgrade_data { #class method
5406 my ($class, %opts) = @_;
5409 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5412 #this seems to be the only expensive one.. why does it take so long?
5413 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5415 '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';
5416 FS::upgrade_journal->set_done('cust_main__signupdate');
5419 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5421 # fix yyyy-m-dd formatted paydates
5422 if ( driver_name =~ /^mysql/i ) {
5424 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5425 } else { # the SQL standard
5427 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5429 FS::upgrade_journal->set_done('cust_main__paydate');
5432 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5434 push @statements, #fix the weird BILL with a cc# in payinfo problem
5436 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5438 FS::upgrade_journal->set_done('cust_main__payinfo');
5443 foreach my $sql ( @statements ) {
5444 my $sth = dbh->prepare($sql) or die dbh->errstr;
5445 $sth->execute or die $sth->errstr;
5446 #warn ( (time - $t). " seconds\n" );
5450 local($ignore_expired_card) = 1;
5451 local($ignore_banned_card) = 1;
5452 local($skip_fuzzyfiles) = 1;
5453 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5455 FS::cust_main::Location->_upgrade_data(%opts);
5457 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5459 foreach my $cust_main ( qsearch({
5460 'table' => 'cust_main',
5462 'extra_sql' => 'WHERE '.
5464 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5465 qw( first last company )
5468 my $error = $cust_main->replace;
5469 die $error if $error;
5472 FS::upgrade_journal->set_done('cust_main__trimspaces');
5476 $class->_upgrade_otaker(%opts);
5486 The delete method should possibly take an FS::cust_main object reference
5487 instead of a scalar customer number.
5489 Bill and collect options should probably be passed as references instead of a
5492 There should probably be a configuration file with a list of allowed credit
5495 No multiple currency support (probably a larger project than just this module).
5497 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5499 Birthdates rely on negative epoch values.
5501 The payby for card/check batches is broken. With mixed batching, bad
5504 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5508 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5509 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5510 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.