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 card_types );
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->check_payinfo_cardtype
459 || $self->SUPER::insert;
461 $dbh->rollback if $oldAutoCommit;
462 #return "inserting cust_main record (transaction rolled back): $error";
466 # now set cust_location.custnum
467 foreach my $l (qw(bill_location ship_location)) {
468 warn " setting $l.custnum\n"
471 unless ( $loc->custnum ) {
472 $loc->set(custnum => $self->custnum);
473 $error ||= $loc->replace;
477 $dbh->rollback if $oldAutoCommit;
478 return "error setting $l custnum: $error";
482 warn " setting invoicing list\n"
485 if ( $invoicing_list ) {
486 $error = $self->check_invoicing_list( $invoicing_list );
488 $dbh->rollback if $oldAutoCommit;
489 #return "checking invoicing_list (transaction rolled back): $error";
492 $self->invoicing_list( $invoicing_list );
495 warn " setting customer tags\n"
498 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
499 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
500 'custnum' => $self->custnum };
501 my $error = $cust_tag->insert;
503 $dbh->rollback if $oldAutoCommit;
508 my $prospectnum = delete $options{'prospectnum'};
509 if ( $prospectnum ) {
511 warn " moving contacts and locations from prospect $prospectnum\n"
515 qsearchs('prospect_main', { 'prospectnum' => $prospectnum } );
516 unless ( $prospect_main ) {
517 $dbh->rollback if $oldAutoCommit;
518 return "Unknown prospectnum $prospectnum";
520 $prospect_main->custnum($self->custnum);
521 $prospect_main->disabled('Y');
522 my $error = $prospect_main->replace;
524 $dbh->rollback if $oldAutoCommit;
528 my @contact = $prospect_main->contact;
529 my @cust_location = $prospect_main->cust_location;
530 my @qual = $prospect_main->qual;
532 foreach my $r ( @contact, @cust_location, @qual ) {
534 $r->custnum($self->custnum);
535 my $error = $r->replace;
537 $dbh->rollback if $oldAutoCommit;
544 warn " setting contacts\n"
547 if ( my $contact = delete $options{'contact'} ) {
549 foreach my $c ( @$contact ) {
550 $c->custnum($self->custnum);
551 my $error = $c->insert;
553 $dbh->rollback if $oldAutoCommit;
559 } elsif ( my $contact_params = delete $options{'contact_params'} ) {
561 my $error = $self->process_o2m( 'table' => 'contact',
562 'fields' => FS::contact->cgi_contact_fields,
563 'params' => $contact_params,
566 $dbh->rollback if $oldAutoCommit;
571 warn " setting cust_main_exemption\n"
574 my $tax_exemption = delete $options{'tax_exemption'};
575 if ( $tax_exemption ) {
577 $tax_exemption = { map { $_ => '' } @$tax_exemption }
578 if ref($tax_exemption) eq 'ARRAY';
580 foreach my $taxname ( keys %$tax_exemption ) {
581 my $cust_main_exemption = new FS::cust_main_exemption {
582 'custnum' => $self->custnum,
583 'taxname' => $taxname,
584 'exempt_number' => $tax_exemption->{$taxname},
586 my $error = $cust_main_exemption->insert;
588 $dbh->rollback if $oldAutoCommit;
589 return "inserting cust_main_exemption (transaction rolled back): $error";
594 warn " ordering packages\n"
597 $error = $self->order_pkgs( $cust_pkgs,
599 'seconds_ref' => \$seconds,
600 'upbytes_ref' => \$upbytes,
601 'downbytes_ref' => \$downbytes,
602 'totalbytes_ref' => \$totalbytes,
605 $dbh->rollback if $oldAutoCommit;
610 $dbh->rollback if $oldAutoCommit;
611 return "No svc_acct record to apply pre-paid time";
613 if ( $upbytes || $downbytes || $totalbytes ) {
614 $dbh->rollback if $oldAutoCommit;
615 return "No svc_acct record to apply pre-paid data";
619 warn " inserting initial $payby payment of $amount\n"
621 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
623 $dbh->rollback if $oldAutoCommit;
624 return "inserting payment (transaction rolled back): $error";
628 unless ( $import || $skip_fuzzyfiles ) {
629 warn " queueing fuzzyfiles update\n"
631 $error = $self->queue_fuzzyfiles_update;
633 $dbh->rollback if $oldAutoCommit;
634 return "updating fuzzy search cache: $error";
638 # FS::geocode_Mixin::after_insert or something?
639 if ( $conf->config('tax_district_method') and !$import ) {
640 # if anything non-empty, try to look it up
641 my $queue = new FS::queue {
642 'job' => 'FS::geocode_Mixin::process_district_update',
643 'custnum' => $self->custnum,
645 my $error = $queue->insert( ref($self), $self->custnum );
647 $dbh->rollback if $oldAutoCommit;
648 return "queueing tax district update: $error";
653 warn " exporting\n" if $DEBUG > 1;
655 my $export_args = $options{'export_args'} || [];
658 map qsearch( 'part_export', {exportnum=>$_} ),
659 $conf->config('cust_main-exports'); #, $agentnum
661 foreach my $part_export ( @part_export ) {
662 my $error = $part_export->export_insert($self, @$export_args);
664 $dbh->rollback if $oldAutoCommit;
665 return "exporting to ". $part_export->exporttype.
666 " (transaction rolled back): $error";
670 #foreach my $depend_jobnum ( @$depend_jobnums ) {
671 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
673 # foreach my $jobnum ( @jobnums ) {
674 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
675 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
677 # my $error = $queue->depend_insert($depend_jobnum);
679 # $dbh->rollback if $oldAutoCommit;
680 # return "error queuing job dependancy: $error";
687 #if ( exists $options{'jobnums'} ) {
688 # push @{ $options{'jobnums'} }, @jobnums;
691 warn " insert complete; committing transaction\n"
694 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
699 use File::CounterFile;
700 sub auto_agent_custid {
703 my $format = $conf->config('cust_main-auto_agent_custid');
705 if ( $format eq '1YMMXXXXXXXX' ) {
707 my $counter = new File::CounterFile 'cust_main.agent_custid';
710 my $ym = 100000000000 + time2str('%y%m00000000', time);
711 if ( $ym > $counter->value ) {
712 $counter->{'value'} = $agent_custid = $ym;
713 $counter->{'updated'} = 1;
715 $agent_custid = $counter->inc;
721 die "Unknown cust_main-auto_agent_custid format: $format";
724 $self->agent_custid($agent_custid);
728 =item PACKAGE METHODS
730 Documentation on customer package methods has been moved to
731 L<FS::cust_main::Packages>.
733 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
735 Recharges this (existing) customer with the specified prepaid card (see
736 L<FS::prepay_credit>), specified either by I<identifier> or as an
737 FS::prepay_credit object. If there is an error, returns the error, otherwise
740 Optionally, five scalar references can be passed as well. They will have their
741 values filled in with the amount, number of seconds, and number of upload,
742 download, and total bytes applied by this prepaid card.
746 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
747 #the only place that uses these args
748 sub recharge_prepay {
749 my( $self, $prepay_credit, $amountref, $secondsref,
750 $upbytesref, $downbytesref, $totalbytesref ) = @_;
752 local $SIG{HUP} = 'IGNORE';
753 local $SIG{INT} = 'IGNORE';
754 local $SIG{QUIT} = 'IGNORE';
755 local $SIG{TERM} = 'IGNORE';
756 local $SIG{TSTP} = 'IGNORE';
757 local $SIG{PIPE} = 'IGNORE';
759 my $oldAutoCommit = $FS::UID::AutoCommit;
760 local $FS::UID::AutoCommit = 0;
763 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
765 my $error = $self->get_prepay( $prepay_credit,
766 'amount_ref' => \$amount,
767 'seconds_ref' => \$seconds,
768 'upbytes_ref' => \$upbytes,
769 'downbytes_ref' => \$downbytes,
770 'totalbytes_ref' => \$totalbytes,
772 || $self->increment_seconds($seconds)
773 || $self->increment_upbytes($upbytes)
774 || $self->increment_downbytes($downbytes)
775 || $self->increment_totalbytes($totalbytes)
776 || $self->insert_cust_pay_prepay( $amount,
778 ? $prepay_credit->identifier
783 $dbh->rollback if $oldAutoCommit;
787 if ( defined($amountref) ) { $$amountref = $amount; }
788 if ( defined($secondsref) ) { $$secondsref = $seconds; }
789 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
790 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
791 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
793 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
798 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
800 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
801 specified either by I<identifier> or as an FS::prepay_credit object.
803 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
804 incremented by the values of the prepaid card.
806 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
807 check or set this customer's I<agentnum>.
809 If there is an error, returns the error, otherwise returns false.
815 my( $self, $prepay_credit, %opt ) = @_;
817 local $SIG{HUP} = 'IGNORE';
818 local $SIG{INT} = 'IGNORE';
819 local $SIG{QUIT} = 'IGNORE';
820 local $SIG{TERM} = 'IGNORE';
821 local $SIG{TSTP} = 'IGNORE';
822 local $SIG{PIPE} = 'IGNORE';
824 my $oldAutoCommit = $FS::UID::AutoCommit;
825 local $FS::UID::AutoCommit = 0;
828 unless ( ref($prepay_credit) ) {
830 my $identifier = $prepay_credit;
832 $prepay_credit = qsearchs(
834 { 'identifier' => $identifier },
839 unless ( $prepay_credit ) {
840 $dbh->rollback if $oldAutoCommit;
841 return "Invalid prepaid card: ". $identifier;
846 if ( $prepay_credit->agentnum ) {
847 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
848 $dbh->rollback if $oldAutoCommit;
849 return "prepaid card not valid for agent ". $self->agentnum;
851 $self->agentnum($prepay_credit->agentnum);
854 my $error = $prepay_credit->delete;
856 $dbh->rollback if $oldAutoCommit;
857 return "removing prepay_credit (transaction rolled back): $error";
860 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
861 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
863 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
868 =item increment_upbytes SECONDS
870 Updates this customer's single or primary account (see L<FS::svc_acct>) by
871 the specified number of upbytes. If there is an error, returns the error,
872 otherwise returns false.
876 sub increment_upbytes {
877 _increment_column( shift, 'upbytes', @_);
880 =item increment_downbytes SECONDS
882 Updates this customer's single or primary account (see L<FS::svc_acct>) by
883 the specified number of downbytes. If there is an error, returns the error,
884 otherwise returns false.
888 sub increment_downbytes {
889 _increment_column( shift, 'downbytes', @_);
892 =item increment_totalbytes SECONDS
894 Updates this customer's single or primary account (see L<FS::svc_acct>) by
895 the specified number of totalbytes. If there is an error, returns the error,
896 otherwise returns false.
900 sub increment_totalbytes {
901 _increment_column( shift, 'totalbytes', @_);
904 =item increment_seconds SECONDS
906 Updates this customer's single or primary account (see L<FS::svc_acct>) by
907 the specified number of seconds. If there is an error, returns the error,
908 otherwise returns false.
912 sub increment_seconds {
913 _increment_column( shift, 'seconds', @_);
916 =item _increment_column AMOUNT
918 Updates this customer's single or primary account (see L<FS::svc_acct>) by
919 the specified number of seconds or bytes. If there is an error, returns
920 the error, otherwise returns false.
924 sub _increment_column {
925 my( $self, $column, $amount ) = @_;
926 warn "$me increment_column called: $column, $amount\n"
929 return '' unless $amount;
931 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
932 $self->ncancelled_pkgs;
935 return 'No packages with primary or single services found'.
936 ' to apply pre-paid time';
937 } elsif ( scalar(@cust_pkg) > 1 ) {
938 #maybe have a way to specify the package/account?
939 return 'Multiple packages found to apply pre-paid time';
942 my $cust_pkg = $cust_pkg[0];
943 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
947 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
950 return 'No account found to apply pre-paid time';
951 } elsif ( scalar(@cust_svc) > 1 ) {
952 return 'Multiple accounts found to apply pre-paid time';
955 my $svc_acct = $cust_svc[0]->svc_x;
956 warn " found service svcnum ". $svc_acct->pkgnum.
957 ' ('. $svc_acct->email. ")\n"
960 $column = "increment_$column";
961 $svc_acct->$column($amount);
965 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
967 Inserts a prepayment in the specified amount for this customer. An optional
968 second argument can specify the prepayment identifier for tracking purposes.
969 If there is an error, returns the error, otherwise returns false.
973 sub insert_cust_pay_prepay {
974 shift->insert_cust_pay('PREP', @_);
977 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
979 Inserts a cash payment in the specified amount for this customer. An optional
980 second argument can specify the payment identifier for tracking purposes.
981 If there is an error, returns the error, otherwise returns false.
985 sub insert_cust_pay_cash {
986 shift->insert_cust_pay('CASH', @_);
989 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
991 Inserts a Western Union payment in the specified amount for this customer. An
992 optional second argument can specify the prepayment identifier for tracking
993 purposes. If there is an error, returns the error, otherwise returns false.
997 sub insert_cust_pay_west {
998 shift->insert_cust_pay('WEST', @_);
1001 sub insert_cust_pay {
1002 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1003 my $payinfo = scalar(@_) ? shift : '';
1005 my $cust_pay = new FS::cust_pay {
1006 'custnum' => $self->custnum,
1007 'paid' => sprintf('%.2f', $amount),
1008 #'_date' => #date the prepaid card was purchased???
1010 'payinfo' => $payinfo,
1018 This method is deprecated. See the I<depend_jobnum> option to the insert and
1019 order_pkgs methods for a better way to defer provisioning.
1021 Re-schedules all exports by calling the B<reexport> method of all associated
1022 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1023 otherwise returns false.
1030 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1031 "use the depend_jobnum option to insert or order_pkgs to delay export";
1033 local $SIG{HUP} = 'IGNORE';
1034 local $SIG{INT} = 'IGNORE';
1035 local $SIG{QUIT} = 'IGNORE';
1036 local $SIG{TERM} = 'IGNORE';
1037 local $SIG{TSTP} = 'IGNORE';
1038 local $SIG{PIPE} = 'IGNORE';
1040 my $oldAutoCommit = $FS::UID::AutoCommit;
1041 local $FS::UID::AutoCommit = 0;
1044 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1045 my $error = $cust_pkg->reexport;
1047 $dbh->rollback if $oldAutoCommit;
1052 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1057 =item delete [ OPTION => VALUE ... ]
1059 This deletes the customer. If there is an error, returns the error, otherwise
1062 This will completely remove all traces of the customer record. This is not
1063 what you want when a customer cancels service; for that, cancel all of the
1064 customer's packages (see L</cancel>).
1066 If the customer has any uncancelled packages, you need to pass a new (valid)
1067 customer number for those packages to be transferred to, as the "new_customer"
1068 option. Cancelled packages will be deleted. Did I mention that this is NOT
1069 what you want when a customer cancels service and that you really should be
1070 looking at L<FS::cust_pkg/cancel>?
1072 You can't delete a customer with invoices (see L<FS::cust_bill>),
1073 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1074 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1075 set the "delete_financials" option to a true value.
1080 my( $self, %opt ) = @_;
1082 local $SIG{HUP} = 'IGNORE';
1083 local $SIG{INT} = 'IGNORE';
1084 local $SIG{QUIT} = 'IGNORE';
1085 local $SIG{TERM} = 'IGNORE';
1086 local $SIG{TSTP} = 'IGNORE';
1087 local $SIG{PIPE} = 'IGNORE';
1089 my $oldAutoCommit = $FS::UID::AutoCommit;
1090 local $FS::UID::AutoCommit = 0;
1093 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1094 $dbh->rollback if $oldAutoCommit;
1095 return "Can't delete a master agent customer";
1098 #use FS::access_user
1099 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1100 $dbh->rollback if $oldAutoCommit;
1101 return "Can't delete a master employee customer";
1104 tie my %financial_tables, 'Tie::IxHash',
1105 'cust_bill' => 'invoices',
1106 'cust_statement' => 'statements',
1107 'cust_credit' => 'credits',
1108 'cust_pay' => 'payments',
1109 'cust_refund' => 'refunds',
1112 foreach my $table ( keys %financial_tables ) {
1114 my @records = $self->$table();
1116 if ( @records && ! $opt{'delete_financials'} ) {
1117 $dbh->rollback if $oldAutoCommit;
1118 return "Can't delete a customer with ". $financial_tables{$table};
1121 foreach my $record ( @records ) {
1122 my $error = $record->delete;
1124 $dbh->rollback if $oldAutoCommit;
1125 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1131 my @cust_pkg = $self->ncancelled_pkgs;
1133 my $new_custnum = $opt{'new_custnum'};
1134 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1135 $dbh->rollback if $oldAutoCommit;
1136 return "Invalid new customer number: $new_custnum";
1138 foreach my $cust_pkg ( @cust_pkg ) {
1139 my %hash = $cust_pkg->hash;
1140 $hash{'custnum'} = $new_custnum;
1141 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1142 my $error = $new_cust_pkg->replace($cust_pkg,
1143 options => { $cust_pkg->options },
1146 $dbh->rollback if $oldAutoCommit;
1151 my @cancelled_cust_pkg = $self->all_pkgs;
1152 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1153 my $error = $cust_pkg->delete;
1155 $dbh->rollback if $oldAutoCommit;
1160 #cust_tax_adjustment in financials?
1161 #cust_pay_pending? ouch
1163 foreach my $table (qw(
1164 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1165 cust_location cust_main_note cust_tax_adjustment
1166 cust_pay_void cust_pay_batch queue cust_tax_exempt
1168 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1169 my $error = $record->delete;
1171 $dbh->rollback if $oldAutoCommit;
1177 my $sth = $dbh->prepare(
1178 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1180 my $errstr = $dbh->errstr;
1181 $dbh->rollback if $oldAutoCommit;
1184 $sth->execute($self->custnum) or do {
1185 my $errstr = $sth->errstr;
1186 $dbh->rollback if $oldAutoCommit;
1192 my $ticket_dbh = '';
1193 if ($conf->config('ticket_system') eq 'RT_Internal') {
1195 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1196 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1197 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1198 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1201 if ( $ticket_dbh ) {
1203 my $ticket_sth = $ticket_dbh->prepare(
1204 'DELETE FROM Links WHERE Target = ?'
1206 my $errstr = $ticket_dbh->errstr;
1207 $dbh->rollback if $oldAutoCommit;
1210 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1212 my $errstr = $ticket_sth->errstr;
1213 $dbh->rollback if $oldAutoCommit;
1217 #check and see if the customer is the only link on the ticket, and
1218 #if so, set the ticket to deleted status in RT?
1219 #maybe someday, for now this will at least fix tickets not displaying
1223 #delete the customer record
1225 my $error = $self->SUPER::delete;
1227 $dbh->rollback if $oldAutoCommit;
1231 # cust_main exports!
1233 #my $export_args = $options{'export_args'} || [];
1236 map qsearch( 'part_export', {exportnum=>$_} ),
1237 $conf->config('cust_main-exports'); #, $agentnum
1239 foreach my $part_export ( @part_export ) {
1240 my $error = $part_export->export_delete( $self ); #, @$export_args);
1242 $dbh->rollback if $oldAutoCommit;
1243 return "exporting to ". $part_export->exporttype.
1244 " (transaction rolled back): $error";
1248 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1253 =item merge NEW_CUSTNUM [ , OPTION => VALUE ... ]
1255 This merges this customer into the provided new custnum, and then deletes the
1256 customer. If there is an error, returns the error, otherwise returns false.
1258 The source customer's name, company name, phone numbers, agent,
1259 referring customer, customer class, advertising source, order taker, and
1260 billing information (except balance) are discarded.
1262 All packages are moved to the target customer. Packages with package locations
1263 are preserved. Packages without package locations are moved to a new package
1264 location with the source customer's service/shipping address.
1266 All invoices, statements, payments, credits and refunds are moved to the target
1267 customer. The source customer's balance is added to the target customer.
1269 All notes, attachments, tickets and customer tags are moved to the target
1272 Change history is not currently moved.
1277 my( $self, $new_custnum, %opt ) = @_;
1279 return "Can't merge a customer into self" if $self->custnum == $new_custnum;
1281 my $new_cust_main = qsearchs( 'cust_main', { 'custnum' => $new_custnum } )
1282 or return "Invalid new customer number: $new_custnum";
1284 return 'Access denied: "Merge customer across agents" access right required to merge into a customer of a different agent'
1285 if $self->agentnum != $new_cust_main->agentnum
1286 && ! $FS::CurrentUser::CurrentUser->access_right('Merge customer across agents');
1288 local $SIG{HUP} = 'IGNORE';
1289 local $SIG{INT} = 'IGNORE';
1290 local $SIG{QUIT} = 'IGNORE';
1291 local $SIG{TERM} = 'IGNORE';
1292 local $SIG{TSTP} = 'IGNORE';
1293 local $SIG{PIPE} = 'IGNORE';
1295 my $oldAutoCommit = $FS::UID::AutoCommit;
1296 local $FS::UID::AutoCommit = 0;
1299 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1300 $dbh->rollback if $oldAutoCommit;
1301 return "Can't merge a master agent customer";
1304 #use FS::access_user
1305 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1306 $dbh->rollback if $oldAutoCommit;
1307 return "Can't merge a master employee customer";
1310 if ( qsearch('cust_pay_pending', { 'custnum' => $self->custnum,
1311 'status' => { op=>'!=', value=>'done' },
1315 $dbh->rollback if $oldAutoCommit;
1316 return "Can't merge a customer with pending payments";
1319 tie my %financial_tables, 'Tie::IxHash',
1320 'cust_bill' => 'invoices',
1321 'cust_bill_void' => 'voided invoices',
1322 'cust_statement' => 'statements',
1323 'cust_credit' => 'credits',
1324 'cust_credit_void' => 'voided credits',
1325 'cust_pay' => 'payments',
1326 'cust_pay_void' => 'voided payments',
1327 'cust_refund' => 'refunds',
1330 foreach my $table ( keys %financial_tables ) {
1332 my @records = $self->$table();
1334 foreach my $record ( @records ) {
1335 $record->custnum($new_custnum);
1336 my $error = $record->replace;
1338 $dbh->rollback if $oldAutoCommit;
1339 return "Error merging ". $financial_tables{$table}. ": $error\n";
1345 my $name = $self->ship_name; #?
1347 my $locationnum = '';
1348 foreach my $cust_pkg ( $self->all_pkgs ) {
1349 $cust_pkg->custnum($new_custnum);
1351 unless ( $cust_pkg->locationnum ) {
1352 unless ( $locationnum ) {
1353 my $cust_location = new FS::cust_location {
1354 $self->location_hash,
1355 'custnum' => $new_custnum,
1357 my $error = $cust_location->insert;
1359 $dbh->rollback if $oldAutoCommit;
1362 $locationnum = $cust_location->locationnum;
1364 $cust_pkg->locationnum($locationnum);
1367 my $error = $cust_pkg->replace;
1369 $dbh->rollback if $oldAutoCommit;
1373 # add customer (ship) name to svc_phone.phone_name if blank
1374 my @cust_svc = $cust_pkg->cust_svc;
1375 foreach my $cust_svc (@cust_svc) {
1376 my($label, $value, $svcdb) = $cust_svc->label;
1377 next unless $svcdb eq 'svc_phone';
1378 my $svc_phone = $cust_svc->svc_x;
1379 next if $svc_phone->phone_name;
1380 $svc_phone->phone_name($name);
1381 my $error = $svc_phone->replace;
1383 $dbh->rollback if $oldAutoCommit;
1391 # cust_tax_exempt (texas tax exemptions)
1392 # cust_recon (some sort of not-well understood thing for OnPac)
1394 #these are moved over
1395 foreach my $table (qw(
1396 cust_tag cust_location contact cust_attachment cust_main_note
1397 cust_tax_adjustment cust_pay_batch queue
1399 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1400 $record->custnum($new_custnum);
1401 my $error = $record->replace;
1403 $dbh->rollback if $oldAutoCommit;
1409 #these aren't preserved
1410 foreach my $table (qw(
1411 cust_main_exemption cust_main_invoice
1413 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1414 my $error = $record->delete;
1416 $dbh->rollback if $oldAutoCommit;
1423 my $sth = $dbh->prepare(
1424 'UPDATE cust_main SET referral_custnum = ? WHERE referral_custnum = ?'
1426 my $errstr = $dbh->errstr;
1427 $dbh->rollback if $oldAutoCommit;
1430 $sth->execute($new_custnum, $self->custnum) or do {
1431 my $errstr = $sth->errstr;
1432 $dbh->rollback if $oldAutoCommit;
1438 my $ticket_dbh = '';
1439 if ($conf->config('ticket_system') eq 'RT_Internal') {
1441 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1442 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1443 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1444 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1447 if ( $ticket_dbh ) {
1449 my $ticket_sth = $ticket_dbh->prepare(
1450 'UPDATE Links SET Target = ? WHERE Target = ?'
1452 my $errstr = $ticket_dbh->errstr;
1453 $dbh->rollback if $oldAutoCommit;
1456 $ticket_sth->execute('freeside://freeside/cust_main/'.$new_custnum,
1457 'freeside://freeside/cust_main/'.$self->custnum)
1459 my $errstr = $ticket_sth->errstr;
1460 $dbh->rollback if $oldAutoCommit;
1466 #delete the customer record
1468 my $error = $self->delete;
1470 $dbh->rollback if $oldAutoCommit;
1474 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1479 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1481 Replaces the OLD_RECORD with this one in the database. If there is an error,
1482 returns the error, otherwise returns false.
1484 To change the customer's address, set the pseudo-fields C<bill_location> and
1485 C<ship_location>. The address will still only change if at least one of the
1486 address fields differs from the existing values.
1488 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1489 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1490 expected and rollback the entire transaction; it is not necessary to call
1491 check_invoicing_list first. Here's an example:
1493 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1495 Currently available options are: I<tax_exemption>.
1497 The I<tax_exemption> option can be set to an arrayref of tax names or a hashref
1498 of tax names and exemption numbers. FS::cust_main_exemption records will be
1499 deleted and inserted as appropriate.
1506 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1508 : $self->replace_old;
1512 warn "$me replace called\n"
1515 my $curuser = $FS::CurrentUser::CurrentUser;
1516 if ( $self->payby eq 'COMP'
1517 && $self->payby ne $old->payby
1518 && ! $curuser->access_right('Complimentary customer')
1521 return "You are not permitted to create complimentary accounts.";
1524 local($ignore_expired_card) = 1
1525 if $old->payby =~ /^(CARD|DCRD)$/
1526 && $self->payby =~ /^(CARD|DCRD)$/
1527 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1529 local($ignore_banned_card) = 1
1530 if ( $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/
1531 || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ )
1532 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1534 if ( $self->payby =~ /^(CARD|DCRD)$/
1535 && $old->payinfo ne $self->payinfo
1536 && $old->paymask ne $self->paymask )
1538 my $error = $self->check_payinfo_cardtype;
1539 return $error if $error;
1542 return "Invoicing locale is required"
1545 && $conf->exists('cust_main-require_locale');
1547 local $SIG{HUP} = 'IGNORE';
1548 local $SIG{INT} = 'IGNORE';
1549 local $SIG{QUIT} = 'IGNORE';
1550 local $SIG{TERM} = 'IGNORE';
1551 local $SIG{TSTP} = 'IGNORE';
1552 local $SIG{PIPE} = 'IGNORE';
1554 my $oldAutoCommit = $FS::UID::AutoCommit;
1555 local $FS::UID::AutoCommit = 0;
1558 for my $l (qw(bill_location ship_location)) {
1559 my $old_loc = $old->$l;
1560 my $new_loc = $self->$l;
1562 # find the existing location if there is one
1563 $new_loc->set('custnum' => $self->custnum);
1564 my $error = $new_loc->find_or_insert;
1566 $dbh->rollback if $oldAutoCommit;
1569 $self->set($l.'num', $new_loc->locationnum);
1572 # replace the customer record
1573 my $error = $self->SUPER::replace($old);
1576 $dbh->rollback if $oldAutoCommit;
1580 # now move packages to the new service location
1581 $self->set('ship_location', ''); #flush cache
1582 if ( $old->ship_locationnum and # should only be null during upgrade...
1583 $old->ship_locationnum != $self->ship_locationnum ) {
1584 $error = $old->ship_location->move_to($self->ship_location);
1586 $dbh->rollback if $oldAutoCommit;
1590 # don't move packages based on the billing location, but
1591 # disable it if it's no longer in use
1592 if ( $old->bill_locationnum and
1593 $old->bill_locationnum != $self->bill_locationnum ) {
1594 $error = $old->bill_location->disable_if_unused;
1596 $dbh->rollback if $oldAutoCommit;
1601 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1602 my $invoicing_list = shift @param;
1603 $error = $self->check_invoicing_list( $invoicing_list );
1605 $dbh->rollback if $oldAutoCommit;
1608 $self->invoicing_list( $invoicing_list );
1611 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1613 #this could be more efficient than deleting and re-inserting, if it matters
1614 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1615 my $error = $cust_tag->delete;
1617 $dbh->rollback if $oldAutoCommit;
1621 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1622 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1623 'custnum' => $self->custnum };
1624 my $error = $cust_tag->insert;
1626 $dbh->rollback if $oldAutoCommit;
1633 my %options = @param;
1635 my $tax_exemption = delete $options{'tax_exemption'};
1636 if ( $tax_exemption ) {
1638 $tax_exemption = { map { $_ => '' } @$tax_exemption }
1639 if ref($tax_exemption) eq 'ARRAY';
1641 my %cust_main_exemption =
1642 map { $_->taxname => $_ }
1643 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1645 foreach my $taxname ( keys %$tax_exemption ) {
1647 if ( $cust_main_exemption{$taxname} &&
1648 $cust_main_exemption{$taxname}->exempt_number eq $tax_exemption->{$taxname}
1651 delete $cust_main_exemption{$taxname};
1655 my $cust_main_exemption = new FS::cust_main_exemption {
1656 'custnum' => $self->custnum,
1657 'taxname' => $taxname,
1658 'exempt_number' => $tax_exemption->{$taxname},
1660 my $error = $cust_main_exemption->insert;
1662 $dbh->rollback if $oldAutoCommit;
1663 return "inserting cust_main_exemption (transaction rolled back): $error";
1667 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1668 my $error = $cust_main_exemption->delete;
1670 $dbh->rollback if $oldAutoCommit;
1671 return "deleting cust_main_exemption (transaction rolled back): $error";
1677 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1678 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1679 && $self->get('payinfo') !~ /^99\d{14}$/
1681 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1686 # card/check/lec info has changed, want to retry realtime_ invoice events
1687 my $error = $self->retry_realtime;
1689 $dbh->rollback if $oldAutoCommit;
1694 unless ( $import || $skip_fuzzyfiles ) {
1695 $error = $self->queue_fuzzyfiles_update;
1697 $dbh->rollback if $oldAutoCommit;
1698 return "updating fuzzy search cache: $error";
1702 # tax district update in cust_location
1704 # cust_main exports!
1706 my $export_args = $options{'export_args'} || [];
1709 map qsearch( 'part_export', {exportnum=>$_} ),
1710 $conf->config('cust_main-exports'); #, $agentnum
1712 foreach my $part_export ( @part_export ) {
1713 my $error = $part_export->export_replace( $self, $old, @$export_args);
1715 $dbh->rollback if $oldAutoCommit;
1716 return "exporting to ". $part_export->exporttype.
1717 " (transaction rolled back): $error";
1721 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1726 =item queue_fuzzyfiles_update
1728 Used by insert & replace to update the fuzzy search cache
1732 use FS::cust_main::Search;
1733 sub queue_fuzzyfiles_update {
1736 local $SIG{HUP} = 'IGNORE';
1737 local $SIG{INT} = 'IGNORE';
1738 local $SIG{QUIT} = 'IGNORE';
1739 local $SIG{TERM} = 'IGNORE';
1740 local $SIG{TSTP} = 'IGNORE';
1741 local $SIG{PIPE} = 'IGNORE';
1743 my $oldAutoCommit = $FS::UID::AutoCommit;
1744 local $FS::UID::AutoCommit = 0;
1747 foreach my $field ( 'first', 'last', 'company', 'ship_company' ) {
1748 my $queue = new FS::queue {
1749 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1751 my @args = "cust_main.$field", $self->get($field);
1752 my $error = $queue->insert( @args );
1754 $dbh->rollback if $oldAutoCommit;
1755 return "queueing job (transaction rolled back): $error";
1759 my @locations = $self->bill_location;
1760 push @locations, $self->ship_location if $self->has_ship_address;
1761 foreach my $location (@locations) {
1762 my $queue = new FS::queue {
1763 'job' => 'FS::cust_main::Search::append_fuzzyfiles_fuzzyfield'
1765 my @args = 'cust_location.address1', $location->address1;
1766 my $error = $queue->insert( @args );
1768 $dbh->rollback if $oldAutoCommit;
1769 return "queueing job (transaction rolled back): $error";
1773 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1780 Checks all fields to make sure this is a valid customer record. If there is
1781 an error, returns the error, otherwise returns false. Called by the insert
1782 and replace methods.
1789 warn "$me check BEFORE: \n". $self->_dump
1793 $self->ut_numbern('custnum')
1794 || $self->ut_number('agentnum')
1795 || $self->ut_textn('agent_custid')
1796 || $self->ut_number('refnum')
1797 || $self->ut_foreign_key('bill_locationnum', 'cust_location','locationnum')
1798 || $self->ut_foreign_key('ship_locationnum', 'cust_location','locationnum')
1799 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1800 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
1801 || $self->ut_textn('custbatch')
1802 || $self->ut_name('last')
1803 || $self->ut_name('first')
1804 || $self->ut_snumbern('signupdate')
1805 || $self->ut_snumbern('birthdate')
1806 || $self->ut_namen('spouse_last')
1807 || $self->ut_namen('spouse_first')
1808 || $self->ut_snumbern('spouse_birthdate')
1809 || $self->ut_snumbern('anniversary_date')
1810 || $self->ut_textn('company')
1811 || $self->ut_textn('ship_company')
1812 || $self->ut_anything('comments')
1813 || $self->ut_numbern('referral_custnum')
1814 || $self->ut_textn('stateid')
1815 || $self->ut_textn('stateid_state')
1816 || $self->ut_textn('invoice_terms')
1817 || $self->ut_floatn('cdr_termination_percentage')
1818 || $self->ut_floatn('credit_limit')
1819 || $self->ut_numbern('billday')
1820 || $self->ut_numbern('prorate_day')
1821 || $self->ut_flag('edit_subject')
1822 || $self->ut_flag('calling_list_exempt')
1823 || $self->ut_flag('invoice_noemail')
1824 || $self->ut_flag('message_noemail')
1825 || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1826 || $self->ut_flag('invoice_ship_address')
1829 foreach (qw(company ship_company)) {
1830 my $company = $self->get($_);
1831 $company =~ s/^\s+//;
1832 $company =~ s/\s+$//;
1833 $company =~ s/\s+/ /g;
1834 $self->set($_, $company);
1837 #barf. need message catalogs. i18n. etc.
1838 $error .= "Please select an advertising source."
1839 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1840 return $error if $error;
1842 return "Unknown agent"
1843 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1845 return "Unknown refnum"
1846 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1848 return "Unknown referring custnum: ". $self->referral_custnum
1849 unless ! $self->referral_custnum
1850 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1852 if ( $self->ss eq '' ) {
1857 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1858 or return "Illegal social security number: ". $self->ss;
1859 $self->ss("$1-$2-$3");
1862 #turn off invoice_ship_address if ship & bill are the same
1863 if ($self->bill_locationnum eq $self->ship_locationnum) {
1864 $self->invoice_ship_address('');
1867 # cust_main_county verification now handled by cust_location check
1870 $self->ut_phonen('daytime', $self->country)
1871 || $self->ut_phonen('night', $self->country)
1872 || $self->ut_phonen('fax', $self->country)
1873 || $self->ut_phonen('mobile', $self->country)
1875 return $error if $error;
1877 if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1879 && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1882 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1884 : FS::Msgcat::_gettext('daytime');
1885 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1887 : FS::Msgcat::_gettext('night');
1889 my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1891 : FS::Msgcat::_gettext('mobile');
1893 return "$daytime_label, $night_label or $mobile_label is required"
1897 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1898 # or return "Illegal payby: ". $self->payby;
1900 FS::payby->can_payby($self->table, $self->payby)
1901 or return "Illegal payby: ". $self->payby;
1903 $error = $self->ut_numbern('paystart_month')
1904 || $self->ut_numbern('paystart_year')
1905 || $self->ut_numbern('payissue')
1906 || $self->ut_textn('paytype')
1908 return $error if $error;
1910 if ( $self->payip eq '' ) {
1913 $error = $self->ut_ip('payip');
1914 return $error if $error;
1917 # If it is encrypted and the private key is not availaible then we can't
1918 # check the credit card.
1919 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1921 # Need some kind of global flag to accept invalid cards, for testing
1923 if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1925 my $payinfo = $self->payinfo;
1926 $payinfo =~ s/\D//g;
1927 $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1928 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1930 $self->payinfo($payinfo);
1932 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1934 return gettext('unknown_card_type')
1935 if $self->payinfo !~ /^99\d{14}$/ #token
1936 && cardtype($self->payinfo) eq "Unknown";
1938 unless ( $ignore_banned_card ) {
1939 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1941 if ( $ban->bantype eq 'warn' ) {
1942 #or others depending on value of $ban->reason ?
1943 return '_duplicate_card'.
1944 ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1945 ' until '. time2str('%a %h %o at %r', $ban->_end_date).
1946 ' (ban# '. $ban->bannum. ')'
1947 unless $self->override_ban_warn;
1949 return 'Banned credit card: banned on '.
1950 time2str('%a %h %o at %r', $ban->_date).
1951 ' by '. $ban->otaker.
1952 ' (ban# '. $ban->bannum. ')';
1957 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1958 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1959 $self->paycvv =~ /^(\d{4})$/
1960 or return "CVV2 (CID) for American Express cards is four digits.";
1963 $self->paycvv =~ /^(\d{3})$/
1964 or return "CVV2 (CVC2/CID) is three digits.";
1971 my $cardtype = cardtype($payinfo);
1972 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1974 return "Start date or issue number is required for $cardtype cards"
1975 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1977 return "Start month must be between 1 and 12"
1978 if $self->paystart_month
1979 and $self->paystart_month < 1 || $self->paystart_month > 12;
1981 return "Start year must be 1990 or later"
1982 if $self->paystart_year
1983 and $self->paystart_year < 1990;
1985 return "Issue number must be beween 1 and 99"
1987 and $self->payissue < 1 || $self->payissue > 99;
1990 $self->paystart_month('');
1991 $self->paystart_year('');
1992 $self->payissue('');
1995 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1997 my $payinfo = $self->payinfo;
1998 $payinfo =~ s/[^\d\@\.]//g;
1999 if ( $conf->config('echeck-country') eq 'CA' ) {
2000 $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
2001 or return 'invalid echeck account@branch.bank';
2002 $payinfo = "$1\@$2.$3";
2003 } elsif ( $conf->config('echeck-country') eq 'US' ) {
2004 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
2005 $payinfo = "$1\@$2";
2007 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
2008 $payinfo = "$1\@$2";
2010 $self->payinfo($payinfo);
2013 unless ( $ignore_banned_card ) {
2014 my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
2016 if ( $ban->bantype eq 'warn' ) {
2017 #or others depending on value of $ban->reason ?
2018 return '_duplicate_ach' unless $self->override_ban_warn;
2020 return 'Banned ACH account: banned on '.
2021 time2str('%a %h %o at %r', $ban->_date).
2022 ' by '. $ban->otaker.
2023 ' (ban# '. $ban->bannum. ')';
2028 } elsif ( $self->payby eq 'LECB' ) {
2030 my $payinfo = $self->payinfo;
2031 $payinfo =~ s/\D//g;
2032 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2034 $self->payinfo($payinfo);
2037 } elsif ( $self->payby eq 'BILL' ) {
2039 $error = $self->ut_textn('payinfo');
2040 return "Illegal P.O. number: ". $self->payinfo if $error;
2043 } elsif ( $self->payby eq 'COMP' ) {
2045 my $curuser = $FS::CurrentUser::CurrentUser;
2046 if ( ! $self->custnum
2047 && ! $curuser->access_right('Complimentary customer')
2050 return "You are not permitted to create complimentary accounts."
2053 $error = $self->ut_textn('payinfo');
2054 return "Illegal comp account issuer: ". $self->payinfo if $error;
2057 } elsif ( $self->payby eq 'PREPAY' ) {
2059 my $payinfo = $self->payinfo;
2060 $payinfo =~ s/\W//g; #anything else would just confuse things
2061 $self->payinfo($payinfo);
2062 $error = $self->ut_alpha('payinfo');
2063 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2064 return "Unknown prepayment identifier"
2065 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2070 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2071 return "Expiration date required"
2072 # shouldn't payinfo_check do this?
2073 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
2077 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2078 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2079 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2080 ( $m, $y ) = ( $2, "19$1" );
2081 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2082 ( $m, $y ) = ( $3, "20$2" );
2084 return "Illegal expiration date: ". $self->paydate;
2086 $m = sprintf('%02d',$m);
2087 $self->paydate("$y-$m-01");
2088 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2089 return gettext('expired_card')
2091 && !$ignore_expired_card
2092 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2095 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2096 ( ! $conf->exists('require_cardname')
2097 || $self->payby !~ /^(CARD|DCRD)$/ )
2099 $self->payname( $self->first. " ". $self->getfield('last') );
2102 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2103 $self->payname =~ /^([\w \,\.\-\']*)$/
2104 or return gettext('illegal_name'). " payname: ". $self->payname;
2107 $self->payname =~ /^([\w \,\.\-\'\&]*)$/
2108 or return gettext('illegal_name'). " payname: ". $self->payname;
2114 return "Please select an invoicing locale"
2117 && $conf->exists('cust_main-require_locale');
2119 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2120 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2124 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2126 warn "$me check AFTER: \n". $self->_dump
2129 $self->SUPER::check;
2132 sub check_payinfo_cardtype {
2135 return '' unless $self->payby =~ /^(CARD|DCRD)$/;
2137 my $payinfo = $self->payinfo;
2138 $payinfo =~ s/\D//g;
2140 return '' if $payinfo =~ /^99\d{14}$/; #token
2142 my %bop_card_types = map { $_=>1 } values %{ card_types() };
2143 my $cardtype = cardtype($payinfo);
2145 return "$cardtype not accepted" unless $bop_card_types{$cardtype};
2153 Additional checks for replace only.
2158 my ($new,$old) = @_;
2159 #preserve old value if global config is set
2160 if ($old && $conf->exists('invoice-ship_address')) {
2161 $new->invoice_ship_address($old->invoice_ship_address);
2168 Returns a list of fields which have ship_ duplicates.
2173 qw( last first company
2175 address1 address2 city county state zip country
2177 daytime night fax mobile
2181 =item has_ship_address
2183 Returns true if this customer record has a separate shipping address.
2187 sub has_ship_address {
2189 $self->bill_locationnum != $self->ship_locationnum;
2194 Returns a list of key/value pairs, with the following keys: address1,
2195 adddress2, city, county, state, zip, country, district, and geocode. The
2196 shipping address is used if present.
2202 $self->ship_location->location_hash;
2207 Returns all locations (see L<FS::cust_location>) for this customer.
2213 qsearch('cust_location', { 'custnum' => $self->custnum,
2214 'prospectnum' => '' } );
2219 Returns all contacts (see L<FS::contact>) for this customer.
2223 #already used :/ sub contact {
2226 qsearch('contact', { 'custnum' => $self->custnum } );
2231 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2232 and L<FS::cust_pkg>) for this customer, except those on hold.
2234 Returns a list: an empty list on success or a list of errors.
2240 grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs;
2245 Unsuspends all suspended packages in the on-hold state (those without setup
2246 dates) for this customer.
2252 grep { (!$_->setup) && $_->unsuspend } $self->suspended_pkgs;
2257 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2259 Returns a list: an empty list on success or a list of errors.
2265 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2268 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2270 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2271 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2272 of a list of pkgparts; the hashref has the following keys:
2276 =item pkgparts - listref of pkgparts
2278 =item (other options are passed to the suspend method)
2283 Returns a list: an empty list on success or a list of errors.
2287 sub suspend_if_pkgpart {
2289 my (@pkgparts, %opt);
2290 if (ref($_[0]) eq 'HASH'){
2291 @pkgparts = @{$_[0]{pkgparts}};
2296 grep { $_->suspend(%opt) }
2297 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2298 $self->unsuspended_pkgs;
2301 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2303 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2304 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2305 instead of a list of pkgparts; the hashref has the following keys:
2309 =item pkgparts - listref of pkgparts
2311 =item (other options are passed to the suspend method)
2315 Returns a list: an empty list on success or a list of errors.
2319 sub suspend_unless_pkgpart {
2321 my (@pkgparts, %opt);
2322 if (ref($_[0]) eq 'HASH'){
2323 @pkgparts = @{$_[0]{pkgparts}};
2328 grep { $_->suspend(%opt) }
2329 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2330 $self->unsuspended_pkgs;
2333 =item cancel [ OPTION => VALUE ... ]
2335 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2337 Available options are:
2341 =item quiet - can be set true to supress email cancellation notices.
2343 =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.
2345 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2347 =item nobill - can be set true to skip billing if it might otherwise be done.
2351 Always returns a list: an empty list on success or a list of errors.
2355 # nb that dates are not specified as valid options to this method
2358 my( $self, %opt ) = @_;
2360 warn "$me cancel called on customer ". $self->custnum. " with options ".
2361 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2364 return ( 'access denied' )
2365 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2367 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2369 #should try decryption (we might have the private key)
2370 # and if not maybe queue a job for the server that does?
2371 return ( "Can't (yet) ban encrypted credit cards" )
2372 if $self->is_encrypted($self->payinfo);
2374 my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2375 my $error = $ban->insert;
2376 return ( $error ) if $error;
2380 my @pkgs = $self->ncancelled_pkgs;
2382 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2384 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2385 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2389 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2390 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2393 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2396 sub _banned_pay_hashref {
2407 'payby' => $payby2ban{$self->payby},
2408 'payinfo' => $self->payinfo,
2409 #don't ever *search* on reason! #'reason' =>
2413 sub _new_banned_pay_hashref {
2415 my $hr = $self->_banned_pay_hashref;
2416 $hr->{payinfo} = md5_base64($hr->{payinfo});
2422 Returns all notes (see L<FS::cust_main_note>) for this customer.
2427 my($self,$orderby_classnum) = (shift,shift);
2428 my $orderby = "sticky DESC, _date DESC";
2429 $orderby = "classnum ASC, $orderby" if $orderby_classnum;
2430 qsearch( 'cust_main_note',
2431 { 'custnum' => $self->custnum },
2433 "ORDER BY $orderby",
2439 Returns the agent (see L<FS::agent>) for this customer.
2445 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2450 Returns the agent name (see L<FS::agent>) for this customer.
2456 $self->agent->agent;
2461 Returns any tags associated with this customer, as FS::cust_tag objects,
2462 or an empty list if there are no tags.
2468 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2473 Returns any tags associated with this customer, as FS::part_tag objects,
2474 or an empty list if there are no tags.
2480 map $_->part_tag, $self->cust_tag;
2486 Returns the customer class, as an FS::cust_class object, or the empty string
2487 if there is no customer class.
2493 if ( $self->classnum ) {
2494 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2502 Returns the customer category name, or the empty string if there is no customer
2509 my $cust_class = $self->cust_class;
2511 ? $cust_class->categoryname
2517 Returns the customer class name, or the empty string if there is no customer
2524 my $cust_class = $self->cust_class;
2526 ? $cust_class->classname
2530 =item BILLING METHODS
2532 Documentation on billing methods has been moved to
2533 L<FS::cust_main::Billing>.
2535 =item REALTIME BILLING METHODS
2537 Documentation on realtime billing methods has been moved to
2538 L<FS::cust_main::Billing_Realtime>.
2542 Removes the I<paycvv> field from the database directly.
2544 If there is an error, returns the error, otherwise returns false.
2550 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2551 or return dbh->errstr;
2552 $sth->execute($self->custnum)
2553 or return $sth->errstr;
2558 =item batch_card OPTION => VALUE...
2560 Adds a payment for this invoice to the pending credit card batch (see
2561 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2562 runs the payment using a realtime gateway.
2564 Options may include:
2566 B<amount>: the amount to be paid; defaults to the customer's balance minus
2567 any payments in transit.
2569 B<payby>: the payment method; defaults to cust_main.payby
2571 B<realtime>: runs this as a realtime payment instead of adding it to a
2574 B<invnum>: sets cust_pay_batch.invnum.
2576 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2577 the billing address for the payment; defaults to the customer's billing
2580 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2581 date, and name; defaults to those fields in cust_main.
2586 my ($self, %options) = @_;
2589 if (exists($options{amount})) {
2590 $amount = $options{amount};
2592 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2595 warn(sprintf("Customer balance %.2f - in transit amount %.2f is <= 0.\n",
2597 $self->in_transit_payments
2602 my $invnum = delete $options{invnum};
2603 my $payby = $options{payby} || $self->payby; #still dubious
2605 if ($options{'realtime'}) {
2606 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2612 my $oldAutoCommit = $FS::UID::AutoCommit;
2613 local $FS::UID::AutoCommit = 0;
2616 #this needs to handle mysql as well as Pg, like svc_acct.pm
2617 #(make it into a common function if folks need to do batching with mysql)
2618 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2619 or return "Cannot lock pay_batch: " . $dbh->errstr;
2623 'payby' => FS::payby->payby2payment($payby),
2625 $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2627 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2629 unless ( $pay_batch ) {
2630 $pay_batch = new FS::pay_batch \%pay_batch;
2631 my $error = $pay_batch->insert;
2633 $dbh->rollback if $oldAutoCommit;
2634 die "error creating new batch: $error\n";
2638 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2639 'batchnum' => $pay_batch->batchnum,
2640 'custnum' => $self->custnum,
2643 foreach (qw( address1 address2 city state zip country latitude longitude
2644 payby payinfo paydate payname ))
2646 $options{$_} = '' unless exists($options{$_});
2649 my $loc = $self->bill_location;
2651 my $cust_pay_batch = new FS::cust_pay_batch ( {
2652 'batchnum' => $pay_batch->batchnum,
2653 'invnum' => $invnum || 0, # is there a better value?
2654 # this field should be
2656 # cust_bill_pay_batch now
2657 'custnum' => $self->custnum,
2658 'last' => $self->getfield('last'),
2659 'first' => $self->getfield('first'),
2660 'address1' => $options{address1} || $loc->address1,
2661 'address2' => $options{address2} || $loc->address2,
2662 'city' => $options{city} || $loc->city,
2663 'state' => $options{state} || $loc->state,
2664 'zip' => $options{zip} || $loc->zip,
2665 'country' => $options{country} || $loc->country,
2666 'payby' => $options{payby} || $self->payby,
2667 'payinfo' => $options{payinfo} || $self->payinfo,
2668 'exp' => $options{paydate} || $self->paydate,
2669 'payname' => $options{payname} || $self->payname,
2670 'amount' => $amount, # consolidating
2673 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2674 if $old_cust_pay_batch;
2677 if ($old_cust_pay_batch) {
2678 $error = $cust_pay_batch->replace($old_cust_pay_batch)
2680 $error = $cust_pay_batch->insert;
2684 $dbh->rollback if $oldAutoCommit;
2688 my $unapplied = $self->total_unapplied_credits
2689 + $self->total_unapplied_payments
2690 + $self->in_transit_payments;
2691 foreach my $cust_bill ($self->open_cust_bill) {
2692 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2693 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2694 'invnum' => $cust_bill->invnum,
2695 'paybatchnum' => $cust_pay_batch->paybatchnum,
2696 'amount' => $cust_bill->owed,
2699 if ($unapplied >= $cust_bill_pay_batch->amount){
2700 $unapplied -= $cust_bill_pay_batch->amount;
2703 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2704 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
2706 $error = $cust_bill_pay_batch->insert;
2708 $dbh->rollback if $oldAutoCommit;
2713 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2719 Returns the total owed for this customer on all invoices
2720 (see L<FS::cust_bill/owed>).
2726 $self->total_owed_date(2145859200); #12/31/2037
2729 =item total_owed_date TIME
2731 Returns the total owed for this customer on all invoices with date earlier than
2732 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2733 see L<Time::Local> and L<Date::Parse> for conversion functions.
2737 sub total_owed_date {
2741 my $custnum = $self->custnum;
2743 my $owed_sql = FS::cust_bill->owed_sql;
2746 SELECT SUM($owed_sql) FROM cust_bill
2747 WHERE custnum = $custnum
2751 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2755 =item total_owed_pkgnum PKGNUM
2757 Returns the total owed on all invoices for this customer's specific package
2758 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2762 sub total_owed_pkgnum {
2763 my( $self, $pkgnum ) = @_;
2764 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2767 =item total_owed_date_pkgnum TIME PKGNUM
2769 Returns the total owed for this customer's specific package when using
2770 experimental package balances on all invoices with date earlier than
2771 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
2772 see L<Time::Local> and L<Date::Parse> for conversion functions.
2776 sub total_owed_date_pkgnum {
2777 my( $self, $time, $pkgnum ) = @_;
2780 foreach my $cust_bill (
2781 grep { $_->_date <= $time }
2782 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2784 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2786 sprintf( "%.2f", $total_bill );
2792 Returns the total amount of all payments.
2799 $total += $_->paid foreach $self->cust_pay;
2800 sprintf( "%.2f", $total );
2803 =item total_unapplied_credits
2805 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2806 customer. See L<FS::cust_credit/credited>.
2808 =item total_credited
2810 Old name for total_unapplied_credits. Don't use.
2814 sub total_credited {
2815 #carp "total_credited deprecated, use total_unapplied_credits";
2816 shift->total_unapplied_credits(@_);
2819 sub total_unapplied_credits {
2822 my $custnum = $self->custnum;
2824 my $unapplied_sql = FS::cust_credit->unapplied_sql;
2827 SELECT SUM($unapplied_sql) FROM cust_credit
2828 WHERE custnum = $custnum
2831 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2835 =item total_unapplied_credits_pkgnum PKGNUM
2837 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2838 customer. See L<FS::cust_credit/credited>.
2842 sub total_unapplied_credits_pkgnum {
2843 my( $self, $pkgnum ) = @_;
2844 my $total_credit = 0;
2845 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2846 sprintf( "%.2f", $total_credit );
2850 =item total_unapplied_payments
2852 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2853 See L<FS::cust_pay/unapplied>.
2857 sub total_unapplied_payments {
2860 my $custnum = $self->custnum;
2862 my $unapplied_sql = FS::cust_pay->unapplied_sql;
2865 SELECT SUM($unapplied_sql) FROM cust_pay
2866 WHERE custnum = $custnum
2869 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2873 =item total_unapplied_payments_pkgnum PKGNUM
2875 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2876 specific package when using experimental package balances. See
2877 L<FS::cust_pay/unapplied>.
2881 sub total_unapplied_payments_pkgnum {
2882 my( $self, $pkgnum ) = @_;
2883 my $total_unapplied = 0;
2884 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2885 sprintf( "%.2f", $total_unapplied );
2889 =item total_unapplied_refunds
2891 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2892 customer. See L<FS::cust_refund/unapplied>.
2896 sub total_unapplied_refunds {
2898 my $custnum = $self->custnum;
2900 my $unapplied_sql = FS::cust_refund->unapplied_sql;
2903 SELECT SUM($unapplied_sql) FROM cust_refund
2904 WHERE custnum = $custnum
2907 sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2913 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2914 total_unapplied_credits minus total_unapplied_payments).
2920 $self->balance_date_range;
2923 =item balance_date TIME
2925 Returns the balance for this customer, only considering invoices with date
2926 earlier than TIME (total_owed_date minus total_credited minus
2927 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
2928 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
2935 $self->balance_date_range(shift);
2938 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2940 Returns the balance for this customer, optionally considering invoices with
2941 date earlier than START_TIME, and not later than END_TIME
2942 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2944 Times are specified as SQL fragments or numeric
2945 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
2946 L<Date::Parse> for conversion functions. The empty string can be passed
2947 to disable that time constraint completely.
2949 Accepts the same options as L<balance_date_sql>:
2953 =item unapplied_date
2955 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)
2959 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
2960 time will be ignored. Note that START_TIME and END_TIME only limit the date
2961 range for invoices and I<unapplied> payments, credits, and refunds.
2967 sub balance_date_range {
2969 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2970 ') FROM cust_main WHERE custnum='. $self->custnum;
2971 sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2974 =item balance_pkgnum PKGNUM
2976 Returns the balance for this customer's specific package when using
2977 experimental package balances (total_owed plus total_unrefunded, minus
2978 total_unapplied_credits minus total_unapplied_payments)
2982 sub balance_pkgnum {
2983 my( $self, $pkgnum ) = @_;
2986 $self->total_owed_pkgnum($pkgnum)
2987 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2988 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
2989 - $self->total_unapplied_credits_pkgnum($pkgnum)
2990 - $self->total_unapplied_payments_pkgnum($pkgnum)
2994 =item in_transit_payments
2996 Returns the total of requests for payments for this customer pending in
2997 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
3001 sub in_transit_payments {
3003 my $in_transit_payments = 0;
3004 foreach my $pay_batch ( qsearch('pay_batch', {
3007 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3008 'batchnum' => $pay_batch->batchnum,
3009 'custnum' => $self->custnum,
3012 $in_transit_payments += $cust_pay_batch->amount;
3015 sprintf( "%.2f", $in_transit_payments );
3020 Returns a hash of useful information for making a payment.
3030 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3031 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3032 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3036 For credit card transactions:
3048 For electronic check transactions:
3063 $return{balance} = $self->balance;
3065 $return{payname} = $self->payname
3066 || ( $self->first. ' '. $self->get('last') );
3068 $return{$_} = $self->bill_location->$_
3069 for qw(address1 address2 city state zip);
3071 $return{payby} = $self->payby;
3072 $return{stateid_state} = $self->stateid_state;
3074 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3075 $return{card_type} = cardtype($self->payinfo);
3076 $return{payinfo} = $self->paymask;
3078 @return{'month', 'year'} = $self->paydate_monthyear;
3082 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3083 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3084 $return{payinfo1} = $payinfo1;
3085 $return{payinfo2} = $payinfo2;
3086 $return{paytype} = $self->paytype;
3087 $return{paystate} = $self->paystate;
3091 #doubleclick protection
3093 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3099 =item paydate_monthyear
3101 Returns a two-element list consisting of the month and year of this customer's
3102 paydate (credit card expiration date for CARD customers)
3106 sub paydate_monthyear {
3108 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3110 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3119 Returns the exact time in seconds corresponding to the payment method
3120 expiration date. For CARD/DCRD customers this is the end of the month;
3121 for others (COMP is the only other payby that uses paydate) it's the start.
3122 Returns 0 if the paydate is empty or set to the far future.
3128 my ($month, $year) = $self->paydate_monthyear;
3129 return 0 if !$year or $year >= 2037;
3130 if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3132 if ( $month == 13 ) {
3136 return timelocal(0,0,0,1,$month-1,$year) - 1;
3139 return timelocal(0,0,0,1,$month-1,$year);
3143 =item paydate_epoch_sql
3145 Class method. Returns an SQL expression to obtain the payment expiration date
3146 as a number of seconds.
3150 # Special expiration date behavior for non-CARD/DCRD customers has been
3151 # carefully preserved. Do we really use that?
3152 sub paydate_epoch_sql {
3154 my $table = shift || 'cust_main';
3155 my ($case1, $case2);
3156 if ( driver_name eq 'Pg' ) {
3157 $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3158 $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3160 elsif ( lc(driver_name) eq 'mysql' ) {
3161 $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3162 $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3165 return "CASE WHEN $table.payby IN('CARD','DCRD')
3171 =item tax_exemption TAXNAME
3176 my( $self, $taxname ) = @_;
3178 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3179 'taxname' => $taxname,
3184 =item cust_main_exemption
3188 sub cust_main_exemption {
3190 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3193 =item invoicing_list [ ARRAYREF ]
3195 If an arguement is given, sets these email addresses as invoice recipients
3196 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3197 (except as warnings), so use check_invoicing_list first.
3199 Returns a list of email addresses (with svcnum entries expanded).
3201 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3202 check it without disturbing anything by passing nothing.
3204 This interface may change in the future.
3208 sub invoicing_list {
3209 my( $self, $arrayref ) = @_;
3212 my @cust_main_invoice;
3213 if ( $self->custnum ) {
3214 @cust_main_invoice =
3215 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3217 @cust_main_invoice = ();
3219 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3220 #warn $cust_main_invoice->destnum;
3221 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3222 #warn $cust_main_invoice->destnum;
3223 my $error = $cust_main_invoice->delete;
3224 warn $error if $error;
3227 if ( $self->custnum ) {
3228 @cust_main_invoice =
3229 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3231 @cust_main_invoice = ();
3233 my %seen = map { $_->address => 1 } @cust_main_invoice;
3234 foreach my $address ( @{$arrayref} ) {
3235 next if exists $seen{$address} && $seen{$address};
3236 $seen{$address} = 1;
3237 my $cust_main_invoice = new FS::cust_main_invoice ( {
3238 'custnum' => $self->custnum,
3241 my $error = $cust_main_invoice->insert;
3242 warn $error if $error;
3246 if ( $self->custnum ) {
3248 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3255 =item check_invoicing_list ARRAYREF
3257 Checks these arguements as valid input for the invoicing_list method. If there
3258 is an error, returns the error, otherwise returns false.
3262 sub check_invoicing_list {
3263 my( $self, $arrayref ) = @_;
3265 foreach my $address ( @$arrayref ) {
3267 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3268 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3271 my $cust_main_invoice = new FS::cust_main_invoice ( {
3272 'custnum' => $self->custnum,
3275 my $error = $self->custnum
3276 ? $cust_main_invoice->check
3277 : $cust_main_invoice->checkdest
3279 return $error if $error;
3283 return "Email address required"
3284 if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3285 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3290 =item set_default_invoicing_list
3292 Sets the invoicing list to all accounts associated with this customer,
3293 overwriting any previous invoicing list.
3297 sub set_default_invoicing_list {
3299 $self->invoicing_list($self->all_emails);
3304 Returns the email addresses of all accounts provisioned for this customer.
3311 foreach my $cust_pkg ( $self->all_pkgs ) {
3312 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3314 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3315 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3317 $list{$_}=1 foreach map { $_->email } @svc_acct;
3322 =item invoicing_list_addpost
3324 Adds postal invoicing to this customer. If this customer is already configured
3325 to receive postal invoices, does nothing.
3329 sub invoicing_list_addpost {
3331 return if grep { $_ eq 'POST' } $self->invoicing_list;
3332 my @invoicing_list = $self->invoicing_list;
3333 push @invoicing_list, 'POST';
3334 $self->invoicing_list(\@invoicing_list);
3337 =item invoicing_list_emailonly
3339 Returns the list of email invoice recipients (invoicing_list without non-email
3340 destinations such as POST and FAX).
3344 sub invoicing_list_emailonly {
3346 warn "$me invoicing_list_emailonly called"
3348 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3351 =item invoicing_list_emailonly_scalar
3353 Returns the list of email invoice recipients (invoicing_list without non-email
3354 destinations such as POST and FAX) as a comma-separated scalar.
3358 sub invoicing_list_emailonly_scalar {
3360 warn "$me invoicing_list_emailonly_scalar called"
3362 join(', ', $self->invoicing_list_emailonly);
3365 =item referral_custnum_cust_main
3367 Returns the customer who referred this customer (or the empty string, if
3368 this customer was not referred).
3370 Note the difference with referral_cust_main method: This method,
3371 referral_custnum_cust_main returns the single customer (if any) who referred
3372 this customer, while referral_cust_main returns an array of customers referred
3377 sub referral_custnum_cust_main {
3379 return '' unless $self->referral_custnum;
3380 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3383 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3385 Returns an array of customers referred by this customer (referral_custnum set
3386 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3387 customers referred by customers referred by this customer and so on, inclusive.
3388 The default behavior is DEPTH 1 (no recursion).
3390 Note the difference with referral_custnum_cust_main method: This method,
3391 referral_cust_main, returns an array of customers referred BY this customer,
3392 while referral_custnum_cust_main returns the single customer (if any) who
3393 referred this customer.
3397 sub referral_cust_main {
3399 my $depth = @_ ? shift : 1;
3400 my $exclude = @_ ? shift : {};
3403 map { $exclude->{$_->custnum}++; $_; }
3404 grep { ! $exclude->{ $_->custnum } }
3405 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3409 map { $_->referral_cust_main($depth-1, $exclude) }
3416 =item referral_cust_main_ncancelled
3418 Same as referral_cust_main, except only returns customers with uncancelled
3423 sub referral_cust_main_ncancelled {
3425 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3428 =item referral_cust_pkg [ DEPTH ]
3430 Like referral_cust_main, except returns a flat list of all unsuspended (and
3431 uncancelled) packages for each customer. The number of items in this list may
3432 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3436 sub referral_cust_pkg {
3438 my $depth = @_ ? shift : 1;
3440 map { $_->unsuspended_pkgs }
3441 grep { $_->unsuspended_pkgs }
3442 $self->referral_cust_main($depth);
3445 =item referring_cust_main
3447 Returns the single cust_main record for the customer who referred this customer
3448 (referral_custnum), or false.
3452 sub referring_cust_main {
3454 return '' unless $self->referral_custnum;
3455 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3458 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3460 Applies a credit to this customer. If there is an error, returns the error,
3461 otherwise returns false.
3463 REASON can be a text string, an FS::reason object, or a scalar reference to
3464 a reasonnum. If a text string, it will be automatically inserted as a new
3465 reason, and a 'reason_type' option must be passed to indicate the
3466 FS::reason_type for the new reason.
3468 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3469 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3470 I<commission_pkgnum>.
3472 Any other options are passed to FS::cust_credit::insert.
3477 my( $self, $amount, $reason, %options ) = @_;
3479 my $cust_credit = new FS::cust_credit {
3480 'custnum' => $self->custnum,
3481 'amount' => $amount,
3484 if ( ref($reason) ) {
3486 if ( ref($reason) eq 'SCALAR' ) {
3487 $cust_credit->reasonnum( $$reason );
3489 $cust_credit->reasonnum( $reason->reasonnum );
3493 $cust_credit->set('reason', $reason)
3496 $cust_credit->$_( delete $options{$_} )
3497 foreach grep exists($options{$_}),
3498 qw( addlinfo eventnum ),
3499 map "commission_$_", qw( agentnum salesnum pkgnum );
3501 $cust_credit->insert(%options);
3505 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3507 Creates a one-time charge for this customer. If there is an error, returns
3508 the error, otherwise returns false.
3510 New-style, with a hashref of options:
3512 my $error = $cust_main->charge(
3516 'start_date' => str2time('7/4/2009'),
3517 'pkg' => 'Description',
3518 'comment' => 'Comment',
3519 'additional' => [], #extra invoice detail
3520 'classnum' => 1, #pkg_class
3522 'setuptax' => '', # or 'Y' for tax exempt
3524 'locationnum'=> 1234, # optional
3527 'taxclass' => 'Tax class',
3530 'taxproduct' => 2, #part_pkg_taxproduct
3531 'override' => {}, #XXX describe
3533 #will be filled in with the new object
3534 'cust_pkg_ref' => \$cust_pkg,
3536 #generate an invoice immediately
3538 'invoice_terms' => '', #with these terms
3544 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3548 #super false laziness w/quotation::charge
3551 my ( $amount, $setup_cost, $quantity, $start_date, $classnum );
3552 my ( $pkg, $comment, $additional );
3553 my ( $setuptax, $taxclass ); #internal taxes
3554 my ( $taxproduct, $override ); #vendor (CCH) taxes
3556 my $separate_bill = '';
3557 my $cust_pkg_ref = '';
3558 my ( $bill_now, $invoice_terms ) = ( 0, '' );
3560 if ( ref( $_[0] ) ) {
3561 $amount = $_[0]->{amount};
3562 $setup_cost = $_[0]->{setup_cost};
3563 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3564 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3565 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3566 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3567 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
3568 : '$'. sprintf("%.2f",$amount);
3569 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3570 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3571 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3572 $additional = $_[0]->{additional} || [];
3573 $taxproduct = $_[0]->{taxproductnum};
3574 $override = { '' => $_[0]->{tax_override} };
3575 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3576 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3577 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3578 $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3579 $separate_bill = $_[0]->{separate_bill} || '';
3585 $pkg = @_ ? shift : 'One-time charge';
3586 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
3588 $taxclass = @_ ? shift : '';
3592 local $SIG{HUP} = 'IGNORE';
3593 local $SIG{INT} = 'IGNORE';
3594 local $SIG{QUIT} = 'IGNORE';
3595 local $SIG{TERM} = 'IGNORE';
3596 local $SIG{TSTP} = 'IGNORE';
3597 local $SIG{PIPE} = 'IGNORE';
3599 my $oldAutoCommit = $FS::UID::AutoCommit;
3600 local $FS::UID::AutoCommit = 0;
3603 my $part_pkg = new FS::part_pkg ( {
3605 'comment' => $comment,
3609 'classnum' => ( $classnum ? $classnum : '' ),
3610 'setuptax' => $setuptax,
3611 'taxclass' => $taxclass,
3612 'taxproductnum' => $taxproduct,
3613 'setup_cost' => $setup_cost,
3616 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3617 ( 0 .. @$additional - 1 )
3619 'additional_count' => scalar(@$additional),
3620 'setup_fee' => $amount,
3623 my $error = $part_pkg->insert( options => \%options,
3624 tax_overrides => $override,
3627 $dbh->rollback if $oldAutoCommit;
3631 my $pkgpart = $part_pkg->pkgpart;
3632 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3633 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3634 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3635 $error = $type_pkgs->insert;
3637 $dbh->rollback if $oldAutoCommit;
3642 my $cust_pkg = new FS::cust_pkg ( {
3643 'custnum' => $self->custnum,
3644 'pkgpart' => $pkgpart,
3645 'quantity' => $quantity,
3646 'start_date' => $start_date,
3647 'no_auto' => $no_auto,
3648 'separate_bill' => $separate_bill,
3649 'locationnum'=> $locationnum,
3652 $error = $cust_pkg->insert;
3654 $dbh->rollback if $oldAutoCommit;
3656 } elsif ( $cust_pkg_ref ) {
3657 ${$cust_pkg_ref} = $cust_pkg;
3661 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3662 'pkg_list' => [ $cust_pkg ],
3665 $dbh->rollback if $oldAutoCommit;
3670 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3675 #=item charge_postal_fee
3677 #Applies a one time charge this customer. If there is an error,
3678 #returns the error, returns the cust_pkg charge object or false
3679 #if there was no charge.
3683 # This should be a customer event. For that to work requires that bill
3684 # also be a customer event.
3686 sub charge_postal_fee {
3689 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3690 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3692 my $cust_pkg = new FS::cust_pkg ( {
3693 'custnum' => $self->custnum,
3694 'pkgpart' => $pkgpart,
3698 my $error = $cust_pkg->insert;
3699 $error ? $error : $cust_pkg;
3702 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3704 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3706 Optionally, a list or hashref of additional arguments to the qsearch call can
3713 my $opt = ref($_[0]) ? shift : { @_ };
3715 #return $self->num_cust_bill unless wantarray || keys %$opt;
3717 $opt->{'table'} = 'cust_bill';
3718 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3719 $opt->{'hashref'}{'custnum'} = $self->custnum;
3720 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3722 map { $_ } #behavior of sort undefined in scalar context
3723 sort { $a->_date <=> $b->_date }
3727 =item open_cust_bill
3729 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3734 sub open_cust_bill {
3738 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3744 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3746 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3750 sub legacy_cust_bill {
3753 #return $self->num_legacy_cust_bill unless wantarray;
3755 map { $_ } #behavior of sort undefined in scalar context
3756 sort { $a->_date <=> $b->_date }
3757 qsearch({ 'table' => 'legacy_cust_bill',
3758 'hashref' => { 'custnum' => $self->custnum, },
3759 'order_by' => 'ORDER BY _date ASC',
3763 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3765 Returns all the statements (see L<FS::cust_statement>) for this customer.
3767 Optionally, a list or hashref of additional arguments to the qsearch call can
3772 =item cust_bill_void
3774 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3778 sub cust_bill_void {
3781 map { $_ } #return $self->num_cust_bill_void unless wantarray;
3782 sort { $a->_date <=> $b->_date }
3783 qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3786 sub cust_statement {
3788 my $opt = ref($_[0]) ? shift : { @_ };
3790 #return $self->num_cust_statement unless wantarray || keys %$opt;
3792 $opt->{'table'} = 'cust_statement';
3793 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3794 $opt->{'hashref'}{'custnum'} = $self->custnum;
3795 $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3797 map { $_ } #behavior of sort undefined in scalar context
3798 sort { $a->_date <=> $b->_date }
3802 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3804 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3806 Optionally, a list or hashref of additional arguments to the qsearch call can
3807 be passed following the SVCDB.
3814 if ( ! $svcdb =~ /^svc_\w+$/ ) {
3815 warn "$me svc_x requires a svcdb";
3818 my $opt = ref($_[0]) ? shift : { @_ };
3820 $opt->{'table'} = $svcdb;
3821 $opt->{'addl_from'} =
3822 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3823 ($opt->{'addl_from'} || '');
3825 my $custnum = $self->custnum;
3826 $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3827 my $where = "cust_pkg.custnum = $custnum";
3829 my $extra_sql = $opt->{'extra_sql'} || '';
3830 if ( keys %{ $opt->{'hashref'} } ) {
3831 $extra_sql = " AND $where $extra_sql";
3834 if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3835 $extra_sql = "WHERE $where AND $1";
3838 $extra_sql = "WHERE $where $extra_sql";
3841 $opt->{'extra_sql'} = $extra_sql;
3846 # required for use as an eventtable;
3849 $self->svc_x('svc_acct', @_);
3854 Returns all the credits (see L<FS::cust_credit>) for this customer.
3860 map { $_ } #return $self->num_cust_credit unless wantarray;
3861 sort { $a->_date <=> $b->_date }
3862 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3865 =item cust_credit_pkgnum
3867 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3868 package when using experimental package balances.
3872 sub cust_credit_pkgnum {
3873 my( $self, $pkgnum ) = @_;
3874 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3875 sort { $a->_date <=> $b->_date }
3876 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3877 'pkgnum' => $pkgnum,
3882 =item cust_credit_void
3884 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3888 sub cust_credit_void {
3891 sort { $a->_date <=> $b->_date }
3892 qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3897 Returns all the payments (see L<FS::cust_pay>) for this customer.
3903 my $opt = ref($_[0]) ? shift : { @_ };
3905 return $self->num_cust_pay unless wantarray || keys %$opt;
3907 $opt->{'table'} = 'cust_pay';
3908 $opt->{'hashref'}{'custnum'} = $self->custnum;
3910 map { $_ } #behavior of sort undefined in scalar context
3911 sort { $a->_date <=> $b->_date }
3918 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
3919 called automatically when the cust_pay method is used in a scalar context.
3925 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3926 my $sth = dbh->prepare($sql) or die dbh->errstr;
3927 $sth->execute($self->custnum) or die $sth->errstr;
3928 $sth->fetchrow_arrayref->[0];
3931 =item unapplied_cust_pay
3933 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3937 sub unapplied_cust_pay {
3941 'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3947 =item cust_pay_pkgnum
3949 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3950 package when using experimental package balances.
3954 sub cust_pay_pkgnum {
3955 my( $self, $pkgnum ) = @_;
3956 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3957 sort { $a->_date <=> $b->_date }
3958 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3959 'pkgnum' => $pkgnum,
3966 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3972 map { $_ } #return $self->num_cust_pay_void unless wantarray;
3973 sort { $a->_date <=> $b->_date }
3974 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3977 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3979 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3981 Optionally, a list or hashref of additional arguments to the qsearch call can
3986 sub cust_pay_batch {
3988 my $opt = ref($_[0]) ? shift : { @_ };
3990 #return $self->num_cust_statement unless wantarray || keys %$opt;
3992 $opt->{'table'} = 'cust_pay_batch';
3993 $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3994 $opt->{'hashref'}{'custnum'} = $self->custnum;
3995 $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3997 map { $_ } #behavior of sort undefined in scalar context
3998 sort { $a->paybatchnum <=> $b->paybatchnum }
4002 =item cust_pay_pending
4004 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4005 (without status "done").
4009 sub cust_pay_pending {
4011 return $self->num_cust_pay_pending unless wantarray;
4012 sort { $a->_date <=> $b->_date }
4013 qsearch( 'cust_pay_pending', {
4014 'custnum' => $self->custnum,
4015 'status' => { op=>'!=', value=>'done' },
4020 =item cust_pay_pending_attempt
4022 Returns all payment attempts / declined payments for this customer, as pending
4023 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4024 a corresponding payment (see L<FS::cust_pay>).
4028 sub cust_pay_pending_attempt {
4030 return $self->num_cust_pay_pending_attempt unless wantarray;
4031 sort { $a->_date <=> $b->_date }
4032 qsearch( 'cust_pay_pending', {
4033 'custnum' => $self->custnum,
4040 =item num_cust_pay_pending
4042 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4043 customer (without status "done"). Also called automatically when the
4044 cust_pay_pending method is used in a scalar context.
4048 sub num_cust_pay_pending {
4051 " SELECT COUNT(*) FROM cust_pay_pending ".
4052 " WHERE custnum = ? AND status != 'done' ",
4057 =item num_cust_pay_pending_attempt
4059 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4060 customer, with status "done" but without a corresp. Also called automatically when the
4061 cust_pay_pending method is used in a scalar context.
4065 sub num_cust_pay_pending_attempt {
4068 " SELECT COUNT(*) FROM cust_pay_pending ".
4069 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4076 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4082 map { $_ } #return $self->num_cust_refund unless wantarray;
4083 sort { $a->_date <=> $b->_date }
4084 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4087 =item display_custnum
4089 Returns the displayed customer number for this customer: agent_custid if
4090 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4094 sub display_custnum {
4097 my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
4098 if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
4099 if ( $special eq 'CoStAg' ) {
4100 $prefix = uc( join('',
4102 ($self->state =~ /^(..)/),
4103 $prefix || ($self->agent->agent =~ /^(..)/)
4106 elsif ( $special eq 'CoStCl' ) {
4107 $prefix = uc( join('',
4109 ($self->state =~ /^(..)/),
4110 ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
4113 # add any others here if needed
4116 my $length = $conf->config('cust_main-custnum-display_length');
4117 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4118 return $self->agent_custid;
4119 } elsif ( $prefix ) {
4120 $length = 8 if !defined($length);
4122 sprintf('%0'.$length.'d', $self->custnum)
4123 } elsif ( $length ) {
4124 return sprintf('%0'.$length.'d', $self->custnum);
4126 return $self->custnum;
4132 Returns a name string for this customer, either "Company (Last, First)" or
4139 my $name = $self->contact;
4140 $name = $self->company. " ($name)" if $self->company;
4144 =item service_contact
4146 Returns the L<FS::contact> object for this customer that has the 'Service'
4147 contact class, or undef if there is no such contact. Deprecated; don't use
4152 sub service_contact {
4154 if ( !exists($self->{service_contact}) ) {
4155 my $classnum = $self->scalar_sql(
4156 'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4157 ) || 0; #if it's zero, qsearchs will return nothing
4158 $self->{service_contact} = qsearchs('contact', {
4159 'classnum' => $classnum, 'custnum' => $self->custnum
4162 $self->{service_contact};
4167 Returns a name string for this (service/shipping) contact, either
4168 "Company (Last, First)" or "Last, First".
4175 my $name = $self->ship_contact;
4176 $name = $self->company. " ($name)" if $self->company;
4182 Returns a name string for this customer, either "Company" or "First Last".
4188 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4191 =item ship_name_short
4193 Returns a name string for this (service/shipping) contact, either "Company"
4198 sub ship_name_short {
4200 $self->service_contact
4201 ? $self->ship_contact_firstlast
4207 Returns this customer's full (billing) contact name only, "Last, First"
4213 $self->get('last'). ', '. $self->first;
4218 Returns this customer's full (shipping) contact name only, "Last, First"
4224 my $contact = $self->service_contact || $self;
4225 $contact->get('last') . ', ' . $contact->get('first');
4228 =item contact_firstlast
4230 Returns this customers full (billing) contact name only, "First Last".
4234 sub contact_firstlast {
4236 $self->first. ' '. $self->get('last');
4239 =item ship_contact_firstlast
4241 Returns this customer's full (shipping) contact name only, "First Last".
4245 sub ship_contact_firstlast {
4247 my $contact = $self->service_contact || $self;
4248 $contact->get('first') . ' '. $contact->get('last');
4251 sub bill_country_full {
4253 $self->bill_location->country_full;
4256 sub ship_country_full {
4258 $self->ship_location->country_full;
4261 =item county_state_county [ PREFIX ]
4263 Returns a string consisting of just the county, state and country.
4267 sub county_state_country {
4270 if ( @_ && $_[0] && $self->has_ship_address ) {
4271 $locationnum = $self->ship_locationnum;
4273 $locationnum = $self->bill_locationnum;
4275 my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4276 $cust_location->county_state_country;
4279 =item geocode DATA_VENDOR
4281 Returns a value for the customer location as encoded by DATA_VENDOR.
4282 Currently this only makes sense for "CCH" as DATA_VENDOR.
4290 Returns a status string for this customer, currently:
4294 =item prospect - No packages have ever been ordered
4296 =item ordered - Recurring packages all are new (not yet billed).
4298 =item active - One or more recurring packages is active
4300 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4302 =item suspended - All non-cancelled recurring packages are suspended
4304 =item cancelled - All recurring packages are cancelled
4308 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4309 cust_main-status_module configuration option.
4313 sub status { shift->cust_status(@_); }
4317 for my $status ( FS::cust_main->statuses() ) {
4318 my $method = $status.'_sql';
4319 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4320 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4321 $sth->execute( ($self->custnum) x $numnum )
4322 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4323 return $status if $sth->fetchrow_arrayref->[0];
4327 =item is_status_delay_cancel
4329 Returns true if customer status is 'suspended'
4330 and all suspended cust_pkg return true for
4331 cust_pkg->is_status_delay_cancel.
4333 This is not a real status, this only meant for hacking display
4334 values, because otherwise treating the customer as suspended is
4335 really the whole point of the delay_cancel option.
4339 sub is_status_delay_cancel {
4341 return 0 unless $self->status eq 'suspended';
4342 foreach my $cust_pkg ($self->ncancelled_pkgs) {
4343 return 0 unless $cust_pkg->is_status_delay_cancel;
4348 =item ucfirst_cust_status
4350 =item ucfirst_status
4352 Returns the status with the first character capitalized.
4356 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4358 sub ucfirst_cust_status {
4360 ucfirst($self->cust_status);
4365 Returns a hex triplet color string for this customer's status.
4369 sub statuscolor { shift->cust_statuscolor(@_); }
4371 sub cust_statuscolor {
4373 __PACKAGE__->statuscolors->{$self->cust_status};
4376 =item tickets [ STATUS ]
4378 Returns an array of hashes representing the customer's RT tickets.
4380 An optional status (or arrayref or hashref of statuses) may be specified.
4386 my $status = ( @_ && $_[0] ) ? shift : '';
4388 my $num = $conf->config('cust_main-max_tickets') || 10;
4391 if ( $conf->config('ticket_system') ) {
4392 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4394 @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4403 foreach my $priority (
4404 $conf->config('ticket_system-custom_priority_field-values'), ''
4406 last if scalar(@tickets) >= $num;
4408 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4409 $num - scalar(@tickets),
4420 =item appointments [ STATUS ]
4422 Returns an array of hashes representing the customer's RT tickets which
4429 my $status = ( @_ && $_[0] ) ? shift : '';
4431 return () unless $conf->config('ticket_system');
4433 my $queueid = $conf->config('ticket_system-appointment-queueid');
4435 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4444 # Return services representing svc_accts in customer support packages
4445 sub support_services {
4447 my %packages = map { $_ => 1 } $conf->config('support_packages');
4449 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4450 grep { $_->part_svc->svcdb eq 'svc_acct' }
4451 map { $_->cust_svc }
4452 grep { exists $packages{ $_->pkgpart } }
4453 $self->ncancelled_pkgs;
4457 # Return a list of latitude/longitude for one of the services (if any)
4458 sub service_coordinates {
4462 grep { $_->latitude && $_->longitude }
4464 map { $_->cust_svc }
4465 $self->ncancelled_pkgs;
4467 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4472 Returns a masked version of the named field
4477 my ($self,$field) = @_;
4481 'x'x(length($self->getfield($field))-4).
4482 substr($self->getfield($field), (length($self->getfield($field))-4));
4486 =item payment_history
4488 Returns an array of hashrefs standardizing information from cust_bill, cust_pay,
4489 cust_credit and cust_refund objects. Each hashref has the following fields:
4491 I<type> - one of 'Line item', 'Invoice', 'Payment', 'Credit', 'Refund' or 'Previous'
4493 I<date> - value of _date field, unix timestamp
4495 I<date_pretty> - user-friendly date
4497 I<description> - user-friendly description of item
4499 I<amount> - impact of item on user's balance
4500 (positive for Invoice/Refund/Line item, negative for Payment/Credit.)
4501 Not to be confused with the native 'amount' field in cust_credit, see below.
4503 I<amount_pretty> - includes money char
4505 I<balance> - customer balance, chronologically as of this item
4507 I<balance_pretty> - includes money char
4509 I<charged> - amount charged for cust_bill (Invoice or Line item) records, undef for other types
4511 I<paid> - amount paid for cust_pay records, undef for other types
4513 I<credit> - amount credited for cust_credit records, undef for other types.
4514 Literally the 'amount' field from cust_credit, renamed here to avoid confusion.
4516 I<refund> - amount refunded for cust_refund records, undef for other types
4518 The four table-specific keys always have positive values, whether they reflect charges or payments.
4520 The following options may be passed to this method:
4522 I<line_items> - if true, returns charges ('Line item') rather than invoices
4524 I<start_date> - unix timestamp, only include records on or after.
4525 If specified, an item of type 'Previous' will also be included.
4526 It does not have table-specific fields.
4528 I<end_date> - unix timestamp, only include records before
4530 I<reverse_sort> - order from newest to oldest (default is oldest to newest)
4532 I<conf> - optional already-loaded FS::Conf object.
4536 # Caution: this gets used by FS::ClientAPI::MyAccount::billing_history,
4537 # and also for sending customer statements, which should both be kept customer-friendly.
4538 # If you add anything that shouldn't be passed on through the API or exposed
4539 # to customers, add a new option to include it, don't include it by default
4540 sub payment_history {
4542 my $opt = ref($_[0]) ? $_[0] : { @_ };
4544 my $conf = $$opt{'conf'} || new FS::Conf;
4545 my $money_char = $conf->config("money_char") || '$',
4547 #first load entire history,
4548 #need previous to calculate previous balance
4549 #loading after end_date shouldn't hurt too much?
4551 if ( $$opt{'line_items'} ) {
4553 foreach my $cust_bill ( $self->cust_bill ) {
4556 'type' => 'Line item',
4557 'description' => $_->desc( $self->locale ).
4558 ( $_->sdate && $_->edate
4559 ? ' '. time2str('%d-%b-%Y', $_->sdate).
4560 ' To '. time2str('%d-%b-%Y', $_->edate)
4563 'amount' => sprintf('%.2f', $_->setup + $_->recur ),
4564 'charged' => sprintf('%.2f', $_->setup + $_->recur ),
4565 'date' => $cust_bill->_date,
4566 'date_pretty' => $self->time2str_local('short', $cust_bill->_date ),
4568 foreach $cust_bill->cust_bill_pkg;
4575 'type' => 'Invoice',
4576 'description' => 'Invoice #'. $_->display_invnum,
4577 'amount' => sprintf('%.2f', $_->charged ),
4578 'charged' => sprintf('%.2f', $_->charged ),
4579 'date' => $_->_date,
4580 'date_pretty' => $self->time2str_local('short', $_->_date ),
4582 foreach $self->cust_bill;
4587 'type' => 'Payment',
4588 'description' => 'Payment', #XXX type
4589 'amount' => sprintf('%.2f', 0 - $_->paid ),
4590 'paid' => sprintf('%.2f', $_->paid ),
4591 'date' => $_->_date,
4592 'date_pretty' => $self->time2str_local('short', $_->_date ),
4594 foreach $self->cust_pay;
4598 'description' => 'Credit', #more info?
4599 'amount' => sprintf('%.2f', 0 -$_->amount ),
4600 'credit' => sprintf('%.2f', $_->amount ),
4601 'date' => $_->_date,
4602 'date_pretty' => $self->time2str_local('short', $_->_date ),
4604 foreach $self->cust_credit;
4608 'description' => 'Refund', #more info? type, like payment?
4609 'amount' => $_->refund,
4610 'refund' => $_->refund,
4611 'date' => $_->_date,
4612 'date_pretty' => $self->time2str_local('short', $_->_date ),
4614 foreach $self->cust_refund;
4616 #put it all in chronological order
4617 @history = sort { $a->{'date'} <=> $b->{'date'} } @history;
4619 #calculate balance, filter items outside date range
4623 foreach my $item (@history) {
4624 last if $$opt{'end_date'} && ($$item{'date'} >= $$opt{'end_date'});
4625 $balance += $$item{'amount'};
4626 if ($$opt{'start_date'} && ($$item{'date'} < $$opt{'start_date'})) {
4627 $previous += $$item{'amount'};
4630 $$item{'balance'} = sprintf("%.2f",$balance);
4631 foreach my $key ( qw(amount balance) ) {
4632 $$item{$key.'_pretty'} = money_pretty($$item{$key});
4637 # start with previous balance, if there was one
4640 'type' => 'Previous',
4641 'description' => 'Previous balance',
4642 'amount' => sprintf("%.2f",$previous),
4643 'balance' => sprintf("%.2f",$previous),
4644 'date' => $$opt{'start_date'},
4645 'date_pretty' => $self->time2str_local('short', $$opt{'start_date'} ),
4647 #false laziness with above
4648 foreach my $key ( qw(amount balance) ) {
4649 $$item{$key.'_pretty'} = $$item{$key};
4650 $$item{$key.'_pretty'} =~ s/^(-?)/$1$money_char/;
4652 unshift(@out,$item);
4655 @out = reverse @history if $$opt{'reverse_sort'};
4662 =head1 CLASS METHODS
4668 Class method that returns the list of possible status strings for customers
4669 (see L<the status method|/status>). For example:
4671 @statuses = FS::cust_main->statuses();
4677 keys %{ $self->statuscolors };
4680 =item cust_status_sql
4682 Returns an SQL fragment to determine the status of a cust_main record, as a
4687 sub cust_status_sql {
4689 for my $status ( FS::cust_main->statuses() ) {
4690 my $method = $status.'_sql';
4691 $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4700 Returns an SQL expression identifying prospective cust_main records (customers
4701 with no packages ever ordered)
4705 use vars qw($select_count_pkgs);
4706 $select_count_pkgs =
4707 "SELECT COUNT(*) FROM cust_pkg
4708 WHERE cust_pkg.custnum = cust_main.custnum";
4710 sub select_count_pkgs_sql {
4715 " 0 = ( $select_count_pkgs ) ";
4720 Returns an SQL expression identifying ordered cust_main records (customers with
4721 no active packages, but recurring packages not yet setup or one time charges
4727 FS::cust_main->none_active_sql.
4728 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4733 Returns an SQL expression identifying active cust_main records (customers with
4734 active recurring packages).
4739 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4742 =item none_active_sql
4744 Returns an SQL expression identifying cust_main records with no active
4745 recurring packages. This includes customers of status prospect, ordered,
4746 inactive, and suspended.
4750 sub none_active_sql {
4751 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4756 Returns an SQL expression identifying inactive cust_main records (customers with
4757 no active recurring packages, but otherwise unsuspended/uncancelled).
4762 FS::cust_main->none_active_sql.
4763 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4769 Returns an SQL expression identifying suspended cust_main records.
4774 sub suspended_sql { susp_sql(@_); }
4776 FS::cust_main->none_active_sql.
4777 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4783 Returns an SQL expression identifying cancelled cust_main records.
4787 sub cancel_sql { shift->cancelled_sql(@_); }
4790 =item uncancelled_sql
4792 Returns an SQL expression identifying un-cancelled cust_main records.
4796 sub uncancelled_sql { uncancel_sql(@_); }
4797 sub uncancel_sql { "
4798 ( 0 < ( $select_count_pkgs
4799 AND ( cust_pkg.cancel IS NULL
4800 OR cust_pkg.cancel = 0
4803 OR 0 = ( $select_count_pkgs )
4809 Returns an SQL fragment to retreive the balance.
4814 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4815 WHERE cust_bill.custnum = cust_main.custnum )
4816 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4817 WHERE cust_pay.custnum = cust_main.custnum )
4818 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4819 WHERE cust_credit.custnum = cust_main.custnum )
4820 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4821 WHERE cust_refund.custnum = cust_main.custnum )
4824 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4826 Returns an SQL fragment to retreive the balance for this customer, optionally
4827 considering invoices with date earlier than START_TIME, and not
4828 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4829 total_unapplied_payments).
4831 Times are specified as SQL fragments or numeric
4832 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4833 L<Date::Parse> for conversion functions. The empty string can be passed
4834 to disable that time constraint completely.
4836 Available options are:
4840 =item unapplied_date
4842 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)
4847 set to true to remove all customer comparison clauses, for totals
4852 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4857 JOIN clause (typically used with the total option)
4861 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4862 time will be ignored. Note that START_TIME and END_TIME only limit the date
4863 range for invoices and I<unapplied> payments, credits, and refunds.
4869 sub balance_date_sql {
4870 my( $class, $start, $end, %opt ) = @_;
4872 my $cutoff = $opt{'cutoff'};
4874 my $owed = FS::cust_bill->owed_sql($cutoff);
4875 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4876 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4877 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4879 my $j = $opt{'join'} || '';
4881 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4882 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4883 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4884 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4886 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4887 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4888 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4889 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4894 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4896 Returns an SQL fragment to retreive the total unapplied payments for this
4897 customer, only considering payments with date earlier than START_TIME, and
4898 optionally not later than END_TIME.
4900 Times are specified as SQL fragments or numeric
4901 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4902 L<Date::Parse> for conversion functions. The empty string can be passed
4903 to disable that time constraint completely.
4905 Available options are:
4909 sub unapplied_payments_date_sql {
4910 my( $class, $start, $end, %opt ) = @_;
4912 my $cutoff = $opt{'cutoff'};
4914 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4916 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4917 'unapplied_date'=>1 );
4919 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4922 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4924 Helper method for balance_date_sql; name (and usage) subject to change
4925 (suggestions welcome).
4927 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4928 cust_refund, cust_credit or cust_pay).
4930 If TABLE is "cust_bill" or the unapplied_date option is true, only
4931 considers records with date earlier than START_TIME, and optionally not
4932 later than END_TIME .
4936 sub _money_table_where {
4937 my( $class, $table, $start, $end, %opt ) = @_;
4940 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4941 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4942 push @where, "$table._date <= $start" if defined($start) && length($start);
4943 push @where, "$table._date > $end" if defined($end) && length($end);
4945 push @where, @{$opt{'where'}} if $opt{'where'};
4946 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4952 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4953 use FS::cust_main::Search;
4956 FS::cust_main::Search->search(@_);
4971 #warn join('-',keys %$param);
4972 my $fh = $param->{filehandle};
4973 my $agentnum = $param->{agentnum};
4974 my $format = $param->{format};
4976 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4979 if ( $format eq 'simple' ) {
4980 @fields = qw( custnum agent_custid amount pkg );
4982 die "unknown format $format";
4985 eval "use Text::CSV_XS;";
4988 my $csv = new Text::CSV_XS;
4995 local $SIG{HUP} = 'IGNORE';
4996 local $SIG{INT} = 'IGNORE';
4997 local $SIG{QUIT} = 'IGNORE';
4998 local $SIG{TERM} = 'IGNORE';
4999 local $SIG{TSTP} = 'IGNORE';
5000 local $SIG{PIPE} = 'IGNORE';
5002 my $oldAutoCommit = $FS::UID::AutoCommit;
5003 local $FS::UID::AutoCommit = 0;
5006 #while ( $columns = $csv->getline($fh) ) {
5008 while ( defined($line=<$fh>) ) {
5010 $csv->parse($line) or do {
5011 $dbh->rollback if $oldAutoCommit;
5012 return "can't parse: ". $csv->error_input();
5015 my @columns = $csv->fields();
5016 #warn join('-',@columns);
5019 foreach my $field ( @fields ) {
5020 $row{$field} = shift @columns;
5023 if ( $row{custnum} && $row{agent_custid} ) {
5024 dbh->rollback if $oldAutoCommit;
5025 return "can't specify custnum with agent_custid $row{agent_custid}";
5029 if ( $row{agent_custid} && $agentnum ) {
5030 %hash = ( 'agent_custid' => $row{agent_custid},
5031 'agentnum' => $agentnum,
5035 if ( $row{custnum} ) {
5036 %hash = ( 'custnum' => $row{custnum} );
5039 unless ( scalar(keys %hash) ) {
5040 $dbh->rollback if $oldAutoCommit;
5041 return "can't find customer without custnum or agent_custid and agentnum";
5044 my $cust_main = qsearchs('cust_main', { %hash } );
5045 unless ( $cust_main ) {
5046 $dbh->rollback if $oldAutoCommit;
5047 my $custnum = $row{custnum} || $row{agent_custid};
5048 return "unknown custnum $custnum";
5051 if ( $row{'amount'} > 0 ) {
5052 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5054 $dbh->rollback if $oldAutoCommit;
5058 } elsif ( $row{'amount'} < 0 ) {
5059 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5062 $dbh->rollback if $oldAutoCommit;
5072 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5074 return "Empty file!" unless $imported;
5080 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5082 Deprecated. Use event notification and message templates
5083 (L<FS::msg_template>) instead.
5085 Sends a templated email notification to the customer (see L<Text::Template>).
5087 OPTIONS is a hash and may include
5089 I<from> - the email sender (default is invoice_from)
5091 I<to> - comma-separated scalar or arrayref of recipients
5092 (default is invoicing_list)
5094 I<subject> - The subject line of the sent email notification
5095 (default is "Notice from company_name")
5097 I<extra_fields> - a hashref of name/value pairs which will be substituted
5100 The following variables are vavailable in the template.
5102 I<$first> - the customer first name
5103 I<$last> - the customer last name
5104 I<$company> - the customer company
5105 I<$payby> - a description of the method of payment for the customer
5106 # would be nice to use FS::payby::shortname
5107 I<$payinfo> - the account information used to collect for this customer
5108 I<$expdate> - the expiration of the customer payment in seconds from epoch
5113 my ($self, $template, %options) = @_;
5115 return unless $conf->exists($template);
5117 my $from = $conf->invoice_from_full($self->agentnum)
5118 if $conf->exists('invoice_from', $self->agentnum);
5119 $from = $options{from} if exists($options{from});
5121 my $to = join(',', $self->invoicing_list_emailonly);
5122 $to = $options{to} if exists($options{to});
5124 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5125 if $conf->exists('company_name', $self->agentnum);
5126 $subject = $options{subject} if exists($options{subject});
5128 my $notify_template = new Text::Template (TYPE => 'ARRAY',
5129 SOURCE => [ map "$_\n",
5130 $conf->config($template)]
5132 or die "can't create new Text::Template object: Text::Template::ERROR";
5133 $notify_template->compile()
5134 or die "can't compile template: Text::Template::ERROR";
5136 $FS::notify_template::_template::company_name =
5137 $conf->config('company_name', $self->agentnum);
5138 $FS::notify_template::_template::company_address =
5139 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5141 my $paydate = $self->paydate || '2037-12-31';
5142 $FS::notify_template::_template::first = $self->first;
5143 $FS::notify_template::_template::last = $self->last;
5144 $FS::notify_template::_template::company = $self->company;
5145 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5146 my $payby = $self->payby;
5147 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5148 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5150 #credit cards expire at the end of the month/year of their exp date
5151 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5152 $FS::notify_template::_template::payby = 'credit card';
5153 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5154 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5156 }elsif ($payby eq 'COMP') {
5157 $FS::notify_template::_template::payby = 'complimentary account';
5159 $FS::notify_template::_template::payby = 'current method';
5161 $FS::notify_template::_template::expdate = $expire_time;
5163 for (keys %{$options{extra_fields}}){
5165 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5168 send_email(from => $from,
5170 subject => $subject,
5171 body => $notify_template->fill_in( PACKAGE =>
5172 'FS::notify_template::_template' ),
5177 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5179 Generates a templated notification to the customer (see L<Text::Template>).
5181 OPTIONS is a hash and may include
5183 I<extra_fields> - a hashref of name/value pairs which will be substituted
5184 into the template. These values may override values mentioned below
5185 and those from the customer record.
5187 I<template_text> - if present, ignores TEMPLATE_NAME and uses the provided text
5189 The following variables are available in the template instead of or in addition
5190 to the fields of the customer record.
5192 I<$payby> - a description of the method of payment for the customer
5193 # would be nice to use FS::payby::shortname
5194 I<$payinfo> - the masked account information used to collect for this customer
5195 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5196 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5200 # a lot like cust_bill::print_latex
5201 sub generate_letter {
5202 my ($self, $template, %options) = @_;
5204 warn "Template $template does not exist" && return
5205 unless $conf->exists($template) || $options{'template_text'};
5207 my $template_source = $options{'template_text'}
5208 ? [ $options{'template_text'} ]
5209 : [ map "$_\n", $conf->config($template) ];
5211 my $letter_template = new Text::Template
5213 SOURCE => $template_source,
5214 DELIMITERS => [ '[@--', '--@]' ],
5216 or die "can't create new Text::Template object: Text::Template::ERROR";
5218 $letter_template->compile()
5219 or die "can't compile template: Text::Template::ERROR";
5221 my %letter_data = map { $_ => $self->$_ } $self->fields;
5222 $letter_data{payinfo} = $self->mask_payinfo;
5224 #my $paydate = $self->paydate || '2037-12-31';
5225 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5227 my $payby = $self->payby;
5228 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5229 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5231 #credit cards expire at the end of the month/year of their exp date
5232 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5233 $letter_data{payby} = 'credit card';
5234 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5235 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5237 }elsif ($payby eq 'COMP') {
5238 $letter_data{payby} = 'complimentary account';
5240 $letter_data{payby} = 'current method';
5242 $letter_data{expdate} = $expire_time;
5244 for (keys %{$options{extra_fields}}){
5245 $letter_data{$_} = $options{extra_fields}->{$_};
5248 unless(exists($letter_data{returnaddress})){
5249 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5250 $self->agent_template)
5252 if ( length($retadd) ) {
5253 $letter_data{returnaddress} = $retadd;
5254 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5255 $letter_data{returnaddress} =
5256 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5260 ( $conf->config('company_name', $self->agentnum),
5261 $conf->config('company_address', $self->agentnum),
5265 $letter_data{returnaddress} = '~';
5269 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5271 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5273 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5275 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5279 ) or die "can't open temp file: $!\n";
5280 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5281 or die "can't write temp file: $!\n";
5283 $letter_data{'logo_file'} = $lh->filename;
5285 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5289 ) or die "can't open temp file: $!\n";
5291 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5293 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5294 return ($1, $letter_data{'logo_file'});
5298 =item print_ps TEMPLATE
5300 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5306 my($file, $lfile) = $self->generate_letter(@_);
5307 my $ps = FS::Misc::generate_ps($file);
5308 unlink($file.'.tex');
5314 =item print TEMPLATE
5316 Prints the filled in template.
5318 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5322 sub queueable_print {
5325 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5326 or die "invalid customer number: " . $opt{custnum};
5328 my $error = $self->print( { 'template' => $opt{template} } );
5329 die $error if $error;
5333 my ($self, $template) = (shift, shift);
5335 [ $self->print_ps($template) ],
5336 'agentnum' => $self->agentnum,
5340 #these three subs should just go away once agent stuff is all config overrides
5342 sub agent_template {
5344 $self->_agent_plandata('agent_templatename');
5347 sub agent_invoice_from {
5349 $self->_agent_plandata('agent_invoice_from');
5352 sub _agent_plandata {
5353 my( $self, $option ) = @_;
5355 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5356 #agent-specific Conf
5358 use FS::part_event::Condition;
5360 my $agentnum = $self->agentnum;
5362 my $regexp = regexp_sql();
5364 my $part_event_option =
5366 'select' => 'part_event_option.*',
5367 'table' => 'part_event_option',
5369 LEFT JOIN part_event USING ( eventpart )
5370 LEFT JOIN part_event_option AS peo_agentnum
5371 ON ( part_event.eventpart = peo_agentnum.eventpart
5372 AND peo_agentnum.optionname = 'agentnum'
5373 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5375 LEFT JOIN part_event_condition
5376 ON ( part_event.eventpart = part_event_condition.eventpart
5377 AND part_event_condition.conditionname = 'cust_bill_age'
5379 LEFT JOIN part_event_condition_option
5380 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5381 AND part_event_condition_option.optionname = 'age'
5384 #'hashref' => { 'optionname' => $option },
5385 #'hashref' => { 'part_event_option.optionname' => $option },
5387 " WHERE part_event_option.optionname = ". dbh->quote($option).
5388 " AND action = 'cust_bill_send_agent' ".
5389 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5390 " AND peo_agentnum.optionname = 'agentnum' ".
5391 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5393 CASE WHEN part_event_condition_option.optionname IS NULL
5395 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5397 , part_event.weight".
5401 unless ( $part_event_option ) {
5402 return $self->agent->invoice_template || ''
5403 if $option eq 'agent_templatename';
5407 $part_event_option->optionvalue;
5411 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5413 Subroutine (not a method), designed to be called from the queue.
5415 Takes a list of options and values.
5417 Pulls up the customer record via the custnum option and calls bill_and_collect.
5422 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5424 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5425 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5427 #without this errors don't get rolled back
5428 $args{'fatal'} = 1; # runs from job queue, will be caught
5430 $cust_main->bill_and_collect( %args );
5433 sub process_bill_and_collect {
5435 my $param = thaw(decode_base64(shift));
5436 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5437 or die "custnum '$param->{custnum}' not found!\n";
5438 $param->{'job'} = $job;
5439 $param->{'fatal'} = 1; # runs from job queue, will be caught
5440 $param->{'retry'} = 1;
5442 $cust_main->bill_and_collect( %$param );
5445 #starting to take quite a while for big dbs
5446 # (JRNL: journaled so it only happens once per database)
5447 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5448 # JRNL seq scan of cust_main on signupdate... index signupdate? will that help?
5449 # JRNL seq scan of cust_main on paydate... index on substrings? maybe set an
5450 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5451 # JRNL leading/trailing spaces in first, last, company
5452 # - otaker upgrade? journal and call it good? (double check to make sure
5453 # we're not still setting otaker here)
5455 #only going to get worse with new location stuff...
5457 sub _upgrade_data { #class method
5458 my ($class, %opts) = @_;
5461 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5464 #this seems to be the only expensive one.. why does it take so long?
5465 unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5467 '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';
5468 FS::upgrade_journal->set_done('cust_main__signupdate');
5471 unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5473 # fix yyyy-m-dd formatted paydates
5474 if ( driver_name =~ /^mysql/i ) {
5476 "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5477 } else { # the SQL standard
5479 "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5481 FS::upgrade_journal->set_done('cust_main__paydate');
5484 unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5486 push @statements, #fix the weird BILL with a cc# in payinfo problem
5488 "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5490 FS::upgrade_journal->set_done('cust_main__payinfo');
5495 foreach my $sql ( @statements ) {
5496 my $sth = dbh->prepare($sql) or die dbh->errstr;
5497 $sth->execute or die $sth->errstr;
5498 #warn ( (time - $t). " seconds\n" );
5502 local($ignore_expired_card) = 1;
5503 local($ignore_banned_card) = 1;
5504 local($skip_fuzzyfiles) = 1;
5505 local($import) = 1; #prevent automatic geocoding (need its own variable?)
5507 FS::cust_main::Location->_upgrade_data(%opts);
5509 unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5511 foreach my $cust_main ( qsearch({
5512 'table' => 'cust_main',
5514 'extra_sql' => 'WHERE '.
5516 map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '% %'",
5517 qw( first last company )
5520 my $error = $cust_main->replace;
5521 die $error if $error;
5524 FS::upgrade_journal->set_done('cust_main__trimspaces');
5528 $class->_upgrade_otaker(%opts);
5538 The delete method should possibly take an FS::cust_main object reference
5539 instead of a scalar customer number.
5541 Bill and collect options should probably be passed as references instead of a
5544 There should probably be a configuration file with a list of allowed credit
5547 No multiple currency support (probably a larger project than just this module).
5549 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5551 Birthdates rely on negative epoch values.
5553 The payby for card/check batches is broken. With mixed batching, bad
5556 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5560 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5561 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5562 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.