5 use base qw( FS::cust_main::Billing FS::cust_main::Billing_Realtime
6 FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
9 use vars qw( $DEBUG $me $conf
11 $import $ignore_expired_card
12 $skip_fuzzyfiles @fuzzyfields
15 use vars qw( $realtime_bop_decline_quiet ); #ugh
17 use Scalar::Util qw( blessed );
18 use List::Util qw( min );
19 use Time::Local qw(timelocal);
20 use Storable qw(thaw);
24 use Digest::MD5 qw(md5_base64);
27 use File::Temp qw( tempfile );
28 use Business::CreditCard 0.28;
30 use FS::UID qw( getotaker dbh driver_name );
31 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
32 use FS::Misc qw( generate_email send_email generate_ps do_print );
33 use FS::Msgcat qw(gettext);
40 use FS::cust_pay_pending;
41 use FS::cust_pay_void;
42 use FS::cust_pay_batch;
45 use FS::part_referral;
46 use FS::cust_main_county;
47 use FS::cust_location;
49 use FS::cust_main_exemption;
50 use FS::cust_tax_adjustment;
51 use FS::cust_tax_location;
53 use FS::cust_main_invoice;
55 use FS::prepay_credit;
59 use FS::part_event_condition;
63 use FS::payment_gateway;
64 use FS::agent_payment_gateway;
68 $realtime_bop_decline_quiet = 0; #move to Billing_Realtime
70 # 1 is mostly method/subroutine entry and options
71 # 2 traces progress of some operations
72 # 3 is even more information including possibly sensitive data
74 $me = '[FS::cust_main]';
77 $ignore_expired_card = 0;
80 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
82 @encrypted_fields = ('payinfo', 'paycvv');
83 sub nohistory_fields { ('payinfo', 'paycvv'); }
85 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
87 #ask FS::UID to run this stuff for us later
88 #$FS::UID::callback{'FS::cust_main'} = sub {
89 install_callback FS::UID sub {
91 #yes, need it for stuff below (prolly should be cached)
96 my ( $hashref, $cache ) = @_;
97 if ( exists $hashref->{'pkgnum'} ) {
98 #@{ $self->{'_pkgnum'} } = ();
99 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
100 $self->{'_pkgnum'} = $subcache;
101 #push @{ $self->{'_pkgnum'} },
102 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
108 FS::cust_main - Object methods for cust_main records
114 $record = new FS::cust_main \%hash;
115 $record = new FS::cust_main { 'column' => 'value' };
117 $error = $record->insert;
119 $error = $new_record->replace($old_record);
121 $error = $record->delete;
123 $error = $record->check;
125 @cust_pkg = $record->all_pkgs;
127 @cust_pkg = $record->ncancelled_pkgs;
129 @cust_pkg = $record->suspended_pkgs;
131 $error = $record->bill;
132 $error = $record->bill %options;
133 $error = $record->bill 'time' => $time;
135 $error = $record->collect;
136 $error = $record->collect %options;
137 $error = $record->collect 'invoice_time' => $time,
142 An FS::cust_main object represents a customer. FS::cust_main inherits from
143 FS::Record. The following fields are currently supported:
149 Primary key (assigned automatically for new customers)
153 Agent (see L<FS::agent>)
157 Advertising source (see L<FS::part_referral>)
169 Cocial security number (optional)
185 (optional, see L<FS::cust_main_county>)
189 (see L<FS::cust_main_county>)
195 (see L<FS::cust_main_county>)
231 (optional, see L<FS::cust_main_county>)
235 (see L<FS::cust_main_county>)
241 (see L<FS::cust_main_county>)
257 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
261 Payment Information (See L<FS::payinfo_Mixin> for data format)
265 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
269 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
273 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
277 Start date month (maestro/solo cards only)
281 Start date year (maestro/solo cards only)
285 Issue number (maestro/solo cards only)
289 Name on card or billing name
293 IP address from which payment information was received
297 Tax exempt, empty or `Y'
301 Order taker (see L<FS::access_user>)
307 =item referral_custnum
309 Referring customer number
313 Enable individual CDR spooling, empty or `Y'
317 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
321 Discourage individual CDR printing, empty or `Y'
331 Creates a new customer. To add the customer to the database, see L<"insert">.
333 Note that this stores the hash reference, not a distinct copy of the hash it
334 points to. You can ask the object for a copy with the I<hash> method.
338 sub table { 'cust_main'; }
340 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
342 Adds this customer to the database. If there is an error, returns the error,
343 otherwise returns false.
345 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
346 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
347 are inserted atomicly, or the transaction is rolled back. Passing an empty
348 hash reference is equivalent to not supplying this parameter. There should be
349 a better explanation of this, but until then, here's an example:
352 tie %hash, 'Tie::RefHash'; #this part is important
354 $cust_pkg => [ $svc_acct ],
357 $cust_main->insert( \%hash );
359 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
360 be set as the invoicing list (see L<"invoicing_list">). Errors return as
361 expected and rollback the entire transaction; it is not necessary to call
362 check_invoicing_list first. The invoicing_list is set after the records in the
363 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
364 invoicing_list destination to the newly-created svc_acct. Here's an example:
366 $cust_main->insert( {}, [ $email, 'POST' ] );
368 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
370 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
371 on the supplied jobnum (they will not run until the specific job completes).
372 This can be used to defer provisioning until some action completes (such
373 as running the customer's credit card successfully).
375 The I<noexport> option is deprecated. If I<noexport> is set true, no
376 provisioning jobs (exports) are scheduled. (You can schedule them later with
377 the B<reexport> method.)
379 The I<tax_exemption> option can be set to an arrayref of tax names.
380 FS::cust_main_exemption records will be created and inserted.
386 my $cust_pkgs = @_ ? shift : {};
387 my $invoicing_list = @_ ? shift : '';
389 warn "$me insert called with options ".
390 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
393 local $SIG{HUP} = 'IGNORE';
394 local $SIG{INT} = 'IGNORE';
395 local $SIG{QUIT} = 'IGNORE';
396 local $SIG{TERM} = 'IGNORE';
397 local $SIG{TSTP} = 'IGNORE';
398 local $SIG{PIPE} = 'IGNORE';
400 my $oldAutoCommit = $FS::UID::AutoCommit;
401 local $FS::UID::AutoCommit = 0;
404 my $prepay_identifier = '';
405 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
407 if ( $self->payby eq 'PREPAY' ) {
409 $self->payby('BILL');
410 $prepay_identifier = $self->payinfo;
413 warn " looking up prepaid card $prepay_identifier\n"
416 my $error = $self->get_prepay( $prepay_identifier,
417 'amount_ref' => \$amount,
418 'seconds_ref' => \$seconds,
419 'upbytes_ref' => \$upbytes,
420 'downbytes_ref' => \$downbytes,
421 'totalbytes_ref' => \$totalbytes,
424 $dbh->rollback if $oldAutoCommit;
425 #return "error applying prepaid card (transaction rolled back): $error";
429 $payby = 'PREP' if $amount;
431 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
434 $self->payby('BILL');
435 $amount = $self->paid;
439 warn " inserting $self\n"
442 $self->signupdate(time) unless $self->signupdate;
444 $self->auto_agent_custid()
445 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
447 my $error = $self->SUPER::insert;
449 $dbh->rollback if $oldAutoCommit;
450 #return "inserting cust_main record (transaction rolled back): $error";
454 warn " setting invoicing list\n"
457 if ( $invoicing_list ) {
458 $error = $self->check_invoicing_list( $invoicing_list );
460 $dbh->rollback if $oldAutoCommit;
461 #return "checking invoicing_list (transaction rolled back): $error";
464 $self->invoicing_list( $invoicing_list );
467 warn " setting customer tags\n"
470 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
471 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
472 'custnum' => $self->custnum };
473 my $error = $cust_tag->insert;
475 $dbh->rollback if $oldAutoCommit;
480 if ( $invoicing_list ) {
481 $error = $self->check_invoicing_list( $invoicing_list );
483 $dbh->rollback if $oldAutoCommit;
484 #return "checking invoicing_list (transaction rolled back): $error";
487 $self->invoicing_list( $invoicing_list );
491 warn " setting cust_main_exemption\n"
494 my $tax_exemption = delete $options{'tax_exemption'};
495 if ( $tax_exemption ) {
496 foreach my $taxname ( @$tax_exemption ) {
497 my $cust_main_exemption = new FS::cust_main_exemption {
498 'custnum' => $self->custnum,
499 'taxname' => $taxname,
501 my $error = $cust_main_exemption->insert;
503 $dbh->rollback if $oldAutoCommit;
504 return "inserting cust_main_exemption (transaction rolled back): $error";
509 if ( $conf->config('cust_main-skeleton_tables')
510 && $conf->config('cust_main-skeleton_custnum') ) {
512 warn " inserting skeleton records\n"
515 my $error = $self->start_copy_skel;
517 $dbh->rollback if $oldAutoCommit;
523 warn " ordering packages\n"
526 $error = $self->order_pkgs( $cust_pkgs,
528 'seconds_ref' => \$seconds,
529 'upbytes_ref' => \$upbytes,
530 'downbytes_ref' => \$downbytes,
531 'totalbytes_ref' => \$totalbytes,
534 $dbh->rollback if $oldAutoCommit;
539 $dbh->rollback if $oldAutoCommit;
540 return "No svc_acct record to apply pre-paid time";
542 if ( $upbytes || $downbytes || $totalbytes ) {
543 $dbh->rollback if $oldAutoCommit;
544 return "No svc_acct record to apply pre-paid data";
548 warn " inserting initial $payby payment of $amount\n"
550 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
552 $dbh->rollback if $oldAutoCommit;
553 return "inserting payment (transaction rolled back): $error";
557 unless ( $import || $skip_fuzzyfiles ) {
558 warn " queueing fuzzyfiles update\n"
560 $error = $self->queue_fuzzyfiles_update;
562 $dbh->rollback if $oldAutoCommit;
563 return "updating fuzzy search cache: $error";
568 warn " exporting\n" if $DEBUG > 1;
570 my $export_args = $options{'export_args'} || [];
573 map qsearch( 'part_export', {exportnum=>$_} ),
574 $conf->config('cust_main-exports'); #, $agentnum
576 foreach my $part_export ( @part_export ) {
577 my $error = $part_export->export_insert($self, @$export_args);
579 $dbh->rollback if $oldAutoCommit;
580 return "exporting to ". $part_export->exporttype.
581 " (transaction rolled back): $error";
585 #foreach my $depend_jobnum ( @$depend_jobnums ) {
586 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
588 # foreach my $jobnum ( @jobnums ) {
589 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
590 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
592 # my $error = $queue->depend_insert($depend_jobnum);
594 # $dbh->rollback if $oldAutoCommit;
595 # return "error queuing job dependancy: $error";
602 #if ( exists $options{'jobnums'} ) {
603 # push @{ $options{'jobnums'} }, @jobnums;
606 warn " insert complete; committing transaction\n"
609 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
614 use File::CounterFile;
615 sub auto_agent_custid {
618 my $format = $conf->config('cust_main-auto_agent_custid');
620 if ( $format eq '1YMMXXXXXXXX' ) {
622 my $counter = new File::CounterFile 'cust_main.agent_custid';
625 my $ym = 100000000000 + time2str('%y%m00000000', time);
626 if ( $ym > $counter->value ) {
627 $counter->{'value'} = $agent_custid = $ym;
628 $counter->{'updated'} = 1;
630 $agent_custid = $counter->inc;
636 die "Unknown cust_main-auto_agent_custid format: $format";
639 $self->agent_custid($agent_custid);
643 sub start_copy_skel {
646 #'mg_user_preference' => {},
647 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
648 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
649 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
650 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
651 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
654 _copy_skel( 'cust_main', #tablename
655 $conf->config('cust_main-skeleton_custnum'), #sourceid
656 $self->custnum, #destid
657 @tables, #child tables
661 #recursive subroutine, not a method
663 my( $table, $sourceid, $destid, %child_tables ) = @_;
666 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
667 ( $table, $primary_key ) = ( $1, $2 );
669 my $dbdef_table = dbdef->table($table);
670 $primary_key = $dbdef_table->primary_key
671 or return "$table has no primary key".
672 " (or do you need to run dbdef-create?)";
675 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
676 join (', ', keys %child_tables). "\n"
679 foreach my $child_table_def ( keys %child_tables ) {
683 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
684 ( $child_table, $child_pkey ) = ( $1, $2 );
686 $child_table = $child_table_def;
688 $child_pkey = dbdef->table($child_table)->primary_key;
689 # or return "$table has no primary key".
690 # " (or do you need to run dbdef-create?)\n";
694 if ( keys %{ $child_tables{$child_table_def} } ) {
696 return "$child_table has no primary key".
697 " (run dbdef-create or try specifying it?)\n"
700 #false laziness w/Record::insert and only works on Pg
701 #refactor the proper last-inserted-id stuff out of Record::insert if this
702 # ever gets use for anything besides a quick kludge for one customer
703 my $default = dbdef->table($child_table)->column($child_pkey)->default;
704 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
705 or return "can't parse $child_table.$child_pkey default value ".
706 " for sequence name: $default";
711 my @sel_columns = grep { $_ ne $primary_key }
712 dbdef->table($child_table)->columns;
713 my $sel_columns = join(', ', @sel_columns );
715 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
716 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
717 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
719 my $sel_st = "SELECT $sel_columns FROM $child_table".
720 " WHERE $primary_key = $sourceid";
723 my $sel_sth = dbh->prepare( $sel_st )
724 or return dbh->errstr;
726 $sel_sth->execute or return $sel_sth->errstr;
728 while ( my $row = $sel_sth->fetchrow_hashref ) {
730 warn " selected row: ".
731 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
735 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
736 my $ins_sth =dbh->prepare($statement)
737 or return dbh->errstr;
738 my @param = ( $destid, map $row->{$_}, @ins_columns );
739 warn " $statement: [ ". join(', ', @param). " ]\n"
741 $ins_sth->execute( @param )
742 or return $ins_sth->errstr;
744 #next unless keys %{ $child_tables{$child_table} };
745 next unless $sequence;
747 #another section of that laziness
748 my $seq_sql = "SELECT currval('$sequence')";
749 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
750 $seq_sth->execute or return $seq_sth->errstr;
751 my $insertid = $seq_sth->fetchrow_arrayref->[0];
753 # don't drink soap! recurse! recurse! okay!
755 _copy_skel( $child_table_def,
756 $row->{$child_pkey}, #sourceid
758 %{ $child_tables{$child_table_def} },
760 return $error if $error;
770 =item order_pkg HASHREF | OPTION => VALUE ...
772 Orders a single package.
774 Options may be passed as a list of key/value pairs or as a hash reference.
785 Optional FS::cust_location object
789 Optional arryaref of FS::svc_* service objects.
793 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
794 jobs will have a dependancy on the supplied job (they will not run until the
795 specific job completes). This can be used to defer provisioning until some
796 action completes (such as running the customer's credit card successfully).
800 Optional subject for a ticket created and attached to this customer
804 Optional queue name for ticket additions
812 my $opt = ref($_[0]) ? shift : { @_ };
814 warn "$me order_pkg called with options ".
815 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
818 my $cust_pkg = $opt->{'cust_pkg'};
819 my $svcs = $opt->{'svcs'} || [];
821 my %svc_options = ();
822 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
823 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
825 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
826 qw( ticket_subject ticket_queue );
828 local $SIG{HUP} = 'IGNORE';
829 local $SIG{INT} = 'IGNORE';
830 local $SIG{QUIT} = 'IGNORE';
831 local $SIG{TERM} = 'IGNORE';
832 local $SIG{TSTP} = 'IGNORE';
833 local $SIG{PIPE} = 'IGNORE';
835 my $oldAutoCommit = $FS::UID::AutoCommit;
836 local $FS::UID::AutoCommit = 0;
839 if ( $opt->{'cust_location'} &&
840 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
841 my $error = $opt->{'cust_location'}->insert;
843 $dbh->rollback if $oldAutoCommit;
844 return "inserting cust_location (transaction rolled back): $error";
846 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
849 $cust_pkg->custnum( $self->custnum );
851 my $error = $cust_pkg->insert( %insert_params );
853 $dbh->rollback if $oldAutoCommit;
854 return "inserting cust_pkg (transaction rolled back): $error";
857 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
858 if ( $svc_something->svcnum ) {
859 my $old_cust_svc = $svc_something->cust_svc;
860 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
861 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
862 $error = $new_cust_svc->replace($old_cust_svc);
864 $svc_something->pkgnum( $cust_pkg->pkgnum );
865 if ( $svc_something->isa('FS::svc_acct') ) {
866 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
867 qw( seconds upbytes downbytes totalbytes ) ) {
868 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
869 ${ $opt->{$_.'_ref'} } = 0;
872 $error = $svc_something->insert(%svc_options);
875 $dbh->rollback if $oldAutoCommit;
876 return "inserting svc_ (transaction rolled back): $error";
880 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
885 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
886 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
888 Like the insert method on an existing record, this method orders multiple
889 packages and included services atomicaly. Pass a Tie::RefHash data structure
890 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
891 There should be a better explanation of this, but until then, here's an
895 tie %hash, 'Tie::RefHash'; #this part is important
897 $cust_pkg => [ $svc_acct ],
900 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
902 Services can be new, in which case they are inserted, or existing unaudited
903 services, in which case they are linked to the newly-created package.
905 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
906 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
908 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
909 on the supplied jobnum (they will not run until the specific job completes).
910 This can be used to defer provisioning until some action completes (such
911 as running the customer's credit card successfully).
913 The I<noexport> option is deprecated. If I<noexport> is set true, no
914 provisioning jobs (exports) are scheduled. (You can schedule them later with
915 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
916 on the cust_main object is not recommended, as existing services will also be
919 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
920 provided, the scalars (provided by references) will be incremented by the
921 values of the prepaid card.`
927 my $cust_pkgs = shift;
928 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
930 $seconds_ref ||= $options{'seconds_ref'};
932 warn "$me order_pkgs called with options ".
933 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
936 local $SIG{HUP} = 'IGNORE';
937 local $SIG{INT} = 'IGNORE';
938 local $SIG{QUIT} = 'IGNORE';
939 local $SIG{TERM} = 'IGNORE';
940 local $SIG{TSTP} = 'IGNORE';
941 local $SIG{PIPE} = 'IGNORE';
943 my $oldAutoCommit = $FS::UID::AutoCommit;
944 local $FS::UID::AutoCommit = 0;
947 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
949 foreach my $cust_pkg ( keys %$cust_pkgs ) {
951 my $error = $self->order_pkg(
952 'cust_pkg' => $cust_pkg,
953 'svcs' => $cust_pkgs->{$cust_pkg},
954 'seconds_ref' => $seconds_ref,
955 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
960 $dbh->rollback if $oldAutoCommit;
966 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
970 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
972 Recharges this (existing) customer with the specified prepaid card (see
973 L<FS::prepay_credit>), specified either by I<identifier> or as an
974 FS::prepay_credit object. If there is an error, returns the error, otherwise
977 Optionally, five scalar references can be passed as well. They will have their
978 values filled in with the amount, number of seconds, and number of upload,
979 download, and total bytes applied by this prepaid card.
983 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
984 #the only place that uses these args
985 sub recharge_prepay {
986 my( $self, $prepay_credit, $amountref, $secondsref,
987 $upbytesref, $downbytesref, $totalbytesref ) = @_;
989 local $SIG{HUP} = 'IGNORE';
990 local $SIG{INT} = 'IGNORE';
991 local $SIG{QUIT} = 'IGNORE';
992 local $SIG{TERM} = 'IGNORE';
993 local $SIG{TSTP} = 'IGNORE';
994 local $SIG{PIPE} = 'IGNORE';
996 my $oldAutoCommit = $FS::UID::AutoCommit;
997 local $FS::UID::AutoCommit = 0;
1000 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
1002 my $error = $self->get_prepay( $prepay_credit,
1003 'amount_ref' => \$amount,
1004 'seconds_ref' => \$seconds,
1005 'upbytes_ref' => \$upbytes,
1006 'downbytes_ref' => \$downbytes,
1007 'totalbytes_ref' => \$totalbytes,
1009 || $self->increment_seconds($seconds)
1010 || $self->increment_upbytes($upbytes)
1011 || $self->increment_downbytes($downbytes)
1012 || $self->increment_totalbytes($totalbytes)
1013 || $self->insert_cust_pay_prepay( $amount,
1015 ? $prepay_credit->identifier
1020 $dbh->rollback if $oldAutoCommit;
1024 if ( defined($amountref) ) { $$amountref = $amount; }
1025 if ( defined($secondsref) ) { $$secondsref = $seconds; }
1026 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
1027 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
1028 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
1030 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1035 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
1037 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
1038 specified either by I<identifier> or as an FS::prepay_credit object.
1040 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
1041 incremented by the values of the prepaid card.
1043 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
1044 check or set this customer's I<agentnum>.
1046 If there is an error, returns the error, otherwise returns false.
1052 my( $self, $prepay_credit, %opt ) = @_;
1054 local $SIG{HUP} = 'IGNORE';
1055 local $SIG{INT} = 'IGNORE';
1056 local $SIG{QUIT} = 'IGNORE';
1057 local $SIG{TERM} = 'IGNORE';
1058 local $SIG{TSTP} = 'IGNORE';
1059 local $SIG{PIPE} = 'IGNORE';
1061 my $oldAutoCommit = $FS::UID::AutoCommit;
1062 local $FS::UID::AutoCommit = 0;
1065 unless ( ref($prepay_credit) ) {
1067 my $identifier = $prepay_credit;
1069 $prepay_credit = qsearchs(
1071 { 'identifier' => $prepay_credit },
1076 unless ( $prepay_credit ) {
1077 $dbh->rollback if $oldAutoCommit;
1078 return "Invalid prepaid card: ". $identifier;
1083 if ( $prepay_credit->agentnum ) {
1084 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1085 $dbh->rollback if $oldAutoCommit;
1086 return "prepaid card not valid for agent ". $self->agentnum;
1088 $self->agentnum($prepay_credit->agentnum);
1091 my $error = $prepay_credit->delete;
1093 $dbh->rollback if $oldAutoCommit;
1094 return "removing prepay_credit (transaction rolled back): $error";
1097 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1098 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1100 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1105 =item increment_upbytes SECONDS
1107 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1108 the specified number of upbytes. If there is an error, returns the error,
1109 otherwise returns false.
1113 sub increment_upbytes {
1114 _increment_column( shift, 'upbytes', @_);
1117 =item increment_downbytes SECONDS
1119 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1120 the specified number of downbytes. If there is an error, returns the error,
1121 otherwise returns false.
1125 sub increment_downbytes {
1126 _increment_column( shift, 'downbytes', @_);
1129 =item increment_totalbytes SECONDS
1131 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1132 the specified number of totalbytes. If there is an error, returns the error,
1133 otherwise returns false.
1137 sub increment_totalbytes {
1138 _increment_column( shift, 'totalbytes', @_);
1141 =item increment_seconds SECONDS
1143 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1144 the specified number of seconds. If there is an error, returns the error,
1145 otherwise returns false.
1149 sub increment_seconds {
1150 _increment_column( shift, 'seconds', @_);
1153 =item _increment_column AMOUNT
1155 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1156 the specified number of seconds or bytes. If there is an error, returns
1157 the error, otherwise returns false.
1161 sub _increment_column {
1162 my( $self, $column, $amount ) = @_;
1163 warn "$me increment_column called: $column, $amount\n"
1166 return '' unless $amount;
1168 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1169 $self->ncancelled_pkgs;
1171 if ( ! @cust_pkg ) {
1172 return 'No packages with primary or single services found'.
1173 ' to apply pre-paid time';
1174 } elsif ( scalar(@cust_pkg) > 1 ) {
1175 #maybe have a way to specify the package/account?
1176 return 'Multiple packages found to apply pre-paid time';
1179 my $cust_pkg = $cust_pkg[0];
1180 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1184 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1186 if ( ! @cust_svc ) {
1187 return 'No account found to apply pre-paid time';
1188 } elsif ( scalar(@cust_svc) > 1 ) {
1189 return 'Multiple accounts found to apply pre-paid time';
1192 my $svc_acct = $cust_svc[0]->svc_x;
1193 warn " found service svcnum ". $svc_acct->pkgnum.
1194 ' ('. $svc_acct->email. ")\n"
1197 $column = "increment_$column";
1198 $svc_acct->$column($amount);
1202 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1204 Inserts a prepayment in the specified amount for this customer. An optional
1205 second argument can specify the prepayment identifier for tracking purposes.
1206 If there is an error, returns the error, otherwise returns false.
1210 sub insert_cust_pay_prepay {
1211 shift->insert_cust_pay('PREP', @_);
1214 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1216 Inserts a cash payment in the specified amount for this customer. An optional
1217 second argument can specify the payment identifier for tracking purposes.
1218 If there is an error, returns the error, otherwise returns false.
1222 sub insert_cust_pay_cash {
1223 shift->insert_cust_pay('CASH', @_);
1226 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1228 Inserts a Western Union payment in the specified amount for this customer. An
1229 optional second argument can specify the prepayment identifier for tracking
1230 purposes. If there is an error, returns the error, otherwise returns false.
1234 sub insert_cust_pay_west {
1235 shift->insert_cust_pay('WEST', @_);
1238 sub insert_cust_pay {
1239 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1240 my $payinfo = scalar(@_) ? shift : '';
1242 my $cust_pay = new FS::cust_pay {
1243 'custnum' => $self->custnum,
1244 'paid' => sprintf('%.2f', $amount),
1245 #'_date' => #date the prepaid card was purchased???
1247 'payinfo' => $payinfo,
1255 This method is deprecated. See the I<depend_jobnum> option to the insert and
1256 order_pkgs methods for a better way to defer provisioning.
1258 Re-schedules all exports by calling the B<reexport> method of all associated
1259 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1260 otherwise returns false.
1267 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1268 "use the depend_jobnum option to insert or order_pkgs to delay export";
1270 local $SIG{HUP} = 'IGNORE';
1271 local $SIG{INT} = 'IGNORE';
1272 local $SIG{QUIT} = 'IGNORE';
1273 local $SIG{TERM} = 'IGNORE';
1274 local $SIG{TSTP} = 'IGNORE';
1275 local $SIG{PIPE} = 'IGNORE';
1277 my $oldAutoCommit = $FS::UID::AutoCommit;
1278 local $FS::UID::AutoCommit = 0;
1281 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1282 my $error = $cust_pkg->reexport;
1284 $dbh->rollback if $oldAutoCommit;
1289 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1294 =item delete [ OPTION => VALUE ... ]
1296 This deletes the customer. If there is an error, returns the error, otherwise
1299 This will completely remove all traces of the customer record. This is not
1300 what you want when a customer cancels service; for that, cancel all of the
1301 customer's packages (see L</cancel>).
1303 If the customer has any uncancelled packages, you need to pass a new (valid)
1304 customer number for those packages to be transferred to, as the "new_customer"
1305 option. Cancelled packages will be deleted. Did I mention that this is NOT
1306 what you want when a customer cancels service and that you really should be
1307 looking at L<FS::cust_pkg/cancel>?
1309 You can't delete a customer with invoices (see L<FS::cust_bill>),
1310 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1311 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1312 set the "delete_financials" option to a true value.
1317 my( $self, %opt ) = @_;
1319 local $SIG{HUP} = 'IGNORE';
1320 local $SIG{INT} = 'IGNORE';
1321 local $SIG{QUIT} = 'IGNORE';
1322 local $SIG{TERM} = 'IGNORE';
1323 local $SIG{TSTP} = 'IGNORE';
1324 local $SIG{PIPE} = 'IGNORE';
1326 my $oldAutoCommit = $FS::UID::AutoCommit;
1327 local $FS::UID::AutoCommit = 0;
1330 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1331 $dbh->rollback if $oldAutoCommit;
1332 return "Can't delete a master agent customer";
1335 #use FS::access_user
1336 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1337 $dbh->rollback if $oldAutoCommit;
1338 return "Can't delete a master employee customer";
1341 tie my %financial_tables, 'Tie::IxHash',
1342 'cust_bill' => 'invoices',
1343 'cust_statement' => 'statements',
1344 'cust_credit' => 'credits',
1345 'cust_pay' => 'payments',
1346 'cust_refund' => 'refunds',
1349 foreach my $table ( keys %financial_tables ) {
1351 my @records = $self->$table();
1353 if ( @records && ! $opt{'delete_financials'} ) {
1354 $dbh->rollback if $oldAutoCommit;
1355 return "Can't delete a customer with ". $financial_tables{$table};
1358 foreach my $record ( @records ) {
1359 my $error = $record->delete;
1361 $dbh->rollback if $oldAutoCommit;
1362 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1368 my @cust_pkg = $self->ncancelled_pkgs;
1370 my $new_custnum = $opt{'new_custnum'};
1371 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1372 $dbh->rollback if $oldAutoCommit;
1373 return "Invalid new customer number: $new_custnum";
1375 foreach my $cust_pkg ( @cust_pkg ) {
1376 my %hash = $cust_pkg->hash;
1377 $hash{'custnum'} = $new_custnum;
1378 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1379 my $error = $new_cust_pkg->replace($cust_pkg,
1380 options => { $cust_pkg->options },
1383 $dbh->rollback if $oldAutoCommit;
1388 my @cancelled_cust_pkg = $self->all_pkgs;
1389 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1390 my $error = $cust_pkg->delete;
1392 $dbh->rollback if $oldAutoCommit;
1397 #cust_tax_adjustment in financials?
1398 #cust_pay_pending? ouch
1400 foreach my $table (qw(
1401 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1402 cust_location cust_main_note cust_tax_adjustment
1403 cust_pay_void cust_pay_batch queue cust_tax_exempt
1405 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1406 my $error = $record->delete;
1408 $dbh->rollback if $oldAutoCommit;
1414 my $sth = $dbh->prepare(
1415 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1417 my $errstr = $dbh->errstr;
1418 $dbh->rollback if $oldAutoCommit;
1421 $sth->execute($self->custnum) or do {
1422 my $errstr = $sth->errstr;
1423 $dbh->rollback if $oldAutoCommit;
1429 my $ticket_dbh = '';
1430 if ($conf->config('ticket_system') eq 'RT_Internal') {
1432 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1433 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1434 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1435 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1438 if ( $ticket_dbh ) {
1440 my $ticket_sth = $ticket_dbh->prepare(
1441 'DELETE FROM Links WHERE Target = ?'
1443 my $errstr = $ticket_dbh->errstr;
1444 $dbh->rollback if $oldAutoCommit;
1447 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1449 my $errstr = $ticket_sth->errstr;
1450 $dbh->rollback if $oldAutoCommit;
1454 #check and see if the customer is the only link on the ticket, and
1455 #if so, set the ticket to deleted status in RT?
1456 #maybe someday, for now this will at least fix tickets not displaying
1460 #delete the customer record
1462 my $error = $self->SUPER::delete;
1464 $dbh->rollback if $oldAutoCommit;
1468 # cust_main exports!
1470 #my $export_args = $options{'export_args'} || [];
1473 map qsearch( 'part_export', {exportnum=>$_} ),
1474 $conf->config('cust_main-exports'); #, $agentnum
1476 foreach my $part_export ( @part_export ) {
1477 my $error = $part_export->export_delete( $self ); #, @$export_args);
1479 $dbh->rollback if $oldAutoCommit;
1480 return "exporting to ". $part_export->exporttype.
1481 " (transaction rolled back): $error";
1485 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1490 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1493 Replaces the OLD_RECORD with this one in the database. If there is an error,
1494 returns the error, otherwise returns false.
1496 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1497 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1498 expected and rollback the entire transaction; it is not necessary to call
1499 check_invoicing_list first. Here's an example:
1501 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1503 Currently available options are: I<tax_exemption>.
1505 The I<tax_exemption> option can be set to an arrayref of tax names.
1506 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1513 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1515 : $self->replace_old;
1519 warn "$me replace called\n"
1522 my $curuser = $FS::CurrentUser::CurrentUser;
1523 if ( $self->payby eq 'COMP'
1524 && $self->payby ne $old->payby
1525 && ! $curuser->access_right('Complimentary customer')
1528 return "You are not permitted to create complimentary accounts.";
1531 local($ignore_expired_card) = 1
1532 if $old->payby =~ /^(CARD|DCRD)$/
1533 && $self->payby =~ /^(CARD|DCRD)$/
1534 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1536 local $SIG{HUP} = 'IGNORE';
1537 local $SIG{INT} = 'IGNORE';
1538 local $SIG{QUIT} = 'IGNORE';
1539 local $SIG{TERM} = 'IGNORE';
1540 local $SIG{TSTP} = 'IGNORE';
1541 local $SIG{PIPE} = 'IGNORE';
1543 my $oldAutoCommit = $FS::UID::AutoCommit;
1544 local $FS::UID::AutoCommit = 0;
1547 my $error = $self->SUPER::replace($old);
1550 $dbh->rollback if $oldAutoCommit;
1554 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1555 my $invoicing_list = shift @param;
1556 $error = $self->check_invoicing_list( $invoicing_list );
1558 $dbh->rollback if $oldAutoCommit;
1561 $self->invoicing_list( $invoicing_list );
1564 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1566 #this could be more efficient than deleting and re-inserting, if it matters
1567 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1568 my $error = $cust_tag->delete;
1570 $dbh->rollback if $oldAutoCommit;
1574 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1575 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1576 'custnum' => $self->custnum };
1577 my $error = $cust_tag->insert;
1579 $dbh->rollback if $oldAutoCommit;
1586 my %options = @param;
1588 my $tax_exemption = delete $options{'tax_exemption'};
1589 if ( $tax_exemption ) {
1591 my %cust_main_exemption =
1592 map { $_->taxname => $_ }
1593 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1595 foreach my $taxname ( @$tax_exemption ) {
1597 next if delete $cust_main_exemption{$taxname};
1599 my $cust_main_exemption = new FS::cust_main_exemption {
1600 'custnum' => $self->custnum,
1601 'taxname' => $taxname,
1603 my $error = $cust_main_exemption->insert;
1605 $dbh->rollback if $oldAutoCommit;
1606 return "inserting cust_main_exemption (transaction rolled back): $error";
1610 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1611 my $error = $cust_main_exemption->delete;
1613 $dbh->rollback if $oldAutoCommit;
1614 return "deleting cust_main_exemption (transaction rolled back): $error";
1620 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1621 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1622 && $self->get('payinfo') !~ /^99\d{14}$/
1624 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1629 # card/check/lec info has changed, want to retry realtime_ invoice events
1630 my $error = $self->retry_realtime;
1632 $dbh->rollback if $oldAutoCommit;
1637 unless ( $import || $skip_fuzzyfiles ) {
1638 $error = $self->queue_fuzzyfiles_update;
1640 $dbh->rollback if $oldAutoCommit;
1641 return "updating fuzzy search cache: $error";
1645 # cust_main exports!
1647 my $export_args = $options{'export_args'} || [];
1650 map qsearch( 'part_export', {exportnum=>$_} ),
1651 $conf->config('cust_main-exports'); #, $agentnum
1653 foreach my $part_export ( @part_export ) {
1654 my $error = $part_export->export_replace( $self, $old, @$export_args);
1656 $dbh->rollback if $oldAutoCommit;
1657 return "exporting to ". $part_export->exporttype.
1658 " (transaction rolled back): $error";
1662 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1667 =item queue_fuzzyfiles_update
1669 Used by insert & replace to update the fuzzy search cache
1673 sub queue_fuzzyfiles_update {
1676 local $SIG{HUP} = 'IGNORE';
1677 local $SIG{INT} = 'IGNORE';
1678 local $SIG{QUIT} = 'IGNORE';
1679 local $SIG{TERM} = 'IGNORE';
1680 local $SIG{TSTP} = 'IGNORE';
1681 local $SIG{PIPE} = 'IGNORE';
1683 my $oldAutoCommit = $FS::UID::AutoCommit;
1684 local $FS::UID::AutoCommit = 0;
1687 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1688 my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1690 $dbh->rollback if $oldAutoCommit;
1691 return "queueing job (transaction rolled back): $error";
1694 if ( $self->ship_last ) {
1695 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1696 $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1698 $dbh->rollback if $oldAutoCommit;
1699 return "queueing job (transaction rolled back): $error";
1703 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1710 Checks all fields to make sure this is a valid customer record. If there is
1711 an error, returns the error, otherwise returns false. Called by the insert
1712 and replace methods.
1719 warn "$me check BEFORE: \n". $self->_dump
1723 $self->ut_numbern('custnum')
1724 || $self->ut_number('agentnum')
1725 || $self->ut_textn('agent_custid')
1726 || $self->ut_number('refnum')
1727 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1728 || $self->ut_textn('custbatch')
1729 || $self->ut_name('last')
1730 || $self->ut_name('first')
1731 || $self->ut_snumbern('birthdate')
1732 || $self->ut_snumbern('signupdate')
1733 || $self->ut_textn('company')
1734 || $self->ut_text('address1')
1735 || $self->ut_textn('address2')
1736 || $self->ut_text('city')
1737 || $self->ut_textn('county')
1738 || $self->ut_textn('state')
1739 || $self->ut_country('country')
1740 || $self->ut_anything('comments')
1741 || $self->ut_numbern('referral_custnum')
1742 || $self->ut_textn('stateid')
1743 || $self->ut_textn('stateid_state')
1744 || $self->ut_textn('invoice_terms')
1745 || $self->ut_alphan('geocode')
1746 || $self->ut_floatn('cdr_termination_percentage')
1749 #barf. need message catalogs. i18n. etc.
1750 $error .= "Please select an advertising source."
1751 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1752 return $error if $error;
1754 return "Unknown agent"
1755 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1757 return "Unknown refnum"
1758 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1760 return "Unknown referring custnum: ". $self->referral_custnum
1761 unless ! $self->referral_custnum
1762 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1764 if ( $self->censustract ne '' ) {
1765 $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1766 or return "Illegal census tract: ". $self->censustract;
1768 $self->censustract("$1.$2");
1771 if ( $self->ss eq '' ) {
1776 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1777 or return "Illegal social security number: ". $self->ss;
1778 $self->ss("$1-$2-$3");
1782 # bad idea to disable, causes billing to fail because of no tax rates later
1783 # except we don't fail any more
1784 unless ( $import ) {
1785 unless ( qsearch('cust_main_county', {
1786 'country' => $self->country,
1789 return "Unknown state/county/country: ".
1790 $self->state. "/". $self->county. "/". $self->country
1791 unless qsearch('cust_main_county',{
1792 'state' => $self->state,
1793 'county' => $self->county,
1794 'country' => $self->country,
1800 $self->ut_phonen('daytime', $self->country)
1801 || $self->ut_phonen('night', $self->country)
1802 || $self->ut_phonen('fax', $self->country)
1803 || $self->ut_zip('zip', $self->country)
1805 return $error if $error;
1807 if ( $conf->exists('cust_main-require_phone')
1808 && ! length($self->daytime) && ! length($self->night)
1811 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1813 : FS::Msgcat::_gettext('daytime');
1814 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1816 : FS::Msgcat::_gettext('night');
1818 return "$daytime_label or $night_label is required"
1822 if ( $self->has_ship_address
1823 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1824 $self->addr_fields )
1828 $self->ut_name('ship_last')
1829 || $self->ut_name('ship_first')
1830 || $self->ut_textn('ship_company')
1831 || $self->ut_text('ship_address1')
1832 || $self->ut_textn('ship_address2')
1833 || $self->ut_text('ship_city')
1834 || $self->ut_textn('ship_county')
1835 || $self->ut_textn('ship_state')
1836 || $self->ut_country('ship_country')
1838 return $error if $error;
1840 #false laziness with above
1841 unless ( qsearchs('cust_main_county', {
1842 'country' => $self->ship_country,
1845 return "Unknown ship_state/ship_county/ship_country: ".
1846 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1847 unless qsearch('cust_main_county',{
1848 'state' => $self->ship_state,
1849 'county' => $self->ship_county,
1850 'country' => $self->ship_country,
1856 $self->ut_phonen('ship_daytime', $self->ship_country)
1857 || $self->ut_phonen('ship_night', $self->ship_country)
1858 || $self->ut_phonen('ship_fax', $self->ship_country)
1859 || $self->ut_zip('ship_zip', $self->ship_country)
1861 return $error if $error;
1863 return "Unit # is required."
1864 if $self->ship_address2 =~ /^\s*$/
1865 && $conf->exists('cust_main-require_address2');
1867 } else { # ship_ info eq billing info, so don't store dup info in database
1869 $self->setfield("ship_$_", '')
1870 foreach $self->addr_fields;
1872 return "Unit # is required."
1873 if $self->address2 =~ /^\s*$/
1874 && $conf->exists('cust_main-require_address2');
1878 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1879 # or return "Illegal payby: ". $self->payby;
1881 FS::payby->can_payby($self->table, $self->payby)
1882 or return "Illegal payby: ". $self->payby;
1884 $error = $self->ut_numbern('paystart_month')
1885 || $self->ut_numbern('paystart_year')
1886 || $self->ut_numbern('payissue')
1887 || $self->ut_textn('paytype')
1889 return $error if $error;
1891 if ( $self->payip eq '' ) {
1894 $error = $self->ut_ip('payip');
1895 return $error if $error;
1898 # If it is encrypted and the private key is not availaible then we can't
1899 # check the credit card.
1900 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1902 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1904 my $payinfo = $self->payinfo;
1905 $payinfo =~ s/\D//g;
1906 $payinfo =~ /^(\d{13,16})$/
1907 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1909 $self->payinfo($payinfo);
1911 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1913 return gettext('unknown_card_type')
1914 if $self->payinfo !~ /^99\d{14}$/ #token
1915 && cardtype($self->payinfo) eq "Unknown";
1917 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1919 return 'Banned credit card: banned on '.
1920 time2str('%a %h %o at %r', $ban->_date).
1921 ' by '. $ban->otaker.
1922 ' (ban# '. $ban->bannum. ')';
1925 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1926 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1927 $self->paycvv =~ /^(\d{4})$/
1928 or return "CVV2 (CID) for American Express cards is four digits.";
1931 $self->paycvv =~ /^(\d{3})$/
1932 or return "CVV2 (CVC2/CID) is three digits.";
1939 my $cardtype = cardtype($payinfo);
1940 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1942 return "Start date or issue number is required for $cardtype cards"
1943 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1945 return "Start month must be between 1 and 12"
1946 if $self->paystart_month
1947 and $self->paystart_month < 1 || $self->paystart_month > 12;
1949 return "Start year must be 1990 or later"
1950 if $self->paystart_year
1951 and $self->paystart_year < 1990;
1953 return "Issue number must be beween 1 and 99"
1955 and $self->payissue < 1 || $self->payissue > 99;
1958 $self->paystart_month('');
1959 $self->paystart_year('');
1960 $self->payissue('');
1963 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1965 my $payinfo = $self->payinfo;
1966 $payinfo =~ s/[^\d\@]//g;
1967 if ( $conf->exists('echeck-nonus') ) {
1968 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1969 $payinfo = "$1\@$2";
1971 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1972 $payinfo = "$1\@$2";
1974 $self->payinfo($payinfo);
1977 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1979 return 'Banned ACH account: banned on '.
1980 time2str('%a %h %o at %r', $ban->_date).
1981 ' by '. $ban->otaker.
1982 ' (ban# '. $ban->bannum. ')';
1985 } elsif ( $self->payby eq 'LECB' ) {
1987 my $payinfo = $self->payinfo;
1988 $payinfo =~ s/\D//g;
1989 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1991 $self->payinfo($payinfo);
1994 } elsif ( $self->payby eq 'BILL' ) {
1996 $error = $self->ut_textn('payinfo');
1997 return "Illegal P.O. number: ". $self->payinfo if $error;
2000 } elsif ( $self->payby eq 'COMP' ) {
2002 my $curuser = $FS::CurrentUser::CurrentUser;
2003 if ( ! $self->custnum
2004 && ! $curuser->access_right('Complimentary customer')
2007 return "You are not permitted to create complimentary accounts."
2010 $error = $self->ut_textn('payinfo');
2011 return "Illegal comp account issuer: ". $self->payinfo if $error;
2014 } elsif ( $self->payby eq 'PREPAY' ) {
2016 my $payinfo = $self->payinfo;
2017 $payinfo =~ s/\W//g; #anything else would just confuse things
2018 $self->payinfo($payinfo);
2019 $error = $self->ut_alpha('payinfo');
2020 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2021 return "Unknown prepayment identifier"
2022 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2027 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2028 return "Expiration date required"
2029 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2033 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2034 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2035 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2036 ( $m, $y ) = ( $2, "19$1" );
2037 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2038 ( $m, $y ) = ( $3, "20$2" );
2040 return "Illegal expiration date: ". $self->paydate;
2042 $self->paydate("$y-$m-01");
2043 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2044 return gettext('expired_card')
2046 && !$ignore_expired_card
2047 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2050 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2051 ( ! $conf->exists('require_cardname')
2052 || $self->payby !~ /^(CARD|DCRD)$/ )
2054 $self->payname( $self->first. " ". $self->getfield('last') );
2056 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2057 or return gettext('illegal_name'). " payname: ". $self->payname;
2061 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2062 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2066 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2068 warn "$me check AFTER: \n". $self->_dump
2071 $self->SUPER::check;
2076 Returns a list of fields which have ship_ duplicates.
2081 qw( last first company
2082 address1 address2 city county state zip country
2087 =item has_ship_address
2089 Returns true if this customer record has a separate shipping address.
2093 sub has_ship_address {
2095 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2100 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2101 city, county, state, zip, country. The shipping address is used if present.
2105 #geocode? dependent on tax-ship_address config, not available in cust_location
2106 #mostly. not yet then.
2110 my $prefix = $self->has_ship_address ? 'ship_' : '';
2112 map { $_ => $self->get($prefix.$_) }
2113 qw( address1 address2 city county state zip country geocode );
2114 #fields that cust_location has
2117 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2119 Returns all packages (see L<FS::cust_pkg>) for this customer.
2125 my $extra_qsearch = ref($_[0]) ? shift : {};
2127 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
2130 if ( $self->{'_pkgnum'} ) {
2131 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
2133 @cust_pkg = $self->_cust_pkg($extra_qsearch);
2136 sort sort_packages @cust_pkg;
2141 Synonym for B<all_pkgs>.
2146 shift->all_pkgs(@_);
2151 Returns all locations (see L<FS::cust_location>) for this customer.
2157 qsearch('cust_location', { 'custnum' => $self->custnum } );
2160 =item location_label [ OPTION => VALUE ... ]
2162 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
2170 used to separate the address elements (defaults to ', ')
2172 =item escape_function
2174 a callback used for escaping the text of the address elements
2180 # false laziness with FS::cust_location::line
2182 sub location_label {
2186 my $separator = $opt{join_string} || ', ';
2187 my $escape = $opt{escape_function} || sub{ shift };
2189 my $cydefault = FS::conf->new->config('countrydefault') || 'US';
2190 my $prefix = length($self->ship_last) ? 'ship_' : '';
2193 foreach (qw ( address1 address2 ) ) {
2194 my $method = "$prefix$_";
2195 $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
2200 foreach (qw ( city county state zip ) ) {
2201 my $method = "$prefix$_";
2202 if ( $self->$method ) {
2203 $line .= ' (' if $method eq 'county';
2204 $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
2205 $line .= ' )' if $method eq 'county';
2209 $line .= $separator. &$escape(code2country($self->country))
2210 if $self->country ne $cydefault;
2215 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2217 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
2221 sub ncancelled_pkgs {
2223 my $extra_qsearch = ref($_[0]) ? shift : {};
2225 return $self->num_ncancelled_pkgs unless wantarray;
2228 if ( $self->{'_pkgnum'} ) {
2230 warn "$me ncancelled_pkgs: returning cached objects"
2233 @cust_pkg = grep { ! $_->getfield('cancel') }
2234 values %{ $self->{'_pkgnum'}->cache };
2238 warn "$me ncancelled_pkgs: searching for packages with custnum ".
2239 $self->custnum. "\n"
2242 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2244 @cust_pkg = $self->_cust_pkg($extra_qsearch);
2248 sort sort_packages @cust_pkg;
2254 my $extra_qsearch = ref($_[0]) ? shift : {};
2256 $extra_qsearch->{'select'} ||= '*';
2257 $extra_qsearch->{'select'} .=
2258 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2262 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2267 'table' => 'cust_pkg',
2268 'hashref' => { 'custnum' => $self->custnum },
2273 # This should be generalized to use config options to determine order.
2276 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
2277 return $locationsort if $locationsort;
2279 if ( $a->get('cancel') xor $b->get('cancel') ) {
2280 return -1 if $b->get('cancel');
2281 return 1 if $a->get('cancel');
2282 #shouldn't get here...
2285 my $a_num_cust_svc = $a->num_cust_svc;
2286 my $b_num_cust_svc = $b->num_cust_svc;
2287 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
2288 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
2289 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
2290 my @a_cust_svc = $a->cust_svc;
2291 my @b_cust_svc = $b->cust_svc;
2292 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2293 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2294 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
2295 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2300 =item suspended_pkgs
2302 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2306 sub suspended_pkgs {
2308 grep { $_->susp } $self->ncancelled_pkgs;
2311 =item unflagged_suspended_pkgs
2313 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2314 customer (thouse packages without the `manual_flag' set).
2318 sub unflagged_suspended_pkgs {
2320 return $self->suspended_pkgs
2321 unless dbdef->table('cust_pkg')->column('manual_flag');
2322 grep { ! $_->manual_flag } $self->suspended_pkgs;
2325 =item unsuspended_pkgs
2327 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2332 sub unsuspended_pkgs {
2334 grep { ! $_->susp } $self->ncancelled_pkgs;
2337 =item next_bill_date
2339 Returns the next date this customer will be billed, as a UNIX timestamp, or
2340 undef if no active package has a next bill date.
2344 sub next_bill_date {
2346 min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2349 =item num_cancelled_pkgs
2351 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2356 sub num_cancelled_pkgs {
2357 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2360 sub num_ncancelled_pkgs {
2361 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2365 my( $self ) = shift;
2366 my $sql = scalar(@_) ? shift : '';
2367 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2368 my $sth = dbh->prepare(
2369 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2370 ) or die dbh->errstr;
2371 $sth->execute($self->custnum) or die $sth->errstr;
2372 $sth->fetchrow_arrayref->[0];
2377 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2378 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2379 on success or a list of errors.
2385 grep { $_->unsuspend } $self->suspended_pkgs;
2390 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2392 Returns a list: an empty list on success or a list of errors.
2398 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2401 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2403 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2404 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2405 of a list of pkgparts; the hashref has the following keys:
2409 =item pkgparts - listref of pkgparts
2411 =item (other options are passed to the suspend method)
2416 Returns a list: an empty list on success or a list of errors.
2420 sub suspend_if_pkgpart {
2422 my (@pkgparts, %opt);
2423 if (ref($_[0]) eq 'HASH'){
2424 @pkgparts = @{$_[0]{pkgparts}};
2429 grep { $_->suspend(%opt) }
2430 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2431 $self->unsuspended_pkgs;
2434 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2436 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2437 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2438 instead of a list of pkgparts; the hashref has the following keys:
2442 =item pkgparts - listref of pkgparts
2444 =item (other options are passed to the suspend method)
2448 Returns a list: an empty list on success or a list of errors.
2452 sub suspend_unless_pkgpart {
2454 my (@pkgparts, %opt);
2455 if (ref($_[0]) eq 'HASH'){
2456 @pkgparts = @{$_[0]{pkgparts}};
2461 grep { $_->suspend(%opt) }
2462 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2463 $self->unsuspended_pkgs;
2466 =item cancel [ OPTION => VALUE ... ]
2468 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2470 Available options are:
2474 =item quiet - can be set true to supress email cancellation notices.
2476 =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.
2478 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2480 =item nobill - can be set true to skip billing if it might otherwise be done.
2484 Always returns a list: an empty list on success or a list of errors.
2488 # nb that dates are not specified as valid options to this method
2491 my( $self, %opt ) = @_;
2493 warn "$me cancel called on customer ". $self->custnum. " with options ".
2494 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2497 return ( 'access denied' )
2498 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2500 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2502 #should try decryption (we might have the private key)
2503 # and if not maybe queue a job for the server that does?
2504 return ( "Can't (yet) ban encrypted credit cards" )
2505 if $self->is_encrypted($self->payinfo);
2507 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2508 my $error = $ban->insert;
2509 return ( $error ) if $error;
2513 my @pkgs = $self->ncancelled_pkgs;
2515 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2517 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2518 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2522 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2523 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2526 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2529 sub _banned_pay_hashref {
2540 'payby' => $payby2ban{$self->payby},
2541 'payinfo' => md5_base64($self->payinfo),
2542 #don't ever *search* on reason! #'reason' =>
2548 Returns all notes (see L<FS::cust_main_note>) for this customer.
2555 qsearch( 'cust_main_note',
2556 { 'custnum' => $self->custnum },
2558 'ORDER BY _DATE DESC'
2564 Returns the agent (see L<FS::agent>) for this customer.
2570 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2575 Returns the agent name (see L<FS::agent>) for this customer.
2581 $self->agent->agent;
2586 Returns any tags associated with this customer, as FS::cust_tag objects,
2587 or an empty list if there are no tags.
2593 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2598 Returns any tags associated with this customer, as FS::part_tag objects,
2599 or an empty list if there are no tags.
2605 map $_->part_tag, $self->cust_tag;
2611 Returns the customer class, as an FS::cust_class object, or the empty string
2612 if there is no customer class.
2618 if ( $self->classnum ) {
2619 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2627 Returns the customer category name, or the empty string if there is no customer
2634 my $cust_class = $self->cust_class;
2636 ? $cust_class->categoryname
2642 Returns the customer class name, or the empty string if there is no customer
2649 my $cust_class = $self->cust_class;
2651 ? $cust_class->classname
2655 =item BILLING METHODS
2657 Documentation on billing methods has been moved to
2658 L<FS::cust_main::Billing>.
2660 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
2662 Runs billing events; see L<FS::part_event> and the billing events web
2665 If there is an error, returns the error, otherwise returns false.
2667 Options are passed as name-value pairs.
2669 Currently available options are:
2675 Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions.
2679 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2683 "collect" (the default) or "pre-bill"
2687 set true to surpress email card/ACH decline notices.
2691 Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2697 # allows for one time override of normal customer billing method
2701 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2704 my( $self, %options ) = @_;
2705 my $time = $options{'time'} || time;
2708 local $SIG{HUP} = 'IGNORE';
2709 local $SIG{INT} = 'IGNORE';
2710 local $SIG{QUIT} = 'IGNORE';
2711 local $SIG{TERM} = 'IGNORE';
2712 local $SIG{TSTP} = 'IGNORE';
2713 local $SIG{PIPE} = 'IGNORE';
2715 my $oldAutoCommit = $FS::UID::AutoCommit;
2716 local $FS::UID::AutoCommit = 0;
2719 $self->select_for_update; #mutex
2722 my $balance = $self->balance;
2723 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
2726 # if ( exists($options{'retry_card'}) ) {
2727 # carp 'retry_card option passed to collect is deprecated; use retry';
2728 # $options{'retry'} ||= $options{'retry_card'};
2730 # if ( exists($options{'retry'}) && $options{'retry'} ) {
2731 # my $error = $self->retry_realtime;
2733 # $dbh->rollback if $oldAutoCommit;
2738 # false laziness w/pay_batch::import_results
2740 my $due_cust_event = $self->due_cust_event(
2741 'debug' => ( $options{'debug'} || 0 ),
2743 'check_freq' => $options{'check_freq'},
2744 'stage' => ( $options{'stage'} || 'collect' ),
2746 unless( ref($due_cust_event) ) {
2747 $dbh->rollback if $oldAutoCommit;
2748 return $due_cust_event;
2751 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2752 #never want to roll back an event just because it or a different one
2754 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
2756 foreach my $cust_event ( @$due_cust_event ) {
2760 #re-eval event conditions (a previous event could have changed things)
2761 unless ( $cust_event->test_conditions( 'time' => $time ) ) {
2762 #don't leave stray "new/locked" records around
2763 my $error = $cust_event->delete;
2764 return $error if $error;
2769 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2770 warn " running cust_event ". $cust_event->eventnum. "\n"
2773 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2774 if ( my $error = $cust_event->do_event() ) {
2775 #XXX wtf is this? figure out a proper dealio with return value
2787 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2789 Inserts database records for and returns an ordered listref of new events due
2790 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
2791 events are due, an empty listref is returned. If there is an error, returns a
2792 scalar error message.
2794 To actually run the events, call each event's test_condition method, and if
2795 still true, call the event's do_event method.
2797 Options are passed as a hashref or as a list of name-value pairs. Available
2804 Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
2808 "collect" (the default) or "pre-bill"
2812 "Current time" for the events.
2816 Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2820 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2824 Explicitly pass the objects to be tested (typically used with eventtable).
2828 Set to true to return the objects, but not actually insert them into the
2835 sub due_cust_event {
2837 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2840 #my $DEBUG = $opt{'debug'}
2841 local($DEBUG) = $opt{'debug'}
2842 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2844 warn "$me due_cust_event called with options ".
2845 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2848 $opt{'time'} ||= time;
2850 local $SIG{HUP} = 'IGNORE';
2851 local $SIG{INT} = 'IGNORE';
2852 local $SIG{QUIT} = 'IGNORE';
2853 local $SIG{TERM} = 'IGNORE';
2854 local $SIG{TSTP} = 'IGNORE';
2855 local $SIG{PIPE} = 'IGNORE';
2857 my $oldAutoCommit = $FS::UID::AutoCommit;
2858 local $FS::UID::AutoCommit = 0;
2861 $self->select_for_update #mutex
2862 unless $opt{testonly};
2865 # find possible events (initial search)
2868 my @cust_event = ();
2870 my @eventtable = $opt{'eventtable'}
2871 ? ( $opt{'eventtable'} )
2872 : FS::part_event->eventtables_runorder;
2874 foreach my $eventtable ( @eventtable ) {
2877 if ( $opt{'objects'} ) {
2879 @objects = @{ $opt{'objects'} };
2883 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2884 @objects = ( $eventtable eq 'cust_main' )
2886 : ( $self->$eventtable() );
2890 my @e_cust_event = ();
2892 my $cross = "CROSS JOIN $eventtable";
2893 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2894 unless $eventtable eq 'cust_main';
2896 foreach my $object ( @objects ) {
2898 #this first search uses the condition_sql magic for optimization.
2899 #the more possible events we can eliminate in this step the better
2901 my $cross_where = '';
2902 my $pkey = $object->primary_key;
2903 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2905 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2907 FS::part_event_condition->where_conditions_sql( $eventtable,
2908 'time'=>$opt{'time'}
2910 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2912 $extra_sql = "AND $extra_sql" if $extra_sql;
2914 #here is the agent virtualization
2915 $extra_sql .= " AND ( part_event.agentnum IS NULL
2916 OR part_event.agentnum = ". $self->agentnum. ' )';
2918 $extra_sql .= " $order";
2920 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2921 if $opt{'debug'} > 2;
2922 my @part_event = qsearch( {
2923 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2924 'select' => 'part_event.*',
2925 'table' => 'part_event',
2926 'addl_from' => "$cross $join",
2927 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2928 'eventtable' => $eventtable,
2931 'extra_sql' => "AND $cross_where $extra_sql",
2935 my $pkey = $object->primary_key;
2936 warn " ". scalar(@part_event).
2937 " possible events found for $eventtable ". $object->$pkey(). "\n";
2940 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2944 warn " ". scalar(@e_cust_event).
2945 " subtotal possible cust events found for $eventtable\n"
2948 push @cust_event, @e_cust_event;
2952 warn " ". scalar(@cust_event).
2953 " total possible cust events found in initial search\n"
2961 $opt{stage} ||= 'collect';
2963 grep { my $stage = $_->part_event->event_stage;
2964 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2974 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
2975 'stats_hashref' => \%unsat ),
2978 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2981 warn " invalid conditions not eliminated with condition_sql:\n".
2982 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2983 if keys %unsat && $DEBUG; # > 1;
2989 unless( $opt{testonly} ) {
2990 foreach my $cust_event ( @cust_event ) {
2992 my $error = $cust_event->insert();
2994 $dbh->rollback if $oldAutoCommit;
3001 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3007 warn " returning events: ". Dumper(@cust_event). "\n"
3014 =item retry_realtime
3016 Schedules realtime / batch credit card / electronic check / LEC billing
3017 events for for retry. Useful if card information has changed or manual
3018 retry is desired. The 'collect' method must be called to actually retry
3021 Implementation details: For either this customer, or for each of this
3022 customer's open invoices, changes the status of the first "done" (with
3023 statustext error) realtime processing event to "failed".
3027 sub retry_realtime {
3030 local $SIG{HUP} = 'IGNORE';
3031 local $SIG{INT} = 'IGNORE';
3032 local $SIG{QUIT} = 'IGNORE';
3033 local $SIG{TERM} = 'IGNORE';
3034 local $SIG{TSTP} = 'IGNORE';
3035 local $SIG{PIPE} = 'IGNORE';
3037 my $oldAutoCommit = $FS::UID::AutoCommit;
3038 local $FS::UID::AutoCommit = 0;
3041 #a little false laziness w/due_cust_event (not too bad, really)
3043 my $join = FS::part_event_condition->join_conditions_sql;
3044 my $order = FS::part_event_condition->order_conditions_sql;
3047 . join ( ' OR ' , map {
3048 "( part_event.eventtable = " . dbh->quote($_)
3049 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3050 } FS::part_event->eventtables)
3053 #here is the agent virtualization
3054 my $agent_virt = " ( part_event.agentnum IS NULL
3055 OR part_event.agentnum = ". $self->agentnum. ' )';
3057 #XXX this shouldn't be hardcoded, actions should declare it...
3058 my @realtime_events = qw(
3059 cust_bill_realtime_card
3060 cust_bill_realtime_check
3061 cust_bill_realtime_lec
3065 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3070 my @cust_event = qsearchs({
3071 'table' => 'cust_event',
3072 'select' => 'cust_event.*',
3073 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3074 'hashref' => { 'status' => 'done' },
3075 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3076 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3079 my %seen_invnum = ();
3080 foreach my $cust_event (@cust_event) {
3082 #max one for the customer, one for each open invoice
3083 my $cust_X = $cust_event->cust_X;
3084 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3088 or $cust_event->part_event->eventtable eq 'cust_bill'
3091 my $error = $cust_event->retry;
3093 $dbh->rollback if $oldAutoCommit;
3094 return "error scheduling event for retry: $error";
3099 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3107 =item REALTIME BILLING METHODS
3109 Documentation on realtime billing methods has been moved to
3110 L<FS::cust_main::Billing_Realtime>.
3114 Removes the I<paycvv> field from the database directly.
3116 If there is an error, returns the error, otherwise returns false.
3122 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3123 or return dbh->errstr;
3124 $sth->execute($self->custnum)
3125 or return $sth->errstr;
3130 =item batch_card OPTION => VALUE...
3132 Adds a payment for this invoice to the pending credit card batch (see
3133 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
3134 runs the payment using a realtime gateway.
3139 my ($self, %options) = @_;
3142 if (exists($options{amount})) {
3143 $amount = $options{amount};
3145 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
3147 return '' unless $amount > 0;
3149 my $invnum = delete $options{invnum};
3150 my $payby = $options{invnum} || $self->payby; #dubious
3152 if ($options{'realtime'}) {
3153 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
3159 my $oldAutoCommit = $FS::UID::AutoCommit;
3160 local $FS::UID::AutoCommit = 0;
3163 #this needs to handle mysql as well as Pg, like svc_acct.pm
3164 #(make it into a common function if folks need to do batching with mysql)
3165 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
3166 or return "Cannot lock pay_batch: " . $dbh->errstr;
3170 'payby' => FS::payby->payby2payment($payby),
3173 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
3175 unless ( $pay_batch ) {
3176 $pay_batch = new FS::pay_batch \%pay_batch;
3177 my $error = $pay_batch->insert;
3179 $dbh->rollback if $oldAutoCommit;
3180 die "error creating new batch: $error\n";
3184 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
3185 'batchnum' => $pay_batch->batchnum,
3186 'custnum' => $self->custnum,
3189 foreach (qw( address1 address2 city state zip country payby payinfo paydate
3191 $options{$_} = '' unless exists($options{$_});
3194 my $cust_pay_batch = new FS::cust_pay_batch ( {
3195 'batchnum' => $pay_batch->batchnum,
3196 'invnum' => $invnum || 0, # is there a better value?
3197 # this field should be
3199 # cust_bill_pay_batch now
3200 'custnum' => $self->custnum,
3201 'last' => $self->getfield('last'),
3202 'first' => $self->getfield('first'),
3203 'address1' => $options{address1} || $self->address1,
3204 'address2' => $options{address2} || $self->address2,
3205 'city' => $options{city} || $self->city,
3206 'state' => $options{state} || $self->state,
3207 'zip' => $options{zip} || $self->zip,
3208 'country' => $options{country} || $self->country,
3209 'payby' => $options{payby} || $self->payby,
3210 'payinfo' => $options{payinfo} || $self->payinfo,
3211 'exp' => $options{paydate} || $self->paydate,
3212 'payname' => $options{payname} || $self->payname,
3213 'amount' => $amount, # consolidating
3216 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
3217 if $old_cust_pay_batch;
3220 if ($old_cust_pay_batch) {
3221 $error = $cust_pay_batch->replace($old_cust_pay_batch)
3223 $error = $cust_pay_batch->insert;
3227 $dbh->rollback if $oldAutoCommit;
3231 my $unapplied = $self->total_unapplied_credits
3232 + $self->total_unapplied_payments
3233 + $self->in_transit_payments;
3234 foreach my $cust_bill ($self->open_cust_bill) {
3235 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
3236 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
3237 'invnum' => $cust_bill->invnum,
3238 'paybatchnum' => $cust_pay_batch->paybatchnum,
3239 'amount' => $cust_bill->owed,
3242 if ($unapplied >= $cust_bill_pay_batch->amount){
3243 $unapplied -= $cust_bill_pay_batch->amount;
3246 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
3247 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
3249 $error = $cust_bill_pay_batch->insert;
3251 $dbh->rollback if $oldAutoCommit;
3256 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3262 Returns the total owed for this customer on all invoices
3263 (see L<FS::cust_bill/owed>).
3269 $self->total_owed_date(2145859200); #12/31/2037
3272 =item total_owed_date TIME
3274 Returns the total owed for this customer on all invoices with date earlier than
3275 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
3276 see L<Time::Local> and L<Date::Parse> for conversion functions.
3280 sub total_owed_date {
3284 my $custnum = $self->custnum;
3286 my $owed_sql = FS::cust_bill->owed_sql;
3289 SELECT SUM($owed_sql) FROM cust_bill
3290 WHERE custnum = $custnum
3294 sprintf( "%.2f", $self->scalar_sql($sql) );
3298 =item total_owed_pkgnum PKGNUM
3300 Returns the total owed on all invoices for this customer's specific package
3301 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
3305 sub total_owed_pkgnum {
3306 my( $self, $pkgnum ) = @_;
3307 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
3310 =item total_owed_date_pkgnum TIME PKGNUM
3312 Returns the total owed for this customer's specific package when using
3313 experimental package balances on all invoices with date earlier than
3314 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
3315 see L<Time::Local> and L<Date::Parse> for conversion functions.
3319 sub total_owed_date_pkgnum {
3320 my( $self, $time, $pkgnum ) = @_;
3323 foreach my $cust_bill (
3324 grep { $_->_date <= $time }
3325 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3327 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
3329 sprintf( "%.2f", $total_bill );
3335 Returns the total amount of all payments.
3342 $total += $_->paid foreach $self->cust_pay;
3343 sprintf( "%.2f", $total );
3346 =item total_unapplied_credits
3348 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3349 customer. See L<FS::cust_credit/credited>.
3351 =item total_credited
3353 Old name for total_unapplied_credits. Don't use.
3357 sub total_credited {
3358 #carp "total_credited deprecated, use total_unapplied_credits";
3359 shift->total_unapplied_credits(@_);
3362 sub total_unapplied_credits {
3365 my $custnum = $self->custnum;
3367 my $unapplied_sql = FS::cust_credit->unapplied_sql;
3370 SELECT SUM($unapplied_sql) FROM cust_credit
3371 WHERE custnum = $custnum
3374 sprintf( "%.2f", $self->scalar_sql($sql) );
3378 =item total_unapplied_credits_pkgnum PKGNUM
3380 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3381 customer. See L<FS::cust_credit/credited>.
3385 sub total_unapplied_credits_pkgnum {
3386 my( $self, $pkgnum ) = @_;
3387 my $total_credit = 0;
3388 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
3389 sprintf( "%.2f", $total_credit );
3393 =item total_unapplied_payments
3395 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3396 See L<FS::cust_pay/unapplied>.
3400 sub total_unapplied_payments {
3403 my $custnum = $self->custnum;
3405 my $unapplied_sql = FS::cust_pay->unapplied_sql;
3408 SELECT SUM($unapplied_sql) FROM cust_pay
3409 WHERE custnum = $custnum
3412 sprintf( "%.2f", $self->scalar_sql($sql) );
3416 =item total_unapplied_payments_pkgnum PKGNUM
3418 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
3419 specific package when using experimental package balances. See
3420 L<FS::cust_pay/unapplied>.
3424 sub total_unapplied_payments_pkgnum {
3425 my( $self, $pkgnum ) = @_;
3426 my $total_unapplied = 0;
3427 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
3428 sprintf( "%.2f", $total_unapplied );
3432 =item total_unapplied_refunds
3434 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
3435 customer. See L<FS::cust_refund/unapplied>.
3439 sub total_unapplied_refunds {
3441 my $custnum = $self->custnum;
3443 my $unapplied_sql = FS::cust_refund->unapplied_sql;
3446 SELECT SUM($unapplied_sql) FROM cust_refund
3447 WHERE custnum = $custnum
3450 sprintf( "%.2f", $self->scalar_sql($sql) );
3456 Returns the balance for this customer (total_owed plus total_unrefunded, minus
3457 total_unapplied_credits minus total_unapplied_payments).
3463 $self->balance_date_range;
3466 =item balance_date TIME
3468 Returns the balance for this customer, only considering invoices with date
3469 earlier than TIME (total_owed_date minus total_credited minus
3470 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3471 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3478 $self->balance_date_range(shift);
3481 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3483 Returns the balance for this customer, optionally considering invoices with
3484 date earlier than START_TIME, and not later than END_TIME
3485 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
3487 Times are specified as SQL fragments or numeric
3488 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
3489 L<Date::Parse> for conversion functions. The empty string can be passed
3490 to disable that time constraint completely.
3492 Available options are:
3496 =item unapplied_date
3498 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)
3504 sub balance_date_range {
3506 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
3507 ') FROM cust_main WHERE custnum='. $self->custnum;
3508 sprintf( '%.2f', $self->scalar_sql($sql) );
3511 =item balance_pkgnum PKGNUM
3513 Returns the balance for this customer's specific package when using
3514 experimental package balances (total_owed plus total_unrefunded, minus
3515 total_unapplied_credits minus total_unapplied_payments)
3519 sub balance_pkgnum {
3520 my( $self, $pkgnum ) = @_;
3523 $self->total_owed_pkgnum($pkgnum)
3524 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
3525 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
3526 - $self->total_unapplied_credits_pkgnum($pkgnum)
3527 - $self->total_unapplied_payments_pkgnum($pkgnum)
3531 =item in_transit_payments
3533 Returns the total of requests for payments for this customer pending in
3534 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
3538 sub in_transit_payments {
3540 my $in_transit_payments = 0;
3541 foreach my $pay_batch ( qsearch('pay_batch', {
3544 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3545 'batchnum' => $pay_batch->batchnum,
3546 'custnum' => $self->custnum,
3548 $in_transit_payments += $cust_pay_batch->amount;
3551 sprintf( "%.2f", $in_transit_payments );
3556 Returns a hash of useful information for making a payment.
3566 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3567 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3568 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3572 For credit card transactions:
3584 For electronic check transactions:
3599 $return{balance} = $self->balance;
3601 $return{payname} = $self->payname
3602 || ( $self->first. ' '. $self->get('last') );
3604 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
3606 $return{payby} = $self->payby;
3607 $return{stateid_state} = $self->stateid_state;
3609 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3610 $return{card_type} = cardtype($self->payinfo);
3611 $return{payinfo} = $self->paymask;
3613 @return{'month', 'year'} = $self->paydate_monthyear;
3617 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3618 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3619 $return{payinfo1} = $payinfo1;
3620 $return{payinfo2} = $payinfo2;
3621 $return{paytype} = $self->paytype;
3622 $return{paystate} = $self->paystate;
3626 #doubleclick protection
3628 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3634 =item paydate_monthyear
3636 Returns a two-element list consisting of the month and year of this customer's
3637 paydate (credit card expiration date for CARD customers)
3641 sub paydate_monthyear {
3643 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3645 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3652 =item tax_exemption TAXNAME
3657 my( $self, $taxname ) = @_;
3659 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3660 'taxname' => $taxname,
3665 =item cust_main_exemption
3669 sub cust_main_exemption {
3671 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3674 =item invoicing_list [ ARRAYREF ]
3676 If an arguement is given, sets these email addresses as invoice recipients
3677 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3678 (except as warnings), so use check_invoicing_list first.
3680 Returns a list of email addresses (with svcnum entries expanded).
3682 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3683 check it without disturbing anything by passing nothing.
3685 This interface may change in the future.
3689 sub invoicing_list {
3690 my( $self, $arrayref ) = @_;
3693 my @cust_main_invoice;
3694 if ( $self->custnum ) {
3695 @cust_main_invoice =
3696 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3698 @cust_main_invoice = ();
3700 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3701 #warn $cust_main_invoice->destnum;
3702 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3703 #warn $cust_main_invoice->destnum;
3704 my $error = $cust_main_invoice->delete;
3705 warn $error if $error;
3708 if ( $self->custnum ) {
3709 @cust_main_invoice =
3710 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3712 @cust_main_invoice = ();
3714 my %seen = map { $_->address => 1 } @cust_main_invoice;
3715 foreach my $address ( @{$arrayref} ) {
3716 next if exists $seen{$address} && $seen{$address};
3717 $seen{$address} = 1;
3718 my $cust_main_invoice = new FS::cust_main_invoice ( {
3719 'custnum' => $self->custnum,
3722 my $error = $cust_main_invoice->insert;
3723 warn $error if $error;
3727 if ( $self->custnum ) {
3729 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3736 =item check_invoicing_list ARRAYREF
3738 Checks these arguements as valid input for the invoicing_list method. If there
3739 is an error, returns the error, otherwise returns false.
3743 sub check_invoicing_list {
3744 my( $self, $arrayref ) = @_;
3746 foreach my $address ( @$arrayref ) {
3748 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3749 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3752 my $cust_main_invoice = new FS::cust_main_invoice ( {
3753 'custnum' => $self->custnum,
3756 my $error = $self->custnum
3757 ? $cust_main_invoice->check
3758 : $cust_main_invoice->checkdest
3760 return $error if $error;
3764 return "Email address required"
3765 if $conf->exists('cust_main-require_invoicing_list_email')
3766 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3771 =item set_default_invoicing_list
3773 Sets the invoicing list to all accounts associated with this customer,
3774 overwriting any previous invoicing list.
3778 sub set_default_invoicing_list {
3780 $self->invoicing_list($self->all_emails);
3785 Returns the email addresses of all accounts provisioned for this customer.
3792 foreach my $cust_pkg ( $self->all_pkgs ) {
3793 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3795 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3796 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3798 $list{$_}=1 foreach map { $_->email } @svc_acct;
3803 =item invoicing_list_addpost
3805 Adds postal invoicing to this customer. If this customer is already configured
3806 to receive postal invoices, does nothing.
3810 sub invoicing_list_addpost {
3812 return if grep { $_ eq 'POST' } $self->invoicing_list;
3813 my @invoicing_list = $self->invoicing_list;
3814 push @invoicing_list, 'POST';
3815 $self->invoicing_list(\@invoicing_list);
3818 =item invoicing_list_emailonly
3820 Returns the list of email invoice recipients (invoicing_list without non-email
3821 destinations such as POST and FAX).
3825 sub invoicing_list_emailonly {
3827 warn "$me invoicing_list_emailonly called"
3829 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3832 =item invoicing_list_emailonly_scalar
3834 Returns the list of email invoice recipients (invoicing_list without non-email
3835 destinations such as POST and FAX) as a comma-separated scalar.
3839 sub invoicing_list_emailonly_scalar {
3841 warn "$me invoicing_list_emailonly_scalar called"
3843 join(', ', $self->invoicing_list_emailonly);
3846 =item referral_custnum_cust_main
3848 Returns the customer who referred this customer (or the empty string, if
3849 this customer was not referred).
3851 Note the difference with referral_cust_main method: This method,
3852 referral_custnum_cust_main returns the single customer (if any) who referred
3853 this customer, while referral_cust_main returns an array of customers referred
3858 sub referral_custnum_cust_main {
3860 return '' unless $self->referral_custnum;
3861 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3864 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3866 Returns an array of customers referred by this customer (referral_custnum set
3867 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3868 customers referred by customers referred by this customer and so on, inclusive.
3869 The default behavior is DEPTH 1 (no recursion).
3871 Note the difference with referral_custnum_cust_main method: This method,
3872 referral_cust_main, returns an array of customers referred BY this customer,
3873 while referral_custnum_cust_main returns the single customer (if any) who
3874 referred this customer.
3878 sub referral_cust_main {
3880 my $depth = @_ ? shift : 1;
3881 my $exclude = @_ ? shift : {};
3884 map { $exclude->{$_->custnum}++; $_; }
3885 grep { ! $exclude->{ $_->custnum } }
3886 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3890 map { $_->referral_cust_main($depth-1, $exclude) }
3897 =item referral_cust_main_ncancelled
3899 Same as referral_cust_main, except only returns customers with uncancelled
3904 sub referral_cust_main_ncancelled {
3906 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3909 =item referral_cust_pkg [ DEPTH ]
3911 Like referral_cust_main, except returns a flat list of all unsuspended (and
3912 uncancelled) packages for each customer. The number of items in this list may
3913 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3917 sub referral_cust_pkg {
3919 my $depth = @_ ? shift : 1;
3921 map { $_->unsuspended_pkgs }
3922 grep { $_->unsuspended_pkgs }
3923 $self->referral_cust_main($depth);
3926 =item referring_cust_main
3928 Returns the single cust_main record for the customer who referred this customer
3929 (referral_custnum), or false.
3933 sub referring_cust_main {
3935 return '' unless $self->referral_custnum;
3936 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3939 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3941 Applies a credit to this customer. If there is an error, returns the error,
3942 otherwise returns false.
3944 REASON can be a text string, an FS::reason object, or a scalar reference to
3945 a reasonnum. If a text string, it will be automatically inserted as a new
3946 reason, and a 'reason_type' option must be passed to indicate the
3947 FS::reason_type for the new reason.
3949 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3951 Any other options are passed to FS::cust_credit::insert.
3956 my( $self, $amount, $reason, %options ) = @_;
3958 my $cust_credit = new FS::cust_credit {
3959 'custnum' => $self->custnum,
3960 'amount' => $amount,
3963 if ( ref($reason) ) {
3965 if ( ref($reason) eq 'SCALAR' ) {
3966 $cust_credit->reasonnum( $$reason );
3968 $cust_credit->reasonnum( $reason->reasonnum );
3972 $cust_credit->set('reason', $reason)
3975 for (qw( addlinfo eventnum )) {
3976 $cust_credit->$_( delete $options{$_} )
3977 if exists($options{$_});
3980 $cust_credit->insert(%options);
3984 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3986 Creates a one-time charge for this customer. If there is an error, returns
3987 the error, otherwise returns false.
3989 New-style, with a hashref of options:
3991 my $error = $cust_main->charge(
3995 'start_date' => str2time('7/4/2009'),
3996 'pkg' => 'Description',
3997 'comment' => 'Comment',
3998 'additional' => [], #extra invoice detail
3999 'classnum' => 1, #pkg_class
4001 'setuptax' => '', # or 'Y' for tax exempt
4004 'taxclass' => 'Tax class',
4007 'taxproduct' => 2, #part_pkg_taxproduct
4008 'override' => {}, #XXX describe
4010 #will be filled in with the new object
4011 'cust_pkg_ref' => \$cust_pkg,
4013 #generate an invoice immediately
4015 'invoice_terms' => '', #with these terms
4021 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
4027 my ( $amount, $quantity, $start_date, $classnum );
4028 my ( $pkg, $comment, $additional );
4029 my ( $setuptax, $taxclass ); #internal taxes
4030 my ( $taxproduct, $override ); #vendor (CCH) taxes
4032 my $cust_pkg_ref = '';
4033 my ( $bill_now, $invoice_terms ) = ( 0, '' );
4034 if ( ref( $_[0] ) ) {
4035 $amount = $_[0]->{amount};
4036 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
4037 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
4038 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
4039 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4040 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
4041 : '$'. sprintf("%.2f",$amount);
4042 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
4043 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4044 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
4045 $additional = $_[0]->{additional} || [];
4046 $taxproduct = $_[0]->{taxproductnum};
4047 $override = { '' => $_[0]->{tax_override} };
4048 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
4049 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
4050 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
4055 $pkg = @_ ? shift : 'One-time charge';
4056 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
4058 $taxclass = @_ ? shift : '';
4062 local $SIG{HUP} = 'IGNORE';
4063 local $SIG{INT} = 'IGNORE';
4064 local $SIG{QUIT} = 'IGNORE';
4065 local $SIG{TERM} = 'IGNORE';
4066 local $SIG{TSTP} = 'IGNORE';
4067 local $SIG{PIPE} = 'IGNORE';
4069 my $oldAutoCommit = $FS::UID::AutoCommit;
4070 local $FS::UID::AutoCommit = 0;
4073 my $part_pkg = new FS::part_pkg ( {
4075 'comment' => $comment,
4079 'classnum' => ( $classnum ? $classnum : '' ),
4080 'setuptax' => $setuptax,
4081 'taxclass' => $taxclass,
4082 'taxproductnum' => $taxproduct,
4085 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4086 ( 0 .. @$additional - 1 )
4088 'additional_count' => scalar(@$additional),
4089 'setup_fee' => $amount,
4092 my $error = $part_pkg->insert( options => \%options,
4093 tax_overrides => $override,
4096 $dbh->rollback if $oldAutoCommit;
4100 my $pkgpart = $part_pkg->pkgpart;
4101 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4102 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4103 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4104 $error = $type_pkgs->insert;
4106 $dbh->rollback if $oldAutoCommit;
4111 my $cust_pkg = new FS::cust_pkg ( {
4112 'custnum' => $self->custnum,
4113 'pkgpart' => $pkgpart,
4114 'quantity' => $quantity,
4115 'start_date' => $start_date,
4116 'no_auto' => $no_auto,
4119 $error = $cust_pkg->insert;
4121 $dbh->rollback if $oldAutoCommit;
4123 } elsif ( $cust_pkg_ref ) {
4124 ${$cust_pkg_ref} = $cust_pkg;
4128 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
4129 'pkg_list' => [ $cust_pkg ],
4132 $dbh->rollback if $oldAutoCommit;
4137 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4142 #=item charge_postal_fee
4144 #Applies a one time charge this customer. If there is an error,
4145 #returns the error, returns the cust_pkg charge object or false
4146 #if there was no charge.
4150 # This should be a customer event. For that to work requires that bill
4151 # also be a customer event.
4153 sub charge_postal_fee {
4156 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
4157 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
4159 my $cust_pkg = new FS::cust_pkg ( {
4160 'custnum' => $self->custnum,
4161 'pkgpart' => $pkgpart,
4165 my $error = $cust_pkg->insert;
4166 $error ? $error : $cust_pkg;
4171 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4177 map { $_ } #return $self->num_cust_bill unless wantarray;
4178 sort { $a->_date <=> $b->_date }
4179 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4182 =item open_cust_bill
4184 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4189 sub open_cust_bill {
4193 'table' => 'cust_bill',
4194 'hashref' => { 'custnum' => $self->custnum, },
4195 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
4196 'order_by' => 'ORDER BY _date ASC',
4201 =item cust_statements
4203 Returns all the statements (see L<FS::cust_statement>) for this customer.
4207 sub cust_statement {
4209 map { $_ } #return $self->num_cust_statement unless wantarray;
4210 sort { $a->_date <=> $b->_date }
4211 qsearch('cust_statement', { 'custnum' => $self->custnum, } )
4216 Returns all the credits (see L<FS::cust_credit>) for this customer.
4222 map { $_ } #return $self->num_cust_credit unless wantarray;
4223 sort { $a->_date <=> $b->_date }
4224 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4227 =item cust_credit_pkgnum
4229 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
4230 package when using experimental package balances.
4234 sub cust_credit_pkgnum {
4235 my( $self, $pkgnum ) = @_;
4236 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
4237 sort { $a->_date <=> $b->_date }
4238 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
4239 'pkgnum' => $pkgnum,
4246 Returns all the payments (see L<FS::cust_pay>) for this customer.
4252 return $self->num_cust_pay unless wantarray;
4253 sort { $a->_date <=> $b->_date }
4254 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
4259 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
4260 called automatically when the cust_pay method is used in a scalar context.
4266 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
4267 my $sth = dbh->prepare($sql) or die dbh->errstr;
4268 $sth->execute($self->custnum) or die $sth->errstr;
4269 $sth->fetchrow_arrayref->[0];
4272 =item cust_pay_pkgnum
4274 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4275 package when using experimental package balances.
4279 sub cust_pay_pkgnum {
4280 my( $self, $pkgnum ) = @_;
4281 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4282 sort { $a->_date <=> $b->_date }
4283 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4284 'pkgnum' => $pkgnum,
4291 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4297 map { $_ } #return $self->num_cust_pay_void unless wantarray;
4298 sort { $a->_date <=> $b->_date }
4299 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4302 =item cust_pay_batch
4304 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
4308 sub cust_pay_batch {
4310 map { $_ } #return $self->num_cust_pay_batch unless wantarray;
4311 sort { $a->paybatchnum <=> $b->paybatchnum }
4312 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
4315 =item cust_pay_pending
4317 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4318 (without status "done").
4322 sub cust_pay_pending {
4324 return $self->num_cust_pay_pending unless wantarray;
4325 sort { $a->_date <=> $b->_date }
4326 qsearch( 'cust_pay_pending', {
4327 'custnum' => $self->custnum,
4328 'status' => { op=>'!=', value=>'done' },
4333 =item cust_pay_pending_attempt
4335 Returns all payment attempts / declined payments for this customer, as pending
4336 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4337 a corresponding payment (see L<FS::cust_pay>).
4341 sub cust_pay_pending_attempt {
4343 return $self->num_cust_pay_pending_attempt unless wantarray;
4344 sort { $a->_date <=> $b->_date }
4345 qsearch( 'cust_pay_pending', {
4346 'custnum' => $self->custnum,
4353 =item num_cust_pay_pending
4355 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4356 customer (without status "done"). Also called automatically when the
4357 cust_pay_pending method is used in a scalar context.
4361 sub num_cust_pay_pending {
4364 " SELECT COUNT(*) FROM cust_pay_pending ".
4365 " WHERE custnum = ? AND status != 'done' ",
4370 =item num_cust_pay_pending_attempt
4372 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4373 customer, with status "done" but without a corresp. Also called automatically when the
4374 cust_pay_pending method is used in a scalar context.
4378 sub num_cust_pay_pending_attempt {
4381 " SELECT COUNT(*) FROM cust_pay_pending ".
4382 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4389 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4395 map { $_ } #return $self->num_cust_refund unless wantarray;
4396 sort { $a->_date <=> $b->_date }
4397 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4400 =item display_custnum
4402 Returns the displayed customer number for this customer: agent_custid if
4403 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4407 sub display_custnum {
4409 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4410 return $self->agent_custid;
4412 return $self->custnum;
4418 Returns a name string for this customer, either "Company (Last, First)" or
4425 my $name = $self->contact;
4426 $name = $self->company. " ($name)" if $self->company;
4432 Returns a name string for this (service/shipping) contact, either
4433 "Company (Last, First)" or "Last, First".
4439 if ( $self->get('ship_last') ) {
4440 my $name = $self->ship_contact;
4441 $name = $self->ship_company. " ($name)" if $self->ship_company;
4450 Returns a name string for this customer, either "Company" or "First Last".
4456 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4459 =item ship_name_short
4461 Returns a name string for this (service/shipping) contact, either "Company"
4466 sub ship_name_short {
4468 if ( $self->get('ship_last') ) {
4469 $self->ship_company !~ /^\s*$/
4470 ? $self->ship_company
4471 : $self->ship_contact_firstlast;
4473 $self->name_company_or_firstlast;
4479 Returns this customer's full (billing) contact name only, "Last, First"
4485 $self->get('last'). ', '. $self->first;
4490 Returns this customer's full (shipping) contact name only, "Last, First"
4496 $self->get('ship_last')
4497 ? $self->get('ship_last'). ', '. $self->ship_first
4501 =item contact_firstlast
4503 Returns this customers full (billing) contact name only, "First Last".
4507 sub contact_firstlast {
4509 $self->first. ' '. $self->get('last');
4512 =item ship_contact_firstlast
4514 Returns this customer's full (shipping) contact name only, "First Last".
4518 sub ship_contact_firstlast {
4520 $self->get('ship_last')
4521 ? $self->first. ' '. $self->get('ship_last')
4522 : $self->contact_firstlast;
4527 Returns this customer's full country name
4533 code2country($self->country);
4536 =item geocode DATA_VENDOR
4538 Returns a value for the customer location as encoded by DATA_VENDOR.
4539 Currently this only makes sense for "CCH" as DATA_VENDOR.
4544 my ($self, $data_vendor) = (shift, shift); #always cch for now
4546 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
4547 return $geocode if $geocode;
4549 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
4553 my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
4554 if $self->country eq 'US';
4558 #CCH specific location stuff
4559 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
4561 my @cust_tax_location =
4563 'table' => 'cust_tax_location',
4564 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
4565 'extra_sql' => $extra_sql,
4566 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
4569 $geocode = $cust_tax_location[0]->geocode
4570 if scalar(@cust_tax_location);
4579 Returns a status string for this customer, currently:
4583 =item prospect - No packages have ever been ordered
4585 =item ordered - Recurring packages all are new (not yet billed).
4587 =item active - One or more recurring packages is active
4589 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4591 =item suspended - All non-cancelled recurring packages are suspended
4593 =item cancelled - All recurring packages are cancelled
4599 sub status { shift->cust_status(@_); }
4603 # prospect ordered active inactive suspended cancelled
4604 for my $status ( FS::cust_main->statuses() ) {
4605 my $method = $status.'_sql';
4606 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4607 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4608 $sth->execute( ($self->custnum) x $numnum )
4609 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4610 return $status if $sth->fetchrow_arrayref->[0];
4614 =item ucfirst_cust_status
4616 =item ucfirst_status
4618 Returns the status with the first character capitalized.
4622 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4624 sub ucfirst_cust_status {
4626 ucfirst($self->cust_status);
4631 Returns a hex triplet color string for this customer's status.
4635 use vars qw(%statuscolor);
4636 tie %statuscolor, 'Tie::IxHash',
4637 'prospect' => '7e0079', #'000000', #black? naw, purple
4638 'active' => '00CC00', #green
4639 'ordered' => '009999', #teal? cyan?
4640 'inactive' => '0000CC', #blue
4641 'suspended' => 'FF9900', #yellow
4642 'cancelled' => 'FF0000', #red
4645 sub statuscolor { shift->cust_statuscolor(@_); }
4647 sub cust_statuscolor {
4649 $statuscolor{$self->cust_status};
4654 Returns an array of hashes representing the customer's RT tickets.
4661 my $num = $conf->config('cust_main-max_tickets') || 10;
4664 if ( $conf->config('ticket_system') ) {
4665 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4667 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4671 foreach my $priority (
4672 $conf->config('ticket_system-custom_priority_field-values'), ''
4674 last if scalar(@tickets) >= $num;
4676 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4677 $num - scalar(@tickets),
4687 # Return services representing svc_accts in customer support packages
4688 sub support_services {
4690 my %packages = map { $_ => 1 } $conf->config('support_packages');
4692 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4693 grep { $_->part_svc->svcdb eq 'svc_acct' }
4694 map { $_->cust_svc }
4695 grep { exists $packages{ $_->pkgpart } }
4696 $self->ncancelled_pkgs;
4700 # Return a list of latitude/longitude for one of the services (if any)
4701 sub service_coordinates {
4705 grep { $_->latitude && $_->longitude }
4707 map { $_->cust_svc }
4708 $self->ncancelled_pkgs;
4710 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4715 Returns a masked version of the named field
4720 my ($self,$field) = @_;
4724 'x'x(length($self->getfield($field))-4).
4725 substr($self->getfield($field), (length($self->getfield($field))-4));
4731 =head1 CLASS METHODS
4737 Class method that returns the list of possible status strings for customers
4738 (see L<the status method|/status>). For example:
4740 @statuses = FS::cust_main->statuses();
4745 #my $self = shift; #could be class...
4751 Returns an SQL expression identifying prospective cust_main records (customers
4752 with no packages ever ordered)
4756 use vars qw($select_count_pkgs);
4757 $select_count_pkgs =
4758 "SELECT COUNT(*) FROM cust_pkg
4759 WHERE cust_pkg.custnum = cust_main.custnum";
4761 sub select_count_pkgs_sql {
4766 " 0 = ( $select_count_pkgs ) ";
4771 Returns an SQL expression identifying ordered cust_main records (customers with
4772 recurring packages not yet setup).
4777 FS::cust_main->none_active_sql.
4778 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
4783 Returns an SQL expression identifying active cust_main records (customers with
4784 active recurring packages).
4789 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4792 =item none_active_sql
4794 Returns an SQL expression identifying cust_main records with no active
4795 recurring packages. This includes customers of status prospect, ordered,
4796 inactive, and suspended.
4800 sub none_active_sql {
4801 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4806 Returns an SQL expression identifying inactive cust_main records (customers with
4807 no active recurring packages, but otherwise unsuspended/uncancelled).
4812 FS::cust_main->none_active_sql.
4813 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4819 Returns an SQL expression identifying suspended cust_main records.
4824 sub suspended_sql { susp_sql(@_); }
4826 FS::cust_main->none_active_sql.
4827 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4833 Returns an SQL expression identifying cancelled cust_main records.
4837 sub cancelled_sql { cancel_sql(@_); }
4840 my $recurring_sql = FS::cust_pkg->recurring_sql;
4841 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
4844 0 < ( $select_count_pkgs )
4845 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
4846 AND 0 = ( $select_count_pkgs AND $recurring_sql
4847 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4849 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4855 =item uncancelled_sql
4857 Returns an SQL expression identifying un-cancelled cust_main records.
4861 sub uncancelled_sql { uncancel_sql(@_); }
4862 sub uncancel_sql { "
4863 ( 0 < ( $select_count_pkgs
4864 AND ( cust_pkg.cancel IS NULL
4865 OR cust_pkg.cancel = 0
4868 OR 0 = ( $select_count_pkgs )
4874 Returns an SQL fragment to retreive the balance.
4879 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4880 WHERE cust_bill.custnum = cust_main.custnum )
4881 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4882 WHERE cust_pay.custnum = cust_main.custnum )
4883 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4884 WHERE cust_credit.custnum = cust_main.custnum )
4885 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4886 WHERE cust_refund.custnum = cust_main.custnum )
4889 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4891 Returns an SQL fragment to retreive the balance for this customer, optionally
4892 considering invoices with date earlier than START_TIME, and not
4893 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4894 total_unapplied_payments).
4896 Times are specified as SQL fragments or numeric
4897 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4898 L<Date::Parse> for conversion functions. The empty string can be passed
4899 to disable that time constraint completely.
4901 Available options are:
4905 =item unapplied_date
4907 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)
4912 set to true to remove all customer comparison clauses, for totals
4917 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4922 JOIN clause (typically used with the total option)
4926 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4927 time will be ignored. Note that START_TIME and END_TIME only limit the date
4928 range for invoices and I<unapplied> payments, credits, and refunds.
4934 sub balance_date_sql {
4935 my( $class, $start, $end, %opt ) = @_;
4937 my $cutoff = $opt{'cutoff'};
4939 my $owed = FS::cust_bill->owed_sql($cutoff);
4940 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4941 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4942 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4944 my $j = $opt{'join'} || '';
4946 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4947 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4948 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4949 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4951 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4952 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4953 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4954 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4959 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4961 Returns an SQL fragment to retreive the total unapplied payments for this
4962 customer, only considering invoices with date earlier than START_TIME, and
4963 optionally not later than END_TIME.
4965 Times are specified as SQL fragments or numeric
4966 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4967 L<Date::Parse> for conversion functions. The empty string can be passed
4968 to disable that time constraint completely.
4970 Available options are:
4974 sub unapplied_payments_date_sql {
4975 my( $class, $start, $end, %opt ) = @_;
4977 my $cutoff = $opt{'cutoff'};
4979 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4981 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4982 'unapplied_date'=>1 );
4984 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4987 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4989 Helper method for balance_date_sql; name (and usage) subject to change
4990 (suggestions welcome).
4992 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4993 cust_refund, cust_credit or cust_pay).
4995 If TABLE is "cust_bill" or the unapplied_date option is true, only
4996 considers records with date earlier than START_TIME, and optionally not
4997 later than END_TIME .
5001 sub _money_table_where {
5002 my( $class, $table, $start, $end, %opt ) = @_;
5005 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5006 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5007 push @where, "$table._date <= $start" if defined($start) && length($start);
5008 push @where, "$table._date > $end" if defined($end) && length($end);
5010 push @where, @{$opt{'where'}} if $opt{'where'};
5011 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5017 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5018 use FS::cust_main::Search;
5021 FS::cust_main::Search->search(@_);
5030 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
5034 sub append_fuzzyfiles {
5035 #my( $first, $last, $company ) = @_;
5037 &check_and_rebuild_fuzzyfiles;
5039 use Fcntl qw(:flock);
5041 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5043 foreach my $field (@fuzzyfields) {
5048 open(CACHE,">>$dir/cust_main.$field")
5049 or die "can't open $dir/cust_main.$field: $!";
5050 flock(CACHE,LOCK_EX)
5051 or die "can't lock $dir/cust_main.$field: $!";
5053 print CACHE "$value\n";
5055 flock(CACHE,LOCK_UN)
5056 or die "can't unlock $dir/cust_main.$field: $!";
5071 #warn join('-',keys %$param);
5072 my $fh = $param->{filehandle};
5073 my $agentnum = $param->{agentnum};
5074 my $format = $param->{format};
5076 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
5079 if ( $format eq 'simple' ) {
5080 @fields = qw( custnum agent_custid amount pkg );
5082 die "unknown format $format";
5085 eval "use Text::CSV_XS;";
5088 my $csv = new Text::CSV_XS;
5095 local $SIG{HUP} = 'IGNORE';
5096 local $SIG{INT} = 'IGNORE';
5097 local $SIG{QUIT} = 'IGNORE';
5098 local $SIG{TERM} = 'IGNORE';
5099 local $SIG{TSTP} = 'IGNORE';
5100 local $SIG{PIPE} = 'IGNORE';
5102 my $oldAutoCommit = $FS::UID::AutoCommit;
5103 local $FS::UID::AutoCommit = 0;
5106 #while ( $columns = $csv->getline($fh) ) {
5108 while ( defined($line=<$fh>) ) {
5110 $csv->parse($line) or do {
5111 $dbh->rollback if $oldAutoCommit;
5112 return "can't parse: ". $csv->error_input();
5115 my @columns = $csv->fields();
5116 #warn join('-',@columns);
5119 foreach my $field ( @fields ) {
5120 $row{$field} = shift @columns;
5123 if ( $row{custnum} && $row{agent_custid} ) {
5124 dbh->rollback if $oldAutoCommit;
5125 return "can't specify custnum with agent_custid $row{agent_custid}";
5129 if ( $row{agent_custid} && $agentnum ) {
5130 %hash = ( 'agent_custid' => $row{agent_custid},
5131 'agentnum' => $agentnum,
5135 if ( $row{custnum} ) {
5136 %hash = ( 'custnum' => $row{custnum} );
5139 unless ( scalar(keys %hash) ) {
5140 $dbh->rollback if $oldAutoCommit;
5141 return "can't find customer without custnum or agent_custid and agentnum";
5144 my $cust_main = qsearchs('cust_main', { %hash } );
5145 unless ( $cust_main ) {
5146 $dbh->rollback if $oldAutoCommit;
5147 my $custnum = $row{custnum} || $row{agent_custid};
5148 return "unknown custnum $custnum";
5151 if ( $row{'amount'} > 0 ) {
5152 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5154 $dbh->rollback if $oldAutoCommit;
5158 } elsif ( $row{'amount'} < 0 ) {
5159 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5162 $dbh->rollback if $oldAutoCommit;
5172 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5174 return "Empty file!" unless $imported;
5180 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5182 Deprecated. Use event notification and message templates
5183 (L<FS::msg_template>) instead.
5185 Sends a templated email notification to the customer (see L<Text::Template>).
5187 OPTIONS is a hash and may include
5189 I<from> - the email sender (default is invoice_from)
5191 I<to> - comma-separated scalar or arrayref of recipients
5192 (default is invoicing_list)
5194 I<subject> - The subject line of the sent email notification
5195 (default is "Notice from company_name")
5197 I<extra_fields> - a hashref of name/value pairs which will be substituted
5200 The following variables are vavailable in the template.
5202 I<$first> - the customer first name
5203 I<$last> - the customer last name
5204 I<$company> - the customer company
5205 I<$payby> - a description of the method of payment for the customer
5206 # would be nice to use FS::payby::shortname
5207 I<$payinfo> - the account information used to collect for this customer
5208 I<$expdate> - the expiration of the customer payment in seconds from epoch
5213 my ($self, $template, %options) = @_;
5215 return unless $conf->exists($template);
5217 my $from = $conf->config('invoice_from', $self->agentnum)
5218 if $conf->exists('invoice_from', $self->agentnum);
5219 $from = $options{from} if exists($options{from});
5221 my $to = join(',', $self->invoicing_list_emailonly);
5222 $to = $options{to} if exists($options{to});
5224 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5225 if $conf->exists('company_name', $self->agentnum);
5226 $subject = $options{subject} if exists($options{subject});
5228 my $notify_template = new Text::Template (TYPE => 'ARRAY',
5229 SOURCE => [ map "$_\n",
5230 $conf->config($template)]
5232 or die "can't create new Text::Template object: Text::Template::ERROR";
5233 $notify_template->compile()
5234 or die "can't compile template: Text::Template::ERROR";
5236 $FS::notify_template::_template::company_name =
5237 $conf->config('company_name', $self->agentnum);
5238 $FS::notify_template::_template::company_address =
5239 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5241 my $paydate = $self->paydate || '2037-12-31';
5242 $FS::notify_template::_template::first = $self->first;
5243 $FS::notify_template::_template::last = $self->last;
5244 $FS::notify_template::_template::company = $self->company;
5245 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5246 my $payby = $self->payby;
5247 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5248 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5250 #credit cards expire at the end of the month/year of their exp date
5251 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5252 $FS::notify_template::_template::payby = 'credit card';
5253 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5254 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5256 }elsif ($payby eq 'COMP') {
5257 $FS::notify_template::_template::payby = 'complimentary account';
5259 $FS::notify_template::_template::payby = 'current method';
5261 $FS::notify_template::_template::expdate = $expire_time;
5263 for (keys %{$options{extra_fields}}){
5265 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5268 send_email(from => $from,
5270 subject => $subject,
5271 body => $notify_template->fill_in( PACKAGE =>
5272 'FS::notify_template::_template' ),
5277 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5279 Generates a templated notification to the customer (see L<Text::Template>).
5281 OPTIONS is a hash and may include
5283 I<extra_fields> - a hashref of name/value pairs which will be substituted
5284 into the template. These values may override values mentioned below
5285 and those from the customer record.
5287 The following variables are available in the template instead of or in addition
5288 to the fields of the customer record.
5290 I<$payby> - a description of the method of payment for the customer
5291 # would be nice to use FS::payby::shortname
5292 I<$payinfo> - the masked account information used to collect for this customer
5293 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5294 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5298 # a lot like cust_bill::print_latex
5299 sub generate_letter {
5300 my ($self, $template, %options) = @_;
5302 return unless $conf->exists($template);
5304 my $letter_template = new Text::Template
5306 SOURCE => [ map "$_\n", $conf->config($template)],
5307 DELIMITERS => [ '[@--', '--@]' ],
5309 or die "can't create new Text::Template object: Text::Template::ERROR";
5311 $letter_template->compile()
5312 or die "can't compile template: Text::Template::ERROR";
5314 my %letter_data = map { $_ => $self->$_ } $self->fields;
5315 $letter_data{payinfo} = $self->mask_payinfo;
5317 #my $paydate = $self->paydate || '2037-12-31';
5318 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5320 my $payby = $self->payby;
5321 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5322 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5324 #credit cards expire at the end of the month/year of their exp date
5325 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5326 $letter_data{payby} = 'credit card';
5327 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5328 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5330 }elsif ($payby eq 'COMP') {
5331 $letter_data{payby} = 'complimentary account';
5333 $letter_data{payby} = 'current method';
5335 $letter_data{expdate} = $expire_time;
5337 for (keys %{$options{extra_fields}}){
5338 $letter_data{$_} = $options{extra_fields}->{$_};
5341 unless(exists($letter_data{returnaddress})){
5342 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5343 $self->agent_template)
5345 if ( length($retadd) ) {
5346 $letter_data{returnaddress} = $retadd;
5347 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5348 $letter_data{returnaddress} =
5349 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5353 ( $conf->config('company_name', $self->agentnum),
5354 $conf->config('company_address', $self->agentnum),
5358 $letter_data{returnaddress} = '~';
5362 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5364 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5366 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5368 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5372 ) or die "can't open temp file: $!\n";
5373 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5374 or die "can't write temp file: $!\n";
5376 $letter_data{'logo_file'} = $lh->filename;
5378 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5382 ) or die "can't open temp file: $!\n";
5384 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5386 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5387 return ($1, $letter_data{'logo_file'});
5391 =item print_ps TEMPLATE
5393 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5399 my($file, $lfile) = $self->generate_letter(@_);
5400 my $ps = FS::Misc::generate_ps($file);
5401 unlink($file.'.tex');
5407 =item print TEMPLATE
5409 Prints the filled in template.
5411 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5415 sub queueable_print {
5418 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5419 or die "invalid customer number: " . $opt{custvnum};
5421 my $error = $self->print( $opt{template} );
5422 die $error if $error;
5426 my ($self, $template) = (shift, shift);
5427 do_print [ $self->print_ps($template) ];
5430 #these three subs should just go away once agent stuff is all config overrides
5432 sub agent_template {
5434 $self->_agent_plandata('agent_templatename');
5437 sub agent_invoice_from {
5439 $self->_agent_plandata('agent_invoice_from');
5442 sub _agent_plandata {
5443 my( $self, $option ) = @_;
5445 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5446 #agent-specific Conf
5448 use FS::part_event::Condition;
5450 my $agentnum = $self->agentnum;
5452 my $regexp = regexp_sql();
5454 my $part_event_option =
5456 'select' => 'part_event_option.*',
5457 'table' => 'part_event_option',
5459 LEFT JOIN part_event USING ( eventpart )
5460 LEFT JOIN part_event_option AS peo_agentnum
5461 ON ( part_event.eventpart = peo_agentnum.eventpart
5462 AND peo_agentnum.optionname = 'agentnum'
5463 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5465 LEFT JOIN part_event_condition
5466 ON ( part_event.eventpart = part_event_condition.eventpart
5467 AND part_event_condition.conditionname = 'cust_bill_age'
5469 LEFT JOIN part_event_condition_option
5470 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5471 AND part_event_condition_option.optionname = 'age'
5474 #'hashref' => { 'optionname' => $option },
5475 #'hashref' => { 'part_event_option.optionname' => $option },
5477 " WHERE part_event_option.optionname = ". dbh->quote($option).
5478 " AND action = 'cust_bill_send_agent' ".
5479 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5480 " AND peo_agentnum.optionname = 'agentnum' ".
5481 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5483 CASE WHEN part_event_condition_option.optionname IS NULL
5485 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5487 , part_event.weight".
5491 unless ( $part_event_option ) {
5492 return $self->agent->invoice_template || ''
5493 if $option eq 'agent_templatename';
5497 $part_event_option->optionvalue;
5501 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5503 Subroutine (not a method), designed to be called from the queue.
5505 Takes a list of options and values.
5507 Pulls up the customer record via the custnum option and calls bill_and_collect.
5512 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5514 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5515 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5517 $cust_main->bill_and_collect( %args );
5520 sub process_bill_and_collect {
5522 my $param = thaw(decode_base64(shift));
5523 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5524 or die "custnum '$param->{custnum}' not found!\n";
5525 $param->{'job'} = $job;
5526 $param->{'fatal'} = 1; # runs from job queue, will be caught
5527 $param->{'retry'} = 1;
5529 $cust_main->bill_and_collect( %$param );
5532 sub _upgrade_data { #class method
5533 my ($class, %opts) = @_;
5535 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
5536 my $sth = dbh->prepare($sql) or die dbh->errstr;
5537 $sth->execute or die $sth->errstr;
5539 local($ignore_expired_card) = 1;
5540 local($skip_fuzzyfiles) = 1;
5541 $class->_upgrade_otaker(%opts);
5551 The delete method should possibly take an FS::cust_main object reference
5552 instead of a scalar customer number.
5554 Bill and collect options should probably be passed as references instead of a
5557 There should probably be a configuration file with a list of allowed credit
5560 No multiple currency support (probably a larger project than just this module).
5562 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5564 Birthdates rely on negative epoch values.
5566 The payby for card/check batches is broken. With mixed batching, bad
5569 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5573 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5574 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5575 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.