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
12 $ignore_expired_card $ignore_illegal_zip $ignore_banned_card
13 $skip_fuzzyfiles @fuzzyfields
16 use vars qw( $realtime_bop_decline_quiet ); #ugh
18 use Scalar::Util qw( blessed );
19 use List::Util qw( min );
20 use Time::Local qw(timelocal);
21 use Storable qw(thaw);
25 use Digest::MD5 qw(md5_base64);
28 use File::Temp qw( tempfile );
29 use Business::CreditCard 0.28;
31 use FS::UID qw( getotaker dbh driver_name );
32 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
33 use FS::Misc qw( generate_email send_email generate_ps do_print );
34 use FS::Msgcat qw(gettext);
41 use FS::cust_pay_pending;
42 use FS::cust_pay_void;
43 use FS::cust_pay_batch;
46 use FS::part_referral;
47 use FS::cust_main_county;
48 use FS::cust_location;
50 use FS::cust_main_exemption;
51 use FS::cust_tax_adjustment;
52 use FS::cust_tax_location;
54 use FS::cust_main_invoice;
56 use FS::prepay_credit;
60 use FS::part_event_condition;
64 use FS::payment_gateway;
65 use FS::agent_payment_gateway;
69 $realtime_bop_decline_quiet = 0; #move to Billing_Realtime
71 # 1 is mostly method/subroutine entry and options
72 # 2 traces progress of some operations
73 # 3 is even more information including possibly sensitive data
75 $me = '[FS::cust_main]';
78 $ignore_expired_card = 0;
79 $ignore_illegal_zip = 0;
80 $ignore_banned_card = 0;
83 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
85 @encrypted_fields = ('payinfo', 'paycvv');
86 sub nohistory_fields { ('payinfo', 'paycvv'); }
88 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
90 #ask FS::UID to run this stuff for us later
91 #$FS::UID::callback{'FS::cust_main'} = sub {
92 install_callback FS::UID sub {
94 #yes, need it for stuff below (prolly should be cached)
99 my ( $hashref, $cache ) = @_;
100 if ( exists $hashref->{'pkgnum'} ) {
101 #@{ $self->{'_pkgnum'} } = ();
102 my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
103 $self->{'_pkgnum'} = $subcache;
104 #push @{ $self->{'_pkgnum'} },
105 FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
111 FS::cust_main - Object methods for cust_main records
117 $record = new FS::cust_main \%hash;
118 $record = new FS::cust_main { 'column' => 'value' };
120 $error = $record->insert;
122 $error = $new_record->replace($old_record);
124 $error = $record->delete;
126 $error = $record->check;
128 @cust_pkg = $record->all_pkgs;
130 @cust_pkg = $record->ncancelled_pkgs;
132 @cust_pkg = $record->suspended_pkgs;
134 $error = $record->bill;
135 $error = $record->bill %options;
136 $error = $record->bill 'time' => $time;
138 $error = $record->collect;
139 $error = $record->collect %options;
140 $error = $record->collect 'invoice_time' => $time,
145 An FS::cust_main object represents a customer. FS::cust_main inherits from
146 FS::Record. The following fields are currently supported:
152 Primary key (assigned automatically for new customers)
156 Agent (see L<FS::agent>)
160 Advertising source (see L<FS::part_referral>)
172 Cocial security number (optional)
188 (optional, see L<FS::cust_main_county>)
192 (see L<FS::cust_main_county>)
198 (see L<FS::cust_main_county>)
234 (optional, see L<FS::cust_main_county>)
238 (see L<FS::cust_main_county>)
244 (see L<FS::cust_main_county>)
260 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
264 Payment Information (See L<FS::payinfo_Mixin> for data format)
268 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
272 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
276 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
280 Start date month (maestro/solo cards only)
284 Start date year (maestro/solo cards only)
288 Issue number (maestro/solo cards only)
292 Name on card or billing name
296 IP address from which payment information was received
300 Tax exempt, empty or `Y'
304 Order taker (see L<FS::access_user>)
310 =item referral_custnum
312 Referring customer number
316 Enable individual CDR spooling, empty or `Y'
320 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
324 Discourage individual CDR printing, empty or `Y'
334 Creates a new customer. To add the customer to the database, see L<"insert">.
336 Note that this stores the hash reference, not a distinct copy of the hash it
337 points to. You can ask the object for a copy with the I<hash> method.
341 sub table { 'cust_main'; }
343 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
345 Adds this customer to the database. If there is an error, returns the error,
346 otherwise returns false.
348 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
349 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
350 are inserted atomicly, or the transaction is rolled back. Passing an empty
351 hash reference is equivalent to not supplying this parameter. There should be
352 a better explanation of this, but until then, here's an example:
355 tie %hash, 'Tie::RefHash'; #this part is important
357 $cust_pkg => [ $svc_acct ],
360 $cust_main->insert( \%hash );
362 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
363 be set as the invoicing list (see L<"invoicing_list">). Errors return as
364 expected and rollback the entire transaction; it is not necessary to call
365 check_invoicing_list first. The invoicing_list is set after the records in the
366 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
367 invoicing_list destination to the newly-created svc_acct. Here's an example:
369 $cust_main->insert( {}, [ $email, 'POST' ] );
371 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
373 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
374 on the supplied jobnum (they will not run until the specific job completes).
375 This can be used to defer provisioning until some action completes (such
376 as running the customer's credit card successfully).
378 The I<noexport> option is deprecated. If I<noexport> is set true, no
379 provisioning jobs (exports) are scheduled. (You can schedule them later with
380 the B<reexport> method.)
382 The I<tax_exemption> option can be set to an arrayref of tax names.
383 FS::cust_main_exemption records will be created and inserted.
389 my $cust_pkgs = @_ ? shift : {};
390 my $invoicing_list = @_ ? shift : '';
392 warn "$me insert called with options ".
393 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
396 local $SIG{HUP} = 'IGNORE';
397 local $SIG{INT} = 'IGNORE';
398 local $SIG{QUIT} = 'IGNORE';
399 local $SIG{TERM} = 'IGNORE';
400 local $SIG{TSTP} = 'IGNORE';
401 local $SIG{PIPE} = 'IGNORE';
403 my $oldAutoCommit = $FS::UID::AutoCommit;
404 local $FS::UID::AutoCommit = 0;
407 my $prepay_identifier = '';
408 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
410 if ( $self->payby eq 'PREPAY' ) {
412 $self->payby('BILL');
413 $prepay_identifier = $self->payinfo;
416 warn " looking up prepaid card $prepay_identifier\n"
419 my $error = $self->get_prepay( $prepay_identifier,
420 'amount_ref' => \$amount,
421 'seconds_ref' => \$seconds,
422 'upbytes_ref' => \$upbytes,
423 'downbytes_ref' => \$downbytes,
424 'totalbytes_ref' => \$totalbytes,
427 $dbh->rollback if $oldAutoCommit;
428 #return "error applying prepaid card (transaction rolled back): $error";
432 $payby = 'PREP' if $amount;
434 } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
437 $self->payby('BILL');
438 $amount = $self->paid;
442 warn " inserting $self\n"
445 $self->signupdate(time) unless $self->signupdate;
447 $self->auto_agent_custid()
448 if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
450 my $error = $self->SUPER::insert;
452 $dbh->rollback if $oldAutoCommit;
453 #return "inserting cust_main record (transaction rolled back): $error";
457 warn " setting invoicing list\n"
460 if ( $invoicing_list ) {
461 $error = $self->check_invoicing_list( $invoicing_list );
463 $dbh->rollback if $oldAutoCommit;
464 #return "checking invoicing_list (transaction rolled back): $error";
467 $self->invoicing_list( $invoicing_list );
470 warn " setting customer tags\n"
473 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
474 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
475 'custnum' => $self->custnum };
476 my $error = $cust_tag->insert;
478 $dbh->rollback if $oldAutoCommit;
483 if ( $invoicing_list ) {
484 $error = $self->check_invoicing_list( $invoicing_list );
486 $dbh->rollback if $oldAutoCommit;
487 #return "checking invoicing_list (transaction rolled back): $error";
490 $self->invoicing_list( $invoicing_list );
494 warn " setting cust_main_exemption\n"
497 my $tax_exemption = delete $options{'tax_exemption'};
498 if ( $tax_exemption ) {
499 foreach my $taxname ( @$tax_exemption ) {
500 my $cust_main_exemption = new FS::cust_main_exemption {
501 'custnum' => $self->custnum,
502 'taxname' => $taxname,
504 my $error = $cust_main_exemption->insert;
506 $dbh->rollback if $oldAutoCommit;
507 return "inserting cust_main_exemption (transaction rolled back): $error";
512 if ( $conf->config('cust_main-skeleton_tables')
513 && $conf->config('cust_main-skeleton_custnum') ) {
515 warn " inserting skeleton records\n"
518 my $error = $self->start_copy_skel;
520 $dbh->rollback if $oldAutoCommit;
526 warn " ordering packages\n"
529 $error = $self->order_pkgs( $cust_pkgs,
531 'seconds_ref' => \$seconds,
532 'upbytes_ref' => \$upbytes,
533 'downbytes_ref' => \$downbytes,
534 'totalbytes_ref' => \$totalbytes,
537 $dbh->rollback if $oldAutoCommit;
542 $dbh->rollback if $oldAutoCommit;
543 return "No svc_acct record to apply pre-paid time";
545 if ( $upbytes || $downbytes || $totalbytes ) {
546 $dbh->rollback if $oldAutoCommit;
547 return "No svc_acct record to apply pre-paid data";
551 warn " inserting initial $payby payment of $amount\n"
553 $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
555 $dbh->rollback if $oldAutoCommit;
556 return "inserting payment (transaction rolled back): $error";
560 unless ( $import || $skip_fuzzyfiles ) {
561 warn " queueing fuzzyfiles update\n"
563 $error = $self->queue_fuzzyfiles_update;
565 $dbh->rollback if $oldAutoCommit;
566 return "updating fuzzy search cache: $error";
571 warn " exporting\n" if $DEBUG > 1;
573 my $export_args = $options{'export_args'} || [];
576 map qsearch( 'part_export', {exportnum=>$_} ),
577 $conf->config('cust_main-exports'); #, $agentnum
579 foreach my $part_export ( @part_export ) {
580 my $error = $part_export->export_insert($self, @$export_args);
582 $dbh->rollback if $oldAutoCommit;
583 return "exporting to ". $part_export->exporttype.
584 " (transaction rolled back): $error";
588 #foreach my $depend_jobnum ( @$depend_jobnums ) {
589 # warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
591 # foreach my $jobnum ( @jobnums ) {
592 # my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
593 # warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
595 # my $error = $queue->depend_insert($depend_jobnum);
597 # $dbh->rollback if $oldAutoCommit;
598 # return "error queuing job dependancy: $error";
605 #if ( exists $options{'jobnums'} ) {
606 # push @{ $options{'jobnums'} }, @jobnums;
609 warn " insert complete; committing transaction\n"
612 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
617 use File::CounterFile;
618 sub auto_agent_custid {
621 my $format = $conf->config('cust_main-auto_agent_custid');
623 if ( $format eq '1YMMXXXXXXXX' ) {
625 my $counter = new File::CounterFile 'cust_main.agent_custid';
628 my $ym = 100000000000 + time2str('%y%m00000000', time);
629 if ( $ym > $counter->value ) {
630 $counter->{'value'} = $agent_custid = $ym;
631 $counter->{'updated'} = 1;
633 $agent_custid = $counter->inc;
639 die "Unknown cust_main-auto_agent_custid format: $format";
642 $self->agent_custid($agent_custid);
646 sub start_copy_skel {
649 #'mg_user_preference' => {},
650 #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
651 #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
652 #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
653 #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
654 my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
657 _copy_skel( 'cust_main', #tablename
658 $conf->config('cust_main-skeleton_custnum'), #sourceid
659 $self->custnum, #destid
660 @tables, #child tables
664 #recursive subroutine, not a method
666 my( $table, $sourceid, $destid, %child_tables ) = @_;
669 if ( $table =~ /^(\w+)\.(\w+)$/ ) {
670 ( $table, $primary_key ) = ( $1, $2 );
672 my $dbdef_table = dbdef->table($table);
673 $primary_key = $dbdef_table->primary_key
674 or return "$table has no primary key".
675 " (or do you need to run dbdef-create?)";
678 warn " _copy_skel: $table.$primary_key $sourceid to $destid for ".
679 join (', ', keys %child_tables). "\n"
682 foreach my $child_table_def ( keys %child_tables ) {
686 if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
687 ( $child_table, $child_pkey ) = ( $1, $2 );
689 $child_table = $child_table_def;
691 $child_pkey = dbdef->table($child_table)->primary_key;
692 # or return "$table has no primary key".
693 # " (or do you need to run dbdef-create?)\n";
697 if ( keys %{ $child_tables{$child_table_def} } ) {
699 return "$child_table has no primary key".
700 " (run dbdef-create or try specifying it?)\n"
703 #false laziness w/Record::insert and only works on Pg
704 #refactor the proper last-inserted-id stuff out of Record::insert if this
705 # ever gets use for anything besides a quick kludge for one customer
706 my $default = dbdef->table($child_table)->column($child_pkey)->default;
707 $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
708 or return "can't parse $child_table.$child_pkey default value ".
709 " for sequence name: $default";
714 my @sel_columns = grep { $_ ne $primary_key }
715 dbdef->table($child_table)->columns;
716 my $sel_columns = join(', ', @sel_columns );
718 my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
719 my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
720 my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
722 my $sel_st = "SELECT $sel_columns FROM $child_table".
723 " WHERE $primary_key = $sourceid";
726 my $sel_sth = dbh->prepare( $sel_st )
727 or return dbh->errstr;
729 $sel_sth->execute or return $sel_sth->errstr;
731 while ( my $row = $sel_sth->fetchrow_hashref ) {
733 warn " selected row: ".
734 join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
738 "INSERT INTO $child_table $ins_columns VALUES $placeholders";
739 my $ins_sth =dbh->prepare($statement)
740 or return dbh->errstr;
741 my @param = ( $destid, map $row->{$_}, @ins_columns );
742 warn " $statement: [ ". join(', ', @param). " ]\n"
744 $ins_sth->execute( @param )
745 or return $ins_sth->errstr;
747 #next unless keys %{ $child_tables{$child_table} };
748 next unless $sequence;
750 #another section of that laziness
751 my $seq_sql = "SELECT currval('$sequence')";
752 my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
753 $seq_sth->execute or return $seq_sth->errstr;
754 my $insertid = $seq_sth->fetchrow_arrayref->[0];
756 # don't drink soap! recurse! recurse! okay!
758 _copy_skel( $child_table_def,
759 $row->{$child_pkey}, #sourceid
761 %{ $child_tables{$child_table_def} },
763 return $error if $error;
773 =item order_pkg HASHREF | OPTION => VALUE ...
775 Orders a single package.
777 Options may be passed as a list of key/value pairs or as a hash reference.
788 Optional FS::cust_location object
792 Optional arryaref of FS::svc_* service objects.
796 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
797 jobs will have a dependancy on the supplied job (they will not run until the
798 specific job completes). This can be used to defer provisioning until some
799 action completes (such as running the customer's credit card successfully).
803 Optional subject for a ticket created and attached to this customer
807 Optional queue name for ticket additions
815 my $opt = ref($_[0]) ? shift : { @_ };
817 warn "$me order_pkg called with options ".
818 join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
821 my $cust_pkg = $opt->{'cust_pkg'};
822 my $svcs = $opt->{'svcs'} || [];
824 my %svc_options = ();
825 $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
826 if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
828 my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
829 qw( ticket_subject ticket_queue );
831 local $SIG{HUP} = 'IGNORE';
832 local $SIG{INT} = 'IGNORE';
833 local $SIG{QUIT} = 'IGNORE';
834 local $SIG{TERM} = 'IGNORE';
835 local $SIG{TSTP} = 'IGNORE';
836 local $SIG{PIPE} = 'IGNORE';
838 my $oldAutoCommit = $FS::UID::AutoCommit;
839 local $FS::UID::AutoCommit = 0;
842 if ( $opt->{'cust_location'} &&
843 ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
844 my $error = $opt->{'cust_location'}->insert;
846 $dbh->rollback if $oldAutoCommit;
847 return "inserting cust_location (transaction rolled back): $error";
849 $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
852 $cust_pkg->custnum( $self->custnum );
854 my $error = $cust_pkg->insert( %insert_params );
856 $dbh->rollback if $oldAutoCommit;
857 return "inserting cust_pkg (transaction rolled back): $error";
860 foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
861 if ( $svc_something->svcnum ) {
862 my $old_cust_svc = $svc_something->cust_svc;
863 my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
864 $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
865 $error = $new_cust_svc->replace($old_cust_svc);
867 $svc_something->pkgnum( $cust_pkg->pkgnum );
868 if ( $svc_something->isa('FS::svc_acct') ) {
869 foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
870 qw( seconds upbytes downbytes totalbytes ) ) {
871 $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
872 ${ $opt->{$_.'_ref'} } = 0;
875 $error = $svc_something->insert(%svc_options);
878 $dbh->rollback if $oldAutoCommit;
879 return "inserting svc_ (transaction rolled back): $error";
883 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
888 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
889 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
891 Like the insert method on an existing record, this method orders multiple
892 packages and included services atomicaly. Pass a Tie::RefHash data structure
893 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
894 There should be a better explanation of this, but until then, here's an
898 tie %hash, 'Tie::RefHash'; #this part is important
900 $cust_pkg => [ $svc_acct ],
903 $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
905 Services can be new, in which case they are inserted, or existing unaudited
906 services, in which case they are linked to the newly-created package.
908 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
909 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
911 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
912 on the supplied jobnum (they will not run until the specific job completes).
913 This can be used to defer provisioning until some action completes (such
914 as running the customer's credit card successfully).
916 The I<noexport> option is deprecated. If I<noexport> is set true, no
917 provisioning jobs (exports) are scheduled. (You can schedule them later with
918 the B<reexport> method for each cust_pkg object. Using the B<reexport> method
919 on the cust_main object is not recommended, as existing services will also be
922 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
923 provided, the scalars (provided by references) will be incremented by the
924 values of the prepaid card.`
930 my $cust_pkgs = shift;
931 my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
933 $seconds_ref ||= $options{'seconds_ref'};
935 warn "$me order_pkgs called with options ".
936 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
939 local $SIG{HUP} = 'IGNORE';
940 local $SIG{INT} = 'IGNORE';
941 local $SIG{QUIT} = 'IGNORE';
942 local $SIG{TERM} = 'IGNORE';
943 local $SIG{TSTP} = 'IGNORE';
944 local $SIG{PIPE} = 'IGNORE';
946 my $oldAutoCommit = $FS::UID::AutoCommit;
947 local $FS::UID::AutoCommit = 0;
950 local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
952 foreach my $cust_pkg ( keys %$cust_pkgs ) {
954 my $error = $self->order_pkg(
955 'cust_pkg' => $cust_pkg,
956 'svcs' => $cust_pkgs->{$cust_pkg},
957 'seconds_ref' => $seconds_ref,
958 map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
963 $dbh->rollback if $oldAutoCommit;
969 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
973 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
975 Recharges this (existing) customer with the specified prepaid card (see
976 L<FS::prepay_credit>), specified either by I<identifier> or as an
977 FS::prepay_credit object. If there is an error, returns the error, otherwise
980 Optionally, five scalar references can be passed as well. They will have their
981 values filled in with the amount, number of seconds, and number of upload,
982 download, and total bytes applied by this prepaid card.
986 #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is
987 #the only place that uses these args
988 sub recharge_prepay {
989 my( $self, $prepay_credit, $amountref, $secondsref,
990 $upbytesref, $downbytesref, $totalbytesref ) = @_;
992 local $SIG{HUP} = 'IGNORE';
993 local $SIG{INT} = 'IGNORE';
994 local $SIG{QUIT} = 'IGNORE';
995 local $SIG{TERM} = 'IGNORE';
996 local $SIG{TSTP} = 'IGNORE';
997 local $SIG{PIPE} = 'IGNORE';
999 my $oldAutoCommit = $FS::UID::AutoCommit;
1000 local $FS::UID::AutoCommit = 0;
1003 my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
1005 my $error = $self->get_prepay( $prepay_credit,
1006 'amount_ref' => \$amount,
1007 'seconds_ref' => \$seconds,
1008 'upbytes_ref' => \$upbytes,
1009 'downbytes_ref' => \$downbytes,
1010 'totalbytes_ref' => \$totalbytes,
1012 || $self->increment_seconds($seconds)
1013 || $self->increment_upbytes($upbytes)
1014 || $self->increment_downbytes($downbytes)
1015 || $self->increment_totalbytes($totalbytes)
1016 || $self->insert_cust_pay_prepay( $amount,
1018 ? $prepay_credit->identifier
1023 $dbh->rollback if $oldAutoCommit;
1027 if ( defined($amountref) ) { $$amountref = $amount; }
1028 if ( defined($secondsref) ) { $$secondsref = $seconds; }
1029 if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
1030 if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
1031 if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
1033 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1038 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
1040 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
1041 specified either by I<identifier> or as an FS::prepay_credit object.
1043 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
1044 incremented by the values of the prepaid card.
1046 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
1047 check or set this customer's I<agentnum>.
1049 If there is an error, returns the error, otherwise returns false.
1055 my( $self, $prepay_credit, %opt ) = @_;
1057 local $SIG{HUP} = 'IGNORE';
1058 local $SIG{INT} = 'IGNORE';
1059 local $SIG{QUIT} = 'IGNORE';
1060 local $SIG{TERM} = 'IGNORE';
1061 local $SIG{TSTP} = 'IGNORE';
1062 local $SIG{PIPE} = 'IGNORE';
1064 my $oldAutoCommit = $FS::UID::AutoCommit;
1065 local $FS::UID::AutoCommit = 0;
1068 unless ( ref($prepay_credit) ) {
1070 my $identifier = $prepay_credit;
1072 $prepay_credit = qsearchs(
1074 { 'identifier' => $prepay_credit },
1079 unless ( $prepay_credit ) {
1080 $dbh->rollback if $oldAutoCommit;
1081 return "Invalid prepaid card: ". $identifier;
1086 if ( $prepay_credit->agentnum ) {
1087 if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1088 $dbh->rollback if $oldAutoCommit;
1089 return "prepaid card not valid for agent ". $self->agentnum;
1091 $self->agentnum($prepay_credit->agentnum);
1094 my $error = $prepay_credit->delete;
1096 $dbh->rollback if $oldAutoCommit;
1097 return "removing prepay_credit (transaction rolled back): $error";
1100 ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1101 for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1103 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1108 =item increment_upbytes SECONDS
1110 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1111 the specified number of upbytes. If there is an error, returns the error,
1112 otherwise returns false.
1116 sub increment_upbytes {
1117 _increment_column( shift, 'upbytes', @_);
1120 =item increment_downbytes SECONDS
1122 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1123 the specified number of downbytes. If there is an error, returns the error,
1124 otherwise returns false.
1128 sub increment_downbytes {
1129 _increment_column( shift, 'downbytes', @_);
1132 =item increment_totalbytes SECONDS
1134 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1135 the specified number of totalbytes. If there is an error, returns the error,
1136 otherwise returns false.
1140 sub increment_totalbytes {
1141 _increment_column( shift, 'totalbytes', @_);
1144 =item increment_seconds SECONDS
1146 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1147 the specified number of seconds. If there is an error, returns the error,
1148 otherwise returns false.
1152 sub increment_seconds {
1153 _increment_column( shift, 'seconds', @_);
1156 =item _increment_column AMOUNT
1158 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1159 the specified number of seconds or bytes. If there is an error, returns
1160 the error, otherwise returns false.
1164 sub _increment_column {
1165 my( $self, $column, $amount ) = @_;
1166 warn "$me increment_column called: $column, $amount\n"
1169 return '' unless $amount;
1171 my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1172 $self->ncancelled_pkgs;
1174 if ( ! @cust_pkg ) {
1175 return 'No packages with primary or single services found'.
1176 ' to apply pre-paid time';
1177 } elsif ( scalar(@cust_pkg) > 1 ) {
1178 #maybe have a way to specify the package/account?
1179 return 'Multiple packages found to apply pre-paid time';
1182 my $cust_pkg = $cust_pkg[0];
1183 warn " found package pkgnum ". $cust_pkg->pkgnum. "\n"
1187 $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1189 if ( ! @cust_svc ) {
1190 return 'No account found to apply pre-paid time';
1191 } elsif ( scalar(@cust_svc) > 1 ) {
1192 return 'Multiple accounts found to apply pre-paid time';
1195 my $svc_acct = $cust_svc[0]->svc_x;
1196 warn " found service svcnum ". $svc_acct->pkgnum.
1197 ' ('. $svc_acct->email. ")\n"
1200 $column = "increment_$column";
1201 $svc_acct->$column($amount);
1205 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1207 Inserts a prepayment in the specified amount for this customer. An optional
1208 second argument can specify the prepayment identifier for tracking purposes.
1209 If there is an error, returns the error, otherwise returns false.
1213 sub insert_cust_pay_prepay {
1214 shift->insert_cust_pay('PREP', @_);
1217 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1219 Inserts a cash payment in the specified amount for this customer. An optional
1220 second argument can specify the payment identifier for tracking purposes.
1221 If there is an error, returns the error, otherwise returns false.
1225 sub insert_cust_pay_cash {
1226 shift->insert_cust_pay('CASH', @_);
1229 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1231 Inserts a Western Union payment in the specified amount for this customer. An
1232 optional second argument can specify the prepayment identifier for tracking
1233 purposes. If there is an error, returns the error, otherwise returns false.
1237 sub insert_cust_pay_west {
1238 shift->insert_cust_pay('WEST', @_);
1241 sub insert_cust_pay {
1242 my( $self, $payby, $amount ) = splice(@_, 0, 3);
1243 my $payinfo = scalar(@_) ? shift : '';
1245 my $cust_pay = new FS::cust_pay {
1246 'custnum' => $self->custnum,
1247 'paid' => sprintf('%.2f', $amount),
1248 #'_date' => #date the prepaid card was purchased???
1250 'payinfo' => $payinfo,
1258 This method is deprecated. See the I<depend_jobnum> option to the insert and
1259 order_pkgs methods for a better way to defer provisioning.
1261 Re-schedules all exports by calling the B<reexport> method of all associated
1262 packages (see L<FS::cust_pkg>). If there is an error, returns the error;
1263 otherwise returns false.
1270 carp "WARNING: FS::cust_main::reexport is deprectated; ".
1271 "use the depend_jobnum option to insert or order_pkgs to delay export";
1273 local $SIG{HUP} = 'IGNORE';
1274 local $SIG{INT} = 'IGNORE';
1275 local $SIG{QUIT} = 'IGNORE';
1276 local $SIG{TERM} = 'IGNORE';
1277 local $SIG{TSTP} = 'IGNORE';
1278 local $SIG{PIPE} = 'IGNORE';
1280 my $oldAutoCommit = $FS::UID::AutoCommit;
1281 local $FS::UID::AutoCommit = 0;
1284 foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1285 my $error = $cust_pkg->reexport;
1287 $dbh->rollback if $oldAutoCommit;
1292 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1297 =item delete [ OPTION => VALUE ... ]
1299 This deletes the customer. If there is an error, returns the error, otherwise
1302 This will completely remove all traces of the customer record. This is not
1303 what you want when a customer cancels service; for that, cancel all of the
1304 customer's packages (see L</cancel>).
1306 If the customer has any uncancelled packages, you need to pass a new (valid)
1307 customer number for those packages to be transferred to, as the "new_customer"
1308 option. Cancelled packages will be deleted. Did I mention that this is NOT
1309 what you want when a customer cancels service and that you really should be
1310 looking at L<FS::cust_pkg/cancel>?
1312 You can't delete a customer with invoices (see L<FS::cust_bill>),
1313 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1314 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1315 set the "delete_financials" option to a true value.
1320 my( $self, %opt ) = @_;
1322 local $SIG{HUP} = 'IGNORE';
1323 local $SIG{INT} = 'IGNORE';
1324 local $SIG{QUIT} = 'IGNORE';
1325 local $SIG{TERM} = 'IGNORE';
1326 local $SIG{TSTP} = 'IGNORE';
1327 local $SIG{PIPE} = 'IGNORE';
1329 my $oldAutoCommit = $FS::UID::AutoCommit;
1330 local $FS::UID::AutoCommit = 0;
1333 if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1334 $dbh->rollback if $oldAutoCommit;
1335 return "Can't delete a master agent customer";
1338 #use FS::access_user
1339 if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1340 $dbh->rollback if $oldAutoCommit;
1341 return "Can't delete a master employee customer";
1344 tie my %financial_tables, 'Tie::IxHash',
1345 'cust_bill' => 'invoices',
1346 'cust_statement' => 'statements',
1347 'cust_credit' => 'credits',
1348 'cust_pay' => 'payments',
1349 'cust_refund' => 'refunds',
1352 foreach my $table ( keys %financial_tables ) {
1354 my @records = $self->$table();
1356 if ( @records && ! $opt{'delete_financials'} ) {
1357 $dbh->rollback if $oldAutoCommit;
1358 return "Can't delete a customer with ". $financial_tables{$table};
1361 foreach my $record ( @records ) {
1362 my $error = $record->delete;
1364 $dbh->rollback if $oldAutoCommit;
1365 return "Error deleting ". $financial_tables{$table}. ": $error\n";
1371 my @cust_pkg = $self->ncancelled_pkgs;
1373 my $new_custnum = $opt{'new_custnum'};
1374 unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1375 $dbh->rollback if $oldAutoCommit;
1376 return "Invalid new customer number: $new_custnum";
1378 foreach my $cust_pkg ( @cust_pkg ) {
1379 my %hash = $cust_pkg->hash;
1380 $hash{'custnum'} = $new_custnum;
1381 my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1382 my $error = $new_cust_pkg->replace($cust_pkg,
1383 options => { $cust_pkg->options },
1386 $dbh->rollback if $oldAutoCommit;
1391 my @cancelled_cust_pkg = $self->all_pkgs;
1392 foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1393 my $error = $cust_pkg->delete;
1395 $dbh->rollback if $oldAutoCommit;
1400 #cust_tax_adjustment in financials?
1401 #cust_pay_pending? ouch
1403 foreach my $table (qw(
1404 cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1405 cust_location cust_main_note cust_tax_adjustment
1406 cust_pay_void cust_pay_batch queue cust_tax_exempt
1408 foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1409 my $error = $record->delete;
1411 $dbh->rollback if $oldAutoCommit;
1417 my $sth = $dbh->prepare(
1418 'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1420 my $errstr = $dbh->errstr;
1421 $dbh->rollback if $oldAutoCommit;
1424 $sth->execute($self->custnum) or do {
1425 my $errstr = $sth->errstr;
1426 $dbh->rollback if $oldAutoCommit;
1432 my $ticket_dbh = '';
1433 if ($conf->config('ticket_system') eq 'RT_Internal') {
1435 } elsif ($conf->config('ticket_system') eq 'RT_External') {
1436 my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1437 $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1438 #or die "RT_External DBI->connect error: $DBI::errstr\n";
1441 if ( $ticket_dbh ) {
1443 my $ticket_sth = $ticket_dbh->prepare(
1444 'DELETE FROM Links WHERE Target = ?'
1446 my $errstr = $ticket_dbh->errstr;
1447 $dbh->rollback if $oldAutoCommit;
1450 $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1452 my $errstr = $ticket_sth->errstr;
1453 $dbh->rollback if $oldAutoCommit;
1457 #check and see if the customer is the only link on the ticket, and
1458 #if so, set the ticket to deleted status in RT?
1459 #maybe someday, for now this will at least fix tickets not displaying
1463 #delete the customer record
1465 my $error = $self->SUPER::delete;
1467 $dbh->rollback if $oldAutoCommit;
1471 # cust_main exports!
1473 #my $export_args = $options{'export_args'} || [];
1476 map qsearch( 'part_export', {exportnum=>$_} ),
1477 $conf->config('cust_main-exports'); #, $agentnum
1479 foreach my $part_export ( @part_export ) {
1480 my $error = $part_export->export_delete( $self ); #, @$export_args);
1482 $dbh->rollback if $oldAutoCommit;
1483 return "exporting to ". $part_export->exporttype.
1484 " (transaction rolled back): $error";
1488 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1493 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1496 Replaces the OLD_RECORD with this one in the database. If there is an error,
1497 returns the error, otherwise returns false.
1499 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1500 be set as the invoicing list (see L<"invoicing_list">). Errors return as
1501 expected and rollback the entire transaction; it is not necessary to call
1502 check_invoicing_list first. Here's an example:
1504 $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1506 Currently available options are: I<tax_exemption>.
1508 The I<tax_exemption> option can be set to an arrayref of tax names.
1509 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1516 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1518 : $self->replace_old;
1522 warn "$me replace called\n"
1525 my $curuser = $FS::CurrentUser::CurrentUser;
1526 if ( $self->payby eq 'COMP'
1527 && $self->payby ne $old->payby
1528 && ! $curuser->access_right('Complimentary customer')
1531 return "You are not permitted to create complimentary accounts.";
1534 local($ignore_expired_card) = 1
1535 if $old->payby =~ /^(CARD|DCRD)$/
1536 && $self->payby =~ /^(CARD|DCRD)$/
1537 && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1539 local $SIG{HUP} = 'IGNORE';
1540 local $SIG{INT} = 'IGNORE';
1541 local $SIG{QUIT} = 'IGNORE';
1542 local $SIG{TERM} = 'IGNORE';
1543 local $SIG{TSTP} = 'IGNORE';
1544 local $SIG{PIPE} = 'IGNORE';
1546 my $oldAutoCommit = $FS::UID::AutoCommit;
1547 local $FS::UID::AutoCommit = 0;
1550 my $error = $self->SUPER::replace($old);
1553 $dbh->rollback if $oldAutoCommit;
1557 if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1558 my $invoicing_list = shift @param;
1559 $error = $self->check_invoicing_list( $invoicing_list );
1561 $dbh->rollback if $oldAutoCommit;
1564 $self->invoicing_list( $invoicing_list );
1567 if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1569 #this could be more efficient than deleting and re-inserting, if it matters
1570 foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1571 my $error = $cust_tag->delete;
1573 $dbh->rollback if $oldAutoCommit;
1577 foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1578 my $cust_tag = new FS::cust_tag { 'tagnum' => $tagnum,
1579 'custnum' => $self->custnum };
1580 my $error = $cust_tag->insert;
1582 $dbh->rollback if $oldAutoCommit;
1589 my %options = @param;
1591 my $tax_exemption = delete $options{'tax_exemption'};
1592 if ( $tax_exemption ) {
1594 my %cust_main_exemption =
1595 map { $_->taxname => $_ }
1596 qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1598 foreach my $taxname ( @$tax_exemption ) {
1600 next if delete $cust_main_exemption{$taxname};
1602 my $cust_main_exemption = new FS::cust_main_exemption {
1603 'custnum' => $self->custnum,
1604 'taxname' => $taxname,
1606 my $error = $cust_main_exemption->insert;
1608 $dbh->rollback if $oldAutoCommit;
1609 return "inserting cust_main_exemption (transaction rolled back): $error";
1613 foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1614 my $error = $cust_main_exemption->delete;
1616 $dbh->rollback if $oldAutoCommit;
1617 return "deleting cust_main_exemption (transaction rolled back): $error";
1623 if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1624 && ( ( $self->get('payinfo') ne $old->get('payinfo')
1625 && $self->get('payinfo') !~ /^99\d{14}$/
1627 || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1632 # card/check/lec info has changed, want to retry realtime_ invoice events
1633 my $error = $self->retry_realtime;
1635 $dbh->rollback if $oldAutoCommit;
1640 unless ( $import || $skip_fuzzyfiles ) {
1641 $error = $self->queue_fuzzyfiles_update;
1643 $dbh->rollback if $oldAutoCommit;
1644 return "updating fuzzy search cache: $error";
1648 # cust_main exports!
1650 my $export_args = $options{'export_args'} || [];
1653 map qsearch( 'part_export', {exportnum=>$_} ),
1654 $conf->config('cust_main-exports'); #, $agentnum
1656 foreach my $part_export ( @part_export ) {
1657 my $error = $part_export->export_replace( $self, $old, @$export_args);
1659 $dbh->rollback if $oldAutoCommit;
1660 return "exporting to ". $part_export->exporttype.
1661 " (transaction rolled back): $error";
1665 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1670 =item queue_fuzzyfiles_update
1672 Used by insert & replace to update the fuzzy search cache
1676 sub queue_fuzzyfiles_update {
1679 local $SIG{HUP} = 'IGNORE';
1680 local $SIG{INT} = 'IGNORE';
1681 local $SIG{QUIT} = 'IGNORE';
1682 local $SIG{TERM} = 'IGNORE';
1683 local $SIG{TSTP} = 'IGNORE';
1684 local $SIG{PIPE} = 'IGNORE';
1686 my $oldAutoCommit = $FS::UID::AutoCommit;
1687 local $FS::UID::AutoCommit = 0;
1690 my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1691 my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1693 $dbh->rollback if $oldAutoCommit;
1694 return "queueing job (transaction rolled back): $error";
1697 if ( $self->ship_last ) {
1698 $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1699 $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1701 $dbh->rollback if $oldAutoCommit;
1702 return "queueing job (transaction rolled back): $error";
1706 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1713 Checks all fields to make sure this is a valid customer record. If there is
1714 an error, returns the error, otherwise returns false. Called by the insert
1715 and replace methods.
1722 warn "$me check BEFORE: \n". $self->_dump
1726 $self->ut_numbern('custnum')
1727 || $self->ut_number('agentnum')
1728 || $self->ut_textn('agent_custid')
1729 || $self->ut_number('refnum')
1730 || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1731 || $self->ut_textn('custbatch')
1732 || $self->ut_name('last')
1733 || $self->ut_name('first')
1734 || $self->ut_snumbern('birthdate')
1735 || $self->ut_snumbern('signupdate')
1736 || $self->ut_textn('company')
1737 || $self->ut_text('address1')
1738 || $self->ut_textn('address2')
1739 || $self->ut_text('city')
1740 || $self->ut_textn('county')
1741 || $self->ut_textn('state')
1742 || $self->ut_country('country')
1743 || $self->ut_anything('comments')
1744 || $self->ut_numbern('referral_custnum')
1745 || $self->ut_textn('stateid')
1746 || $self->ut_textn('stateid_state')
1747 || $self->ut_textn('invoice_terms')
1748 || $self->ut_alphan('geocode')
1749 || $self->ut_floatn('cdr_termination_percentage')
1752 #barf. need message catalogs. i18n. etc.
1753 $error .= "Please select an advertising source."
1754 if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1755 return $error if $error;
1757 return "Unknown agent"
1758 unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1760 return "Unknown refnum"
1761 unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1763 return "Unknown referring custnum: ". $self->referral_custnum
1764 unless ! $self->referral_custnum
1765 || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1767 if ( $self->censustract ne '' ) {
1768 $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1769 or return "Illegal census tract: ". $self->censustract;
1771 $self->censustract("$1.$2");
1774 if ( $self->ss eq '' ) {
1779 $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1780 or return "Illegal social security number: ". $self->ss;
1781 $self->ss("$1-$2-$3");
1785 # bad idea to disable, causes billing to fail because of no tax rates later
1786 # except we don't fail any more
1787 unless ( $import ) {
1788 unless ( qsearch('cust_main_county', {
1789 'country' => $self->country,
1792 return "Unknown state/county/country: ".
1793 $self->state. "/". $self->county. "/". $self->country
1794 unless qsearch('cust_main_county',{
1795 'state' => $self->state,
1796 'county' => $self->county,
1797 'country' => $self->country,
1803 $self->ut_phonen('daytime', $self->country)
1804 || $self->ut_phonen('night', $self->country)
1805 || $self->ut_phonen('fax', $self->country)
1807 return $error if $error;
1809 unless ( $ignore_illegal_zip ) {
1810 $error = $self->ut_zip('zip', $self->country);
1811 return $error if $error;
1814 if ( $conf->exists('cust_main-require_phone')
1815 && ! length($self->daytime) && ! length($self->night)
1818 my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1820 : FS::Msgcat::_gettext('daytime');
1821 my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1823 : FS::Msgcat::_gettext('night');
1825 return "$daytime_label or $night_label is required"
1829 if ( $self->has_ship_address
1830 && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1831 $self->addr_fields )
1835 $self->ut_name('ship_last')
1836 || $self->ut_name('ship_first')
1837 || $self->ut_textn('ship_company')
1838 || $self->ut_text('ship_address1')
1839 || $self->ut_textn('ship_address2')
1840 || $self->ut_text('ship_city')
1841 || $self->ut_textn('ship_county')
1842 || $self->ut_textn('ship_state')
1843 || $self->ut_country('ship_country')
1845 return $error if $error;
1847 #false laziness with above
1848 unless ( qsearchs('cust_main_county', {
1849 'country' => $self->ship_country,
1852 return "Unknown ship_state/ship_county/ship_country: ".
1853 $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1854 unless qsearch('cust_main_county',{
1855 'state' => $self->ship_state,
1856 'county' => $self->ship_county,
1857 'country' => $self->ship_country,
1863 $self->ut_phonen('ship_daytime', $self->ship_country)
1864 || $self->ut_phonen('ship_night', $self->ship_country)
1865 || $self->ut_phonen('ship_fax', $self->ship_country)
1867 return $error if $error;
1869 unless ( $ignore_illegal_zip ) {
1870 $error = $self->ut_zip('ship_zip', $self->ship_country);
1871 return $error if $error;
1873 return "Unit # is required."
1874 if $self->ship_address2 =~ /^\s*$/
1875 && $conf->exists('cust_main-require_address2');
1877 } else { # ship_ info eq billing info, so don't store dup info in database
1879 $self->setfield("ship_$_", '')
1880 foreach $self->addr_fields;
1882 return "Unit # is required."
1883 if $self->address2 =~ /^\s*$/
1884 && $conf->exists('cust_main-require_address2');
1888 #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1889 # or return "Illegal payby: ". $self->payby;
1891 FS::payby->can_payby($self->table, $self->payby)
1892 or return "Illegal payby: ". $self->payby;
1894 $error = $self->ut_numbern('paystart_month')
1895 || $self->ut_numbern('paystart_year')
1896 || $self->ut_numbern('payissue')
1897 || $self->ut_textn('paytype')
1899 return $error if $error;
1901 if ( $self->payip eq '' ) {
1904 $error = $self->ut_ip('payip');
1905 return $error if $error;
1908 # If it is encrypted and the private key is not availaible then we can't
1909 # check the credit card.
1910 my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1912 if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1914 my $payinfo = $self->payinfo;
1915 $payinfo =~ s/\D//g;
1916 $payinfo =~ /^(\d{13,16})$/
1917 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1919 $self->payinfo($payinfo);
1921 or return gettext('invalid_card'); # . ": ". $self->payinfo;
1923 return gettext('unknown_card_type')
1924 if $self->payinfo !~ /^99\d{14}$/ #token
1925 && cardtype($self->payinfo) eq "Unknown";
1927 unless ( $ignore_banned_card ) {
1928 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1930 return 'Banned credit card: banned on '.
1931 time2str('%a %h %o at %r', $ban->_date).
1932 ' by '. $ban->otaker.
1933 ' (ban# '. $ban->bannum. ')';
1937 if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1938 if ( cardtype($self->payinfo) eq 'American Express card' ) {
1939 $self->paycvv =~ /^(\d{4})$/
1940 or return "CVV2 (CID) for American Express cards is four digits.";
1943 $self->paycvv =~ /^(\d{3})$/
1944 or return "CVV2 (CVC2/CID) is three digits.";
1951 my $cardtype = cardtype($payinfo);
1952 if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1954 return "Start date or issue number is required for $cardtype cards"
1955 unless $self->paystart_month && $self->paystart_year or $self->payissue;
1957 return "Start month must be between 1 and 12"
1958 if $self->paystart_month
1959 and $self->paystart_month < 1 || $self->paystart_month > 12;
1961 return "Start year must be 1990 or later"
1962 if $self->paystart_year
1963 and $self->paystart_year < 1990;
1965 return "Issue number must be beween 1 and 99"
1967 and $self->payissue < 1 || $self->payissue > 99;
1970 $self->paystart_month('');
1971 $self->paystart_year('');
1972 $self->payissue('');
1975 } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1977 my $payinfo = $self->payinfo;
1978 $payinfo =~ s/[^\d\@]//g;
1979 if ( $conf->exists('echeck-nonus') ) {
1980 $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1981 $payinfo = "$1\@$2";
1983 $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1984 $payinfo = "$1\@$2";
1986 $self->payinfo($payinfo);
1989 my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1991 return 'Banned ACH account: banned on '.
1992 time2str('%a %h %o at %r', $ban->_date).
1993 ' by '. $ban->otaker.
1994 ' (ban# '. $ban->bannum. ')';
1997 } elsif ( $self->payby eq 'LECB' ) {
1999 my $payinfo = $self->payinfo;
2000 $payinfo =~ s/\D//g;
2001 $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
2003 $self->payinfo($payinfo);
2006 } elsif ( $self->payby eq 'BILL' ) {
2008 $error = $self->ut_textn('payinfo');
2009 return "Illegal P.O. number: ". $self->payinfo if $error;
2012 } elsif ( $self->payby eq 'COMP' ) {
2014 my $curuser = $FS::CurrentUser::CurrentUser;
2015 if ( ! $self->custnum
2016 && ! $curuser->access_right('Complimentary customer')
2019 return "You are not permitted to create complimentary accounts."
2022 $error = $self->ut_textn('payinfo');
2023 return "Illegal comp account issuer: ". $self->payinfo if $error;
2026 } elsif ( $self->payby eq 'PREPAY' ) {
2028 my $payinfo = $self->payinfo;
2029 $payinfo =~ s/\W//g; #anything else would just confuse things
2030 $self->payinfo($payinfo);
2031 $error = $self->ut_alpha('payinfo');
2032 return "Illegal prepayment identifier: ". $self->payinfo if $error;
2033 return "Unknown prepayment identifier"
2034 unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2039 if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2040 return "Expiration date required"
2041 unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2045 if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2046 ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2047 } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2048 ( $m, $y ) = ( $2, "19$1" );
2049 } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2050 ( $m, $y ) = ( $3, "20$2" );
2052 return "Illegal expiration date: ". $self->paydate;
2054 $self->paydate("$y-$m-01");
2055 my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2056 return gettext('expired_card')
2058 && !$ignore_expired_card
2059 && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2062 if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2063 ( ! $conf->exists('require_cardname')
2064 || $self->payby !~ /^(CARD|DCRD)$/ )
2066 $self->payname( $self->first. " ". $self->getfield('last') );
2068 $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2069 or return gettext('illegal_name'). " payname: ". $self->payname;
2073 foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2074 $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2078 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2080 warn "$me check AFTER: \n". $self->_dump
2083 $self->SUPER::check;
2088 Returns a list of fields which have ship_ duplicates.
2093 qw( last first company
2094 address1 address2 city county state zip country
2099 =item has_ship_address
2101 Returns true if this customer record has a separate shipping address.
2105 sub has_ship_address {
2107 scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2112 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2113 city, county, state, zip, country. The shipping address is used if present.
2117 #geocode? dependent on tax-ship_address config, not available in cust_location
2118 #mostly. not yet then.
2122 my $prefix = $self->has_ship_address ? 'ship_' : '';
2124 map { $_ => $self->get($prefix.$_) }
2125 qw( address1 address2 city county state zip country geocode );
2126 #fields that cust_location has
2129 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2131 Returns all packages (see L<FS::cust_pkg>) for this customer.
2137 my $extra_qsearch = ref($_[0]) ? shift : {};
2139 return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
2142 if ( $self->{'_pkgnum'} ) {
2143 @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
2145 @cust_pkg = $self->_cust_pkg($extra_qsearch);
2148 sort sort_packages @cust_pkg;
2153 Synonym for B<all_pkgs>.
2158 shift->all_pkgs(@_);
2163 Returns all locations (see L<FS::cust_location>) for this customer.
2169 qsearch('cust_location', { 'custnum' => $self->custnum } );
2172 =item location_label [ OPTION => VALUE ... ]
2174 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
2182 used to separate the address elements (defaults to ', ')
2184 =item escape_function
2186 a callback used for escaping the text of the address elements
2192 # false laziness with FS::cust_location::line
2194 sub location_label {
2198 my $separator = $opt{join_string} || ', ';
2199 my $escape = $opt{escape_function} || sub{ shift };
2201 my $cydefault = FS::conf->new->config('countrydefault') || 'US';
2202 my $prefix = length($self->ship_last) ? 'ship_' : '';
2205 foreach (qw ( address1 address2 ) ) {
2206 my $method = "$prefix$_";
2207 $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
2212 foreach (qw ( city county state zip ) ) {
2213 my $method = "$prefix$_";
2214 if ( $self->$method ) {
2215 $line .= ' (' if $method eq 'county';
2216 $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
2217 $line .= ' )' if $method eq 'county';
2221 $line .= $separator. &$escape(code2country($self->country))
2222 if $self->country ne $cydefault;
2227 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2229 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
2233 sub ncancelled_pkgs {
2235 my $extra_qsearch = ref($_[0]) ? shift : {};
2237 return $self->num_ncancelled_pkgs unless wantarray;
2240 if ( $self->{'_pkgnum'} ) {
2242 warn "$me ncancelled_pkgs: returning cached objects"
2245 @cust_pkg = grep { ! $_->getfield('cancel') }
2246 values %{ $self->{'_pkgnum'}->cache };
2250 warn "$me ncancelled_pkgs: searching for packages with custnum ".
2251 $self->custnum. "\n"
2254 $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2256 @cust_pkg = $self->_cust_pkg($extra_qsearch);
2260 sort sort_packages @cust_pkg;
2266 my $extra_qsearch = ref($_[0]) ? shift : {};
2268 $extra_qsearch->{'select'} ||= '*';
2269 $extra_qsearch->{'select'} .=
2270 ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2274 $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2279 'table' => 'cust_pkg',
2280 'hashref' => { 'custnum' => $self->custnum },
2285 # This should be generalized to use config options to determine order.
2288 my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
2289 return $locationsort if $locationsort;
2291 if ( $a->get('cancel') xor $b->get('cancel') ) {
2292 return -1 if $b->get('cancel');
2293 return 1 if $a->get('cancel');
2294 #shouldn't get here...
2297 my $a_num_cust_svc = $a->num_cust_svc;
2298 my $b_num_cust_svc = $b->num_cust_svc;
2299 return 0 if !$a_num_cust_svc && !$b_num_cust_svc;
2300 return -1 if $a_num_cust_svc && !$b_num_cust_svc;
2301 return 1 if !$a_num_cust_svc && $b_num_cust_svc;
2302 my @a_cust_svc = $a->cust_svc;
2303 my @b_cust_svc = $b->cust_svc;
2304 return 0 if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2305 return -1 if scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2306 return 1 if !scalar(@a_cust_svc) && scalar(@b_cust_svc);
2307 $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2312 =item suspended_pkgs
2314 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2318 sub suspended_pkgs {
2320 grep { $_->susp } $self->ncancelled_pkgs;
2323 =item unflagged_suspended_pkgs
2325 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2326 customer (thouse packages without the `manual_flag' set).
2330 sub unflagged_suspended_pkgs {
2332 return $self->suspended_pkgs
2333 unless dbdef->table('cust_pkg')->column('manual_flag');
2334 grep { ! $_->manual_flag } $self->suspended_pkgs;
2337 =item unsuspended_pkgs
2339 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2344 sub unsuspended_pkgs {
2346 grep { ! $_->susp } $self->ncancelled_pkgs;
2349 =item next_bill_date
2351 Returns the next date this customer will be billed, as a UNIX timestamp, or
2352 undef if no active package has a next bill date.
2356 sub next_bill_date {
2358 min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2361 =item num_cancelled_pkgs
2363 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2368 sub num_cancelled_pkgs {
2369 shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2372 sub num_ncancelled_pkgs {
2373 shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2377 my( $self ) = shift;
2378 my $sql = scalar(@_) ? shift : '';
2379 $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2380 my $sth = dbh->prepare(
2381 "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2382 ) or die dbh->errstr;
2383 $sth->execute($self->custnum) or die $sth->errstr;
2384 $sth->fetchrow_arrayref->[0];
2389 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2390 and L<FS::cust_pkg>) for this customer. Always returns a list: an empty list
2391 on success or a list of errors.
2397 grep { $_->unsuspend } $self->suspended_pkgs;
2402 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2404 Returns a list: an empty list on success or a list of errors.
2410 grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2413 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2415 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2416 PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref instead
2417 of a list of pkgparts; the hashref has the following keys:
2421 =item pkgparts - listref of pkgparts
2423 =item (other options are passed to the suspend method)
2428 Returns a list: an empty list on success or a list of errors.
2432 sub suspend_if_pkgpart {
2434 my (@pkgparts, %opt);
2435 if (ref($_[0]) eq 'HASH'){
2436 @pkgparts = @{$_[0]{pkgparts}};
2441 grep { $_->suspend(%opt) }
2442 grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2443 $self->unsuspended_pkgs;
2446 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2448 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2449 given PKGPARTs (see L<FS::part_pkg>). Preferred usage is to pass a hashref
2450 instead of a list of pkgparts; the hashref has the following keys:
2454 =item pkgparts - listref of pkgparts
2456 =item (other options are passed to the suspend method)
2460 Returns a list: an empty list on success or a list of errors.
2464 sub suspend_unless_pkgpart {
2466 my (@pkgparts, %opt);
2467 if (ref($_[0]) eq 'HASH'){
2468 @pkgparts = @{$_[0]{pkgparts}};
2473 grep { $_->suspend(%opt) }
2474 grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2475 $self->unsuspended_pkgs;
2478 =item cancel [ OPTION => VALUE ... ]
2480 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2482 Available options are:
2486 =item quiet - can be set true to supress email cancellation notices.
2488 =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.
2490 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2492 =item nobill - can be set true to skip billing if it might otherwise be done.
2496 Always returns a list: an empty list on success or a list of errors.
2500 # nb that dates are not specified as valid options to this method
2503 my( $self, %opt ) = @_;
2505 warn "$me cancel called on customer ". $self->custnum. " with options ".
2506 join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2509 return ( 'access denied' )
2510 unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2512 if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2514 #should try decryption (we might have the private key)
2515 # and if not maybe queue a job for the server that does?
2516 return ( "Can't (yet) ban encrypted credit cards" )
2517 if $self->is_encrypted($self->payinfo);
2519 my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2520 my $error = $ban->insert;
2521 return ( $error ) if $error;
2525 my @pkgs = $self->ncancelled_pkgs;
2527 if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2529 my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2530 warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2534 warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2535 scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2538 grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2541 sub _banned_pay_hashref {
2552 'payby' => $payby2ban{$self->payby},
2553 'payinfo' => md5_base64($self->payinfo),
2554 #don't ever *search* on reason! #'reason' =>
2560 Returns all notes (see L<FS::cust_main_note>) for this customer.
2567 qsearch( 'cust_main_note',
2568 { 'custnum' => $self->custnum },
2570 'ORDER BY _DATE DESC'
2576 Returns the agent (see L<FS::agent>) for this customer.
2582 qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2587 Returns the agent name (see L<FS::agent>) for this customer.
2593 $self->agent->agent;
2598 Returns any tags associated with this customer, as FS::cust_tag objects,
2599 or an empty list if there are no tags.
2605 qsearch('cust_tag', { 'custnum' => $self->custnum } );
2610 Returns any tags associated with this customer, as FS::part_tag objects,
2611 or an empty list if there are no tags.
2617 map $_->part_tag, $self->cust_tag;
2623 Returns the customer class, as an FS::cust_class object, or the empty string
2624 if there is no customer class.
2630 if ( $self->classnum ) {
2631 qsearchs('cust_class', { 'classnum' => $self->classnum } );
2639 Returns the customer category name, or the empty string if there is no customer
2646 my $cust_class = $self->cust_class;
2648 ? $cust_class->categoryname
2654 Returns the customer class name, or the empty string if there is no customer
2661 my $cust_class = $self->cust_class;
2663 ? $cust_class->classname
2667 =item BILLING METHODS
2669 Documentation on billing methods has been moved to
2670 L<FS::cust_main::Billing>.
2672 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
2674 Runs billing events; see L<FS::part_event> and the billing events web
2677 If there is an error, returns the error, otherwise returns false.
2679 Options are passed as name-value pairs.
2681 Currently available options are:
2687 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.
2691 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2695 "collect" (the default) or "pre-bill"
2699 set true to surpress email card/ACH decline notices.
2703 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)
2709 # allows for one time override of normal customer billing method
2713 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2716 my( $self, %options ) = @_;
2717 my $time = $options{'time'} || time;
2720 local $SIG{HUP} = 'IGNORE';
2721 local $SIG{INT} = 'IGNORE';
2722 local $SIG{QUIT} = 'IGNORE';
2723 local $SIG{TERM} = 'IGNORE';
2724 local $SIG{TSTP} = 'IGNORE';
2725 local $SIG{PIPE} = 'IGNORE';
2727 my $oldAutoCommit = $FS::UID::AutoCommit;
2728 local $FS::UID::AutoCommit = 0;
2731 $self->select_for_update; #mutex
2734 my $balance = $self->balance;
2735 warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
2738 # if ( exists($options{'retry_card'}) ) {
2739 # carp 'retry_card option passed to collect is deprecated; use retry';
2740 # $options{'retry'} ||= $options{'retry_card'};
2742 # if ( exists($options{'retry'}) && $options{'retry'} ) {
2743 # my $error = $self->retry_realtime;
2745 # $dbh->rollback if $oldAutoCommit;
2750 # false laziness w/pay_batch::import_results
2752 my $due_cust_event = $self->due_cust_event(
2753 'debug' => ( $options{'debug'} || 0 ),
2755 'check_freq' => $options{'check_freq'},
2756 'stage' => ( $options{'stage'} || 'collect' ),
2758 unless( ref($due_cust_event) ) {
2759 $dbh->rollback if $oldAutoCommit;
2760 return $due_cust_event;
2763 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2764 #never want to roll back an event just because it or a different one
2766 local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
2768 foreach my $cust_event ( @$due_cust_event ) {
2772 #re-eval event conditions (a previous event could have changed things)
2773 unless ( $cust_event->test_conditions( 'time' => $time ) ) {
2774 #don't leave stray "new/locked" records around
2775 my $error = $cust_event->delete;
2776 return $error if $error;
2781 local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2782 warn " running cust_event ". $cust_event->eventnum. "\n"
2785 #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2786 if ( my $error = $cust_event->do_event() ) {
2787 #XXX wtf is this? figure out a proper dealio with return value
2799 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2801 Inserts database records for and returns an ordered listref of new events due
2802 for this customer, as FS::cust_event objects (see L<FS::cust_event>). If no
2803 events are due, an empty listref is returned. If there is an error, returns a
2804 scalar error message.
2806 To actually run the events, call each event's test_condition method, and if
2807 still true, call the event's do_event method.
2809 Options are passed as a hashref or as a list of name-value pairs. Available
2816 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.
2820 "collect" (the default) or "pre-bill"
2824 "Current time" for the events.
2828 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)
2832 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2836 Explicitly pass the objects to be tested (typically used with eventtable).
2840 Set to true to return the objects, but not actually insert them into the
2847 sub due_cust_event {
2849 my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2852 #my $DEBUG = $opt{'debug'}
2853 local($DEBUG) = $opt{'debug'}
2854 if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2856 warn "$me due_cust_event called with options ".
2857 join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2860 $opt{'time'} ||= time;
2862 local $SIG{HUP} = 'IGNORE';
2863 local $SIG{INT} = 'IGNORE';
2864 local $SIG{QUIT} = 'IGNORE';
2865 local $SIG{TERM} = 'IGNORE';
2866 local $SIG{TSTP} = 'IGNORE';
2867 local $SIG{PIPE} = 'IGNORE';
2869 my $oldAutoCommit = $FS::UID::AutoCommit;
2870 local $FS::UID::AutoCommit = 0;
2873 $self->select_for_update #mutex
2874 unless $opt{testonly};
2877 # find possible events (initial search)
2880 my @cust_event = ();
2882 my @eventtable = $opt{'eventtable'}
2883 ? ( $opt{'eventtable'} )
2884 : FS::part_event->eventtables_runorder;
2886 foreach my $eventtable ( @eventtable ) {
2889 if ( $opt{'objects'} ) {
2891 @objects = @{ $opt{'objects'} };
2895 #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2896 @objects = ( $eventtable eq 'cust_main' )
2898 : ( $self->$eventtable() );
2902 my @e_cust_event = ();
2904 my $cross = "CROSS JOIN $eventtable";
2905 $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2906 unless $eventtable eq 'cust_main';
2908 foreach my $object ( @objects ) {
2910 #this first search uses the condition_sql magic for optimization.
2911 #the more possible events we can eliminate in this step the better
2913 my $cross_where = '';
2914 my $pkey = $object->primary_key;
2915 $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2917 my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2919 FS::part_event_condition->where_conditions_sql( $eventtable,
2920 'time'=>$opt{'time'}
2922 my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2924 $extra_sql = "AND $extra_sql" if $extra_sql;
2926 #here is the agent virtualization
2927 $extra_sql .= " AND ( part_event.agentnum IS NULL
2928 OR part_event.agentnum = ". $self->agentnum. ' )';
2930 $extra_sql .= " $order";
2932 warn "searching for events for $eventtable ". $object->$pkey. "\n"
2933 if $opt{'debug'} > 2;
2934 my @part_event = qsearch( {
2935 'debug' => ( $opt{'debug'} > 3 ? 1 : 0 ),
2936 'select' => 'part_event.*',
2937 'table' => 'part_event',
2938 'addl_from' => "$cross $join",
2939 'hashref' => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2940 'eventtable' => $eventtable,
2943 'extra_sql' => "AND $cross_where $extra_sql",
2947 my $pkey = $object->primary_key;
2948 warn " ". scalar(@part_event).
2949 " possible events found for $eventtable ". $object->$pkey(). "\n";
2952 push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2956 warn " ". scalar(@e_cust_event).
2957 " subtotal possible cust events found for $eventtable\n"
2960 push @cust_event, @e_cust_event;
2964 warn " ". scalar(@cust_event).
2965 " total possible cust events found in initial search\n"
2973 $opt{stage} ||= 'collect';
2975 grep { my $stage = $_->part_event->event_stage;
2976 $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2986 @cust_event = grep $_->test_conditions( 'time' => $opt{'time'},
2987 'stats_hashref' => \%unsat ),
2990 warn " ". scalar(@cust_event). " cust events left satisfying conditions\n"
2993 warn " invalid conditions not eliminated with condition_sql:\n".
2994 join('', map " $_: ".$unsat{$_}."\n", keys %unsat )
2995 if keys %unsat && $DEBUG; # > 1;
3001 unless( $opt{testonly} ) {
3002 foreach my $cust_event ( @cust_event ) {
3004 my $error = $cust_event->insert();
3006 $dbh->rollback if $oldAutoCommit;
3013 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3019 warn " returning events: ". Dumper(@cust_event). "\n"
3026 =item retry_realtime
3028 Schedules realtime / batch credit card / electronic check / LEC billing
3029 events for for retry. Useful if card information has changed or manual
3030 retry is desired. The 'collect' method must be called to actually retry
3033 Implementation details: For either this customer, or for each of this
3034 customer's open invoices, changes the status of the first "done" (with
3035 statustext error) realtime processing event to "failed".
3039 sub retry_realtime {
3042 local $SIG{HUP} = 'IGNORE';
3043 local $SIG{INT} = 'IGNORE';
3044 local $SIG{QUIT} = 'IGNORE';
3045 local $SIG{TERM} = 'IGNORE';
3046 local $SIG{TSTP} = 'IGNORE';
3047 local $SIG{PIPE} = 'IGNORE';
3049 my $oldAutoCommit = $FS::UID::AutoCommit;
3050 local $FS::UID::AutoCommit = 0;
3053 #a little false laziness w/due_cust_event (not too bad, really)
3055 my $join = FS::part_event_condition->join_conditions_sql;
3056 my $order = FS::part_event_condition->order_conditions_sql;
3059 . join ( ' OR ' , map {
3060 "( part_event.eventtable = " . dbh->quote($_)
3061 . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3062 } FS::part_event->eventtables)
3065 #here is the agent virtualization
3066 my $agent_virt = " ( part_event.agentnum IS NULL
3067 OR part_event.agentnum = ". $self->agentnum. ' )';
3069 #XXX this shouldn't be hardcoded, actions should declare it...
3070 my @realtime_events = qw(
3071 cust_bill_realtime_card
3072 cust_bill_realtime_check
3073 cust_bill_realtime_lec
3077 my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3082 my @cust_event = qsearchs({
3083 'table' => 'cust_event',
3084 'select' => 'cust_event.*',
3085 'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3086 'hashref' => { 'status' => 'done' },
3087 'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3088 " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3091 my %seen_invnum = ();
3092 foreach my $cust_event (@cust_event) {
3094 #max one for the customer, one for each open invoice
3095 my $cust_X = $cust_event->cust_X;
3096 next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3100 or $cust_event->part_event->eventtable eq 'cust_bill'
3103 my $error = $cust_event->retry;
3105 $dbh->rollback if $oldAutoCommit;
3106 return "error scheduling event for retry: $error";
3111 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3119 =item REALTIME BILLING METHODS
3121 Documentation on realtime billing methods has been moved to
3122 L<FS::cust_main::Billing_Realtime>.
3126 Removes the I<paycvv> field from the database directly.
3128 If there is an error, returns the error, otherwise returns false.
3134 my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3135 or return dbh->errstr;
3136 $sth->execute($self->custnum)
3137 or return $sth->errstr;
3142 =item batch_card OPTION => VALUE...
3144 Adds a payment for this invoice to the pending credit card batch (see
3145 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
3146 runs the payment using a realtime gateway.
3151 my ($self, %options) = @_;
3154 if (exists($options{amount})) {
3155 $amount = $options{amount};
3157 $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
3159 return '' unless $amount > 0;
3161 my $invnum = delete $options{invnum};
3162 my $payby = $options{invnum} || $self->payby; #dubious
3164 if ($options{'realtime'}) {
3165 return $self->realtime_bop( FS::payby->payby2bop($self->payby),
3171 my $oldAutoCommit = $FS::UID::AutoCommit;
3172 local $FS::UID::AutoCommit = 0;
3175 #this needs to handle mysql as well as Pg, like svc_acct.pm
3176 #(make it into a common function if folks need to do batching with mysql)
3177 $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
3178 or return "Cannot lock pay_batch: " . $dbh->errstr;
3182 'payby' => FS::payby->payby2payment($payby),
3185 my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
3187 unless ( $pay_batch ) {
3188 $pay_batch = new FS::pay_batch \%pay_batch;
3189 my $error = $pay_batch->insert;
3191 $dbh->rollback if $oldAutoCommit;
3192 die "error creating new batch: $error\n";
3196 my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
3197 'batchnum' => $pay_batch->batchnum,
3198 'custnum' => $self->custnum,
3201 foreach (qw( address1 address2 city state zip country payby payinfo paydate
3203 $options{$_} = '' unless exists($options{$_});
3206 my $cust_pay_batch = new FS::cust_pay_batch ( {
3207 'batchnum' => $pay_batch->batchnum,
3208 'invnum' => $invnum || 0, # is there a better value?
3209 # this field should be
3211 # cust_bill_pay_batch now
3212 'custnum' => $self->custnum,
3213 'last' => $self->getfield('last'),
3214 'first' => $self->getfield('first'),
3215 'address1' => $options{address1} || $self->address1,
3216 'address2' => $options{address2} || $self->address2,
3217 'city' => $options{city} || $self->city,
3218 'state' => $options{state} || $self->state,
3219 'zip' => $options{zip} || $self->zip,
3220 'country' => $options{country} || $self->country,
3221 'payby' => $options{payby} || $self->payby,
3222 'payinfo' => $options{payinfo} || $self->payinfo,
3223 'exp' => $options{paydate} || $self->paydate,
3224 'payname' => $options{payname} || $self->payname,
3225 'amount' => $amount, # consolidating
3228 $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
3229 if $old_cust_pay_batch;
3232 if ($old_cust_pay_batch) {
3233 $error = $cust_pay_batch->replace($old_cust_pay_batch)
3235 $error = $cust_pay_batch->insert;
3239 $dbh->rollback if $oldAutoCommit;
3243 my $unapplied = $self->total_unapplied_credits
3244 + $self->total_unapplied_payments
3245 + $self->in_transit_payments;
3246 foreach my $cust_bill ($self->open_cust_bill) {
3247 #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
3248 my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
3249 'invnum' => $cust_bill->invnum,
3250 'paybatchnum' => $cust_pay_batch->paybatchnum,
3251 'amount' => $cust_bill->owed,
3254 if ($unapplied >= $cust_bill_pay_batch->amount){
3255 $unapplied -= $cust_bill_pay_batch->amount;
3258 $cust_bill_pay_batch->amount(sprintf ( "%.2f",
3259 $cust_bill_pay_batch->amount - $unapplied )); $unapplied = 0;
3261 $error = $cust_bill_pay_batch->insert;
3263 $dbh->rollback if $oldAutoCommit;
3268 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3274 Returns the total owed for this customer on all invoices
3275 (see L<FS::cust_bill/owed>).
3281 $self->total_owed_date(2145859200); #12/31/2037
3284 =item total_owed_date TIME
3286 Returns the total owed for this customer on all invoices with date earlier than
3287 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
3288 see L<Time::Local> and L<Date::Parse> for conversion functions.
3292 sub total_owed_date {
3296 my $custnum = $self->custnum;
3298 my $owed_sql = FS::cust_bill->owed_sql;
3301 SELECT SUM($owed_sql) FROM cust_bill
3302 WHERE custnum = $custnum
3306 sprintf( "%.2f", $self->scalar_sql($sql) );
3310 =item total_owed_pkgnum PKGNUM
3312 Returns the total owed on all invoices for this customer's specific package
3313 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
3317 sub total_owed_pkgnum {
3318 my( $self, $pkgnum ) = @_;
3319 $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
3322 =item total_owed_date_pkgnum TIME PKGNUM
3324 Returns the total owed for this customer's specific package when using
3325 experimental package balances on all invoices with date earlier than
3326 TIME. TIME is specified as a UNIX timestamp; see L<perlfunc/"time">). Also
3327 see L<Time::Local> and L<Date::Parse> for conversion functions.
3331 sub total_owed_date_pkgnum {
3332 my( $self, $time, $pkgnum ) = @_;
3335 foreach my $cust_bill (
3336 grep { $_->_date <= $time }
3337 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3339 $total_bill += $cust_bill->owed_pkgnum($pkgnum);
3341 sprintf( "%.2f", $total_bill );
3347 Returns the total amount of all payments.
3354 $total += $_->paid foreach $self->cust_pay;
3355 sprintf( "%.2f", $total );
3358 =item total_unapplied_credits
3360 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3361 customer. See L<FS::cust_credit/credited>.
3363 =item total_credited
3365 Old name for total_unapplied_credits. Don't use.
3369 sub total_credited {
3370 #carp "total_credited deprecated, use total_unapplied_credits";
3371 shift->total_unapplied_credits(@_);
3374 sub total_unapplied_credits {
3377 my $custnum = $self->custnum;
3379 my $unapplied_sql = FS::cust_credit->unapplied_sql;
3382 SELECT SUM($unapplied_sql) FROM cust_credit
3383 WHERE custnum = $custnum
3386 sprintf( "%.2f", $self->scalar_sql($sql) );
3390 =item total_unapplied_credits_pkgnum PKGNUM
3392 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3393 customer. See L<FS::cust_credit/credited>.
3397 sub total_unapplied_credits_pkgnum {
3398 my( $self, $pkgnum ) = @_;
3399 my $total_credit = 0;
3400 $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
3401 sprintf( "%.2f", $total_credit );
3405 =item total_unapplied_payments
3407 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3408 See L<FS::cust_pay/unapplied>.
3412 sub total_unapplied_payments {
3415 my $custnum = $self->custnum;
3417 my $unapplied_sql = FS::cust_pay->unapplied_sql;
3420 SELECT SUM($unapplied_sql) FROM cust_pay
3421 WHERE custnum = $custnum
3424 sprintf( "%.2f", $self->scalar_sql($sql) );
3428 =item total_unapplied_payments_pkgnum PKGNUM
3430 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
3431 specific package when using experimental package balances. See
3432 L<FS::cust_pay/unapplied>.
3436 sub total_unapplied_payments_pkgnum {
3437 my( $self, $pkgnum ) = @_;
3438 my $total_unapplied = 0;
3439 $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
3440 sprintf( "%.2f", $total_unapplied );
3444 =item total_unapplied_refunds
3446 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
3447 customer. See L<FS::cust_refund/unapplied>.
3451 sub total_unapplied_refunds {
3453 my $custnum = $self->custnum;
3455 my $unapplied_sql = FS::cust_refund->unapplied_sql;
3458 SELECT SUM($unapplied_sql) FROM cust_refund
3459 WHERE custnum = $custnum
3462 sprintf( "%.2f", $self->scalar_sql($sql) );
3468 Returns the balance for this customer (total_owed plus total_unrefunded, minus
3469 total_unapplied_credits minus total_unapplied_payments).
3475 $self->balance_date_range;
3478 =item balance_date TIME
3480 Returns the balance for this customer, only considering invoices with date
3481 earlier than TIME (total_owed_date minus total_credited minus
3482 total_unapplied_payments). TIME is specified as a UNIX timestamp; see
3483 L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion
3490 $self->balance_date_range(shift);
3493 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3495 Returns the balance for this customer, optionally considering invoices with
3496 date earlier than START_TIME, and not later than END_TIME
3497 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
3499 Times are specified as SQL fragments or numeric
3500 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
3501 L<Date::Parse> for conversion functions. The empty string can be passed
3502 to disable that time constraint completely.
3504 Available options are:
3508 =item unapplied_date
3510 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)
3516 sub balance_date_range {
3518 my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
3519 ') FROM cust_main WHERE custnum='. $self->custnum;
3520 sprintf( '%.2f', $self->scalar_sql($sql) );
3523 =item balance_pkgnum PKGNUM
3525 Returns the balance for this customer's specific package when using
3526 experimental package balances (total_owed plus total_unrefunded, minus
3527 total_unapplied_credits minus total_unapplied_payments)
3531 sub balance_pkgnum {
3532 my( $self, $pkgnum ) = @_;
3535 $self->total_owed_pkgnum($pkgnum)
3536 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
3537 # + $self->total_unapplied_refunds_pkgnum($pkgnum)
3538 - $self->total_unapplied_credits_pkgnum($pkgnum)
3539 - $self->total_unapplied_payments_pkgnum($pkgnum)
3543 =item in_transit_payments
3545 Returns the total of requests for payments for this customer pending in
3546 batches in transit to the bank. See L<FS::pay_batch> and L<FS::cust_pay_batch>
3550 sub in_transit_payments {
3552 my $in_transit_payments = 0;
3553 foreach my $pay_batch ( qsearch('pay_batch', {
3556 foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3557 'batchnum' => $pay_batch->batchnum,
3558 'custnum' => $self->custnum,
3560 $in_transit_payments += $cust_pay_batch->amount;
3563 sprintf( "%.2f", $in_transit_payments );
3568 Returns a hash of useful information for making a payment.
3578 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3579 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3580 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3584 For credit card transactions:
3596 For electronic check transactions:
3611 $return{balance} = $self->balance;
3613 $return{payname} = $self->payname
3614 || ( $self->first. ' '. $self->get('last') );
3616 $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
3618 $return{payby} = $self->payby;
3619 $return{stateid_state} = $self->stateid_state;
3621 if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3622 $return{card_type} = cardtype($self->payinfo);
3623 $return{payinfo} = $self->paymask;
3625 @return{'month', 'year'} = $self->paydate_monthyear;
3629 if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3630 my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3631 $return{payinfo1} = $payinfo1;
3632 $return{payinfo2} = $payinfo2;
3633 $return{paytype} = $self->paytype;
3634 $return{paystate} = $self->paystate;
3638 #doubleclick protection
3640 $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3646 =item paydate_monthyear
3648 Returns a two-element list consisting of the month and year of this customer's
3649 paydate (credit card expiration date for CARD customers)
3653 sub paydate_monthyear {
3655 if ( $self->paydate =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3657 } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3664 =item tax_exemption TAXNAME
3669 my( $self, $taxname ) = @_;
3671 qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3672 'taxname' => $taxname,
3677 =item cust_main_exemption
3681 sub cust_main_exemption {
3683 qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3686 =item invoicing_list [ ARRAYREF ]
3688 If an arguement is given, sets these email addresses as invoice recipients
3689 (see L<FS::cust_main_invoice>). Errors are not fatal and are not reported
3690 (except as warnings), so use check_invoicing_list first.
3692 Returns a list of email addresses (with svcnum entries expanded).
3694 Note: You can clear the invoicing list by passing an empty ARRAYREF. You can
3695 check it without disturbing anything by passing nothing.
3697 This interface may change in the future.
3701 sub invoicing_list {
3702 my( $self, $arrayref ) = @_;
3705 my @cust_main_invoice;
3706 if ( $self->custnum ) {
3707 @cust_main_invoice =
3708 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3710 @cust_main_invoice = ();
3712 foreach my $cust_main_invoice ( @cust_main_invoice ) {
3713 #warn $cust_main_invoice->destnum;
3714 unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3715 #warn $cust_main_invoice->destnum;
3716 my $error = $cust_main_invoice->delete;
3717 warn $error if $error;
3720 if ( $self->custnum ) {
3721 @cust_main_invoice =
3722 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3724 @cust_main_invoice = ();
3726 my %seen = map { $_->address => 1 } @cust_main_invoice;
3727 foreach my $address ( @{$arrayref} ) {
3728 next if exists $seen{$address} && $seen{$address};
3729 $seen{$address} = 1;
3730 my $cust_main_invoice = new FS::cust_main_invoice ( {
3731 'custnum' => $self->custnum,
3734 my $error = $cust_main_invoice->insert;
3735 warn $error if $error;
3739 if ( $self->custnum ) {
3741 qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3748 =item check_invoicing_list ARRAYREF
3750 Checks these arguements as valid input for the invoicing_list method. If there
3751 is an error, returns the error, otherwise returns false.
3755 sub check_invoicing_list {
3756 my( $self, $arrayref ) = @_;
3758 foreach my $address ( @$arrayref ) {
3760 if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3761 return 'Can\'t add FAX invoice destination with a blank FAX number.';
3764 my $cust_main_invoice = new FS::cust_main_invoice ( {
3765 'custnum' => $self->custnum,
3768 my $error = $self->custnum
3769 ? $cust_main_invoice->check
3770 : $cust_main_invoice->checkdest
3772 return $error if $error;
3776 return "Email address required"
3777 if $conf->exists('cust_main-require_invoicing_list_email')
3778 && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3783 =item set_default_invoicing_list
3785 Sets the invoicing list to all accounts associated with this customer,
3786 overwriting any previous invoicing list.
3790 sub set_default_invoicing_list {
3792 $self->invoicing_list($self->all_emails);
3797 Returns the email addresses of all accounts provisioned for this customer.
3804 foreach my $cust_pkg ( $self->all_pkgs ) {
3805 my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3807 map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3808 grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3810 $list{$_}=1 foreach map { $_->email } @svc_acct;
3815 =item invoicing_list_addpost
3817 Adds postal invoicing to this customer. If this customer is already configured
3818 to receive postal invoices, does nothing.
3822 sub invoicing_list_addpost {
3824 return if grep { $_ eq 'POST' } $self->invoicing_list;
3825 my @invoicing_list = $self->invoicing_list;
3826 push @invoicing_list, 'POST';
3827 $self->invoicing_list(\@invoicing_list);
3830 =item invoicing_list_emailonly
3832 Returns the list of email invoice recipients (invoicing_list without non-email
3833 destinations such as POST and FAX).
3837 sub invoicing_list_emailonly {
3839 warn "$me invoicing_list_emailonly called"
3841 grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3844 =item invoicing_list_emailonly_scalar
3846 Returns the list of email invoice recipients (invoicing_list without non-email
3847 destinations such as POST and FAX) as a comma-separated scalar.
3851 sub invoicing_list_emailonly_scalar {
3853 warn "$me invoicing_list_emailonly_scalar called"
3855 join(', ', $self->invoicing_list_emailonly);
3858 =item referral_custnum_cust_main
3860 Returns the customer who referred this customer (or the empty string, if
3861 this customer was not referred).
3863 Note the difference with referral_cust_main method: This method,
3864 referral_custnum_cust_main returns the single customer (if any) who referred
3865 this customer, while referral_cust_main returns an array of customers referred
3870 sub referral_custnum_cust_main {
3872 return '' unless $self->referral_custnum;
3873 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3876 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3878 Returns an array of customers referred by this customer (referral_custnum set
3879 to this custnum). If DEPTH is given, recurses up to the given depth, returning
3880 customers referred by customers referred by this customer and so on, inclusive.
3881 The default behavior is DEPTH 1 (no recursion).
3883 Note the difference with referral_custnum_cust_main method: This method,
3884 referral_cust_main, returns an array of customers referred BY this customer,
3885 while referral_custnum_cust_main returns the single customer (if any) who
3886 referred this customer.
3890 sub referral_cust_main {
3892 my $depth = @_ ? shift : 1;
3893 my $exclude = @_ ? shift : {};
3896 map { $exclude->{$_->custnum}++; $_; }
3897 grep { ! $exclude->{ $_->custnum } }
3898 qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3902 map { $_->referral_cust_main($depth-1, $exclude) }
3909 =item referral_cust_main_ncancelled
3911 Same as referral_cust_main, except only returns customers with uncancelled
3916 sub referral_cust_main_ncancelled {
3918 grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3921 =item referral_cust_pkg [ DEPTH ]
3923 Like referral_cust_main, except returns a flat list of all unsuspended (and
3924 uncancelled) packages for each customer. The number of items in this list may
3925 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3929 sub referral_cust_pkg {
3931 my $depth = @_ ? shift : 1;
3933 map { $_->unsuspended_pkgs }
3934 grep { $_->unsuspended_pkgs }
3935 $self->referral_cust_main($depth);
3938 =item referring_cust_main
3940 Returns the single cust_main record for the customer who referred this customer
3941 (referral_custnum), or false.
3945 sub referring_cust_main {
3947 return '' unless $self->referral_custnum;
3948 qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3951 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3953 Applies a credit to this customer. If there is an error, returns the error,
3954 otherwise returns false.
3956 REASON can be a text string, an FS::reason object, or a scalar reference to
3957 a reasonnum. If a text string, it will be automatically inserted as a new
3958 reason, and a 'reason_type' option must be passed to indicate the
3959 FS::reason_type for the new reason.
3961 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3963 Any other options are passed to FS::cust_credit::insert.
3968 my( $self, $amount, $reason, %options ) = @_;
3970 my $cust_credit = new FS::cust_credit {
3971 'custnum' => $self->custnum,
3972 'amount' => $amount,
3975 if ( ref($reason) ) {
3977 if ( ref($reason) eq 'SCALAR' ) {
3978 $cust_credit->reasonnum( $$reason );
3980 $cust_credit->reasonnum( $reason->reasonnum );
3984 $cust_credit->set('reason', $reason)
3987 for (qw( addlinfo eventnum )) {
3988 $cust_credit->$_( delete $options{$_} )
3989 if exists($options{$_});
3992 $cust_credit->insert(%options);
3996 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3998 Creates a one-time charge for this customer. If there is an error, returns
3999 the error, otherwise returns false.
4001 New-style, with a hashref of options:
4003 my $error = $cust_main->charge(
4007 'start_date' => str2time('7/4/2009'),
4008 'pkg' => 'Description',
4009 'comment' => 'Comment',
4010 'additional' => [], #extra invoice detail
4011 'classnum' => 1, #pkg_class
4013 'setuptax' => '', # or 'Y' for tax exempt
4016 'taxclass' => 'Tax class',
4019 'taxproduct' => 2, #part_pkg_taxproduct
4020 'override' => {}, #XXX describe
4022 #will be filled in with the new object
4023 'cust_pkg_ref' => \$cust_pkg,
4025 #generate an invoice immediately
4027 'invoice_terms' => '', #with these terms
4033 my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
4039 my ( $amount, $quantity, $start_date, $classnum );
4040 my ( $pkg, $comment, $additional );
4041 my ( $setuptax, $taxclass ); #internal taxes
4042 my ( $taxproduct, $override ); #vendor (CCH) taxes
4044 my $cust_pkg_ref = '';
4045 my ( $bill_now, $invoice_terms ) = ( 0, '' );
4046 if ( ref( $_[0] ) ) {
4047 $amount = $_[0]->{amount};
4048 $quantity = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
4049 $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
4050 $no_auto = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
4051 $pkg = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4052 $comment = exists($_[0]->{comment}) ? $_[0]->{comment}
4053 : '$'. sprintf("%.2f",$amount);
4054 $setuptax = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
4055 $taxclass = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4056 $classnum = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
4057 $additional = $_[0]->{additional} || [];
4058 $taxproduct = $_[0]->{taxproductnum};
4059 $override = { '' => $_[0]->{tax_override} };
4060 $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
4061 $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
4062 $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
4067 $pkg = @_ ? shift : 'One-time charge';
4068 $comment = @_ ? shift : '$'. sprintf("%.2f",$amount);
4070 $taxclass = @_ ? shift : '';
4074 local $SIG{HUP} = 'IGNORE';
4075 local $SIG{INT} = 'IGNORE';
4076 local $SIG{QUIT} = 'IGNORE';
4077 local $SIG{TERM} = 'IGNORE';
4078 local $SIG{TSTP} = 'IGNORE';
4079 local $SIG{PIPE} = 'IGNORE';
4081 my $oldAutoCommit = $FS::UID::AutoCommit;
4082 local $FS::UID::AutoCommit = 0;
4085 my $part_pkg = new FS::part_pkg ( {
4087 'comment' => $comment,
4091 'classnum' => ( $classnum ? $classnum : '' ),
4092 'setuptax' => $setuptax,
4093 'taxclass' => $taxclass,
4094 'taxproductnum' => $taxproduct,
4097 my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4098 ( 0 .. @$additional - 1 )
4100 'additional_count' => scalar(@$additional),
4101 'setup_fee' => $amount,
4104 my $error = $part_pkg->insert( options => \%options,
4105 tax_overrides => $override,
4108 $dbh->rollback if $oldAutoCommit;
4112 my $pkgpart = $part_pkg->pkgpart;
4113 my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4114 unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4115 my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4116 $error = $type_pkgs->insert;
4118 $dbh->rollback if $oldAutoCommit;
4123 my $cust_pkg = new FS::cust_pkg ( {
4124 'custnum' => $self->custnum,
4125 'pkgpart' => $pkgpart,
4126 'quantity' => $quantity,
4127 'start_date' => $start_date,
4128 'no_auto' => $no_auto,
4131 $error = $cust_pkg->insert;
4133 $dbh->rollback if $oldAutoCommit;
4135 } elsif ( $cust_pkg_ref ) {
4136 ${$cust_pkg_ref} = $cust_pkg;
4140 my $error = $self->bill( 'invoice_terms' => $invoice_terms,
4141 'pkg_list' => [ $cust_pkg ],
4144 $dbh->rollback if $oldAutoCommit;
4149 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4154 #=item charge_postal_fee
4156 #Applies a one time charge this customer. If there is an error,
4157 #returns the error, returns the cust_pkg charge object or false
4158 #if there was no charge.
4162 # This should be a customer event. For that to work requires that bill
4163 # also be a customer event.
4165 sub charge_postal_fee {
4168 my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
4169 return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
4171 my $cust_pkg = new FS::cust_pkg ( {
4172 'custnum' => $self->custnum,
4173 'pkgpart' => $pkgpart,
4177 my $error = $cust_pkg->insert;
4178 $error ? $error : $cust_pkg;
4183 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4189 map { $_ } #return $self->num_cust_bill unless wantarray;
4190 sort { $a->_date <=> $b->_date }
4191 qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4194 =item open_cust_bill
4196 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4201 sub open_cust_bill {
4205 'table' => 'cust_bill',
4206 'hashref' => { 'custnum' => $self->custnum, },
4207 'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
4208 'order_by' => 'ORDER BY _date ASC',
4213 =item cust_statements
4215 Returns all the statements (see L<FS::cust_statement>) for this customer.
4219 sub cust_statement {
4221 map { $_ } #return $self->num_cust_statement unless wantarray;
4222 sort { $a->_date <=> $b->_date }
4223 qsearch('cust_statement', { 'custnum' => $self->custnum, } )
4228 Returns all the credits (see L<FS::cust_credit>) for this customer.
4234 map { $_ } #return $self->num_cust_credit unless wantarray;
4235 sort { $a->_date <=> $b->_date }
4236 qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4239 =item cust_credit_pkgnum
4241 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
4242 package when using experimental package balances.
4246 sub cust_credit_pkgnum {
4247 my( $self, $pkgnum ) = @_;
4248 map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
4249 sort { $a->_date <=> $b->_date }
4250 qsearch( 'cust_credit', { 'custnum' => $self->custnum,
4251 'pkgnum' => $pkgnum,
4258 Returns all the payments (see L<FS::cust_pay>) for this customer.
4264 return $self->num_cust_pay unless wantarray;
4265 sort { $a->_date <=> $b->_date }
4266 qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
4271 Returns the number of payments (see L<FS::cust_pay>) for this customer. Also
4272 called automatically when the cust_pay method is used in a scalar context.
4278 my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
4279 my $sth = dbh->prepare($sql) or die dbh->errstr;
4280 $sth->execute($self->custnum) or die $sth->errstr;
4281 $sth->fetchrow_arrayref->[0];
4284 =item cust_pay_pkgnum
4286 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4287 package when using experimental package balances.
4291 sub cust_pay_pkgnum {
4292 my( $self, $pkgnum ) = @_;
4293 map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4294 sort { $a->_date <=> $b->_date }
4295 qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4296 'pkgnum' => $pkgnum,
4303 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4309 map { $_ } #return $self->num_cust_pay_void unless wantarray;
4310 sort { $a->_date <=> $b->_date }
4311 qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4314 =item cust_pay_batch
4316 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
4320 sub cust_pay_batch {
4322 map { $_ } #return $self->num_cust_pay_batch unless wantarray;
4323 sort { $a->paybatchnum <=> $b->paybatchnum }
4324 qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
4327 =item cust_pay_pending
4329 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4330 (without status "done").
4334 sub cust_pay_pending {
4336 return $self->num_cust_pay_pending unless wantarray;
4337 sort { $a->_date <=> $b->_date }
4338 qsearch( 'cust_pay_pending', {
4339 'custnum' => $self->custnum,
4340 'status' => { op=>'!=', value=>'done' },
4345 =item cust_pay_pending_attempt
4347 Returns all payment attempts / declined payments for this customer, as pending
4348 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4349 a corresponding payment (see L<FS::cust_pay>).
4353 sub cust_pay_pending_attempt {
4355 return $self->num_cust_pay_pending_attempt unless wantarray;
4356 sort { $a->_date <=> $b->_date }
4357 qsearch( 'cust_pay_pending', {
4358 'custnum' => $self->custnum,
4365 =item num_cust_pay_pending
4367 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4368 customer (without status "done"). Also called automatically when the
4369 cust_pay_pending method is used in a scalar context.
4373 sub num_cust_pay_pending {
4376 " SELECT COUNT(*) FROM cust_pay_pending ".
4377 " WHERE custnum = ? AND status != 'done' ",
4382 =item num_cust_pay_pending_attempt
4384 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4385 customer, with status "done" but without a corresp. Also called automatically when the
4386 cust_pay_pending method is used in a scalar context.
4390 sub num_cust_pay_pending_attempt {
4393 " SELECT COUNT(*) FROM cust_pay_pending ".
4394 " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4401 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4407 map { $_ } #return $self->num_cust_refund unless wantarray;
4408 sort { $a->_date <=> $b->_date }
4409 qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4412 =item display_custnum
4414 Returns the displayed customer number for this customer: agent_custid if
4415 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4419 sub display_custnum {
4421 if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4422 return $self->agent_custid;
4424 return $self->custnum;
4430 Returns a name string for this customer, either "Company (Last, First)" or
4437 my $name = $self->contact;
4438 $name = $self->company. " ($name)" if $self->company;
4444 Returns a name string for this (service/shipping) contact, either
4445 "Company (Last, First)" or "Last, First".
4451 if ( $self->get('ship_last') ) {
4452 my $name = $self->ship_contact;
4453 $name = $self->ship_company. " ($name)" if $self->ship_company;
4462 Returns a name string for this customer, either "Company" or "First Last".
4468 $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4471 =item ship_name_short
4473 Returns a name string for this (service/shipping) contact, either "Company"
4478 sub ship_name_short {
4480 if ( $self->get('ship_last') ) {
4481 $self->ship_company !~ /^\s*$/
4482 ? $self->ship_company
4483 : $self->ship_contact_firstlast;
4485 $self->name_company_or_firstlast;
4491 Returns this customer's full (billing) contact name only, "Last, First"
4497 $self->get('last'). ', '. $self->first;
4502 Returns this customer's full (shipping) contact name only, "Last, First"
4508 $self->get('ship_last')
4509 ? $self->get('ship_last'). ', '. $self->ship_first
4513 =item contact_firstlast
4515 Returns this customers full (billing) contact name only, "First Last".
4519 sub contact_firstlast {
4521 $self->first. ' '. $self->get('last');
4524 =item ship_contact_firstlast
4526 Returns this customer's full (shipping) contact name only, "First Last".
4530 sub ship_contact_firstlast {
4532 $self->get('ship_last')
4533 ? $self->first. ' '. $self->get('ship_last')
4534 : $self->contact_firstlast;
4539 Returns this customer's full country name
4545 code2country($self->country);
4548 =item geocode DATA_VENDOR
4550 Returns a value for the customer location as encoded by DATA_VENDOR.
4551 Currently this only makes sense for "CCH" as DATA_VENDOR.
4556 my ($self, $data_vendor) = (shift, shift); #always cch for now
4558 my $geocode = $self->get('geocode'); #XXX only one data_vendor for geocode
4559 return $geocode if $geocode;
4561 my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
4565 my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
4566 if $self->country eq 'US';
4570 #CCH specific location stuff
4571 my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
4573 my @cust_tax_location =
4575 'table' => 'cust_tax_location',
4576 'hashref' => { 'zip' => $zip, 'data_vendor' => $data_vendor },
4577 'extra_sql' => $extra_sql,
4578 'order_by' => 'ORDER BY plus4hi',#overlapping with distinct ends
4581 $geocode = $cust_tax_location[0]->geocode
4582 if scalar(@cust_tax_location);
4591 Returns a status string for this customer, currently:
4595 =item prospect - No packages have ever been ordered
4597 =item ordered - Recurring packages all are new (not yet billed).
4599 =item active - One or more recurring packages is active
4601 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4603 =item suspended - All non-cancelled recurring packages are suspended
4605 =item cancelled - All recurring packages are cancelled
4611 sub status { shift->cust_status(@_); }
4615 # prospect ordered active inactive suspended cancelled
4616 for my $status ( FS::cust_main->statuses() ) {
4617 my $method = $status.'_sql';
4618 my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4619 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4620 $sth->execute( ($self->custnum) x $numnum )
4621 or die "Error executing 'SELECT $sql': ". $sth->errstr;
4622 return $status if $sth->fetchrow_arrayref->[0];
4626 =item ucfirst_cust_status
4628 =item ucfirst_status
4630 Returns the status with the first character capitalized.
4634 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4636 sub ucfirst_cust_status {
4638 ucfirst($self->cust_status);
4643 Returns a hex triplet color string for this customer's status.
4647 use vars qw(%statuscolor);
4648 tie %statuscolor, 'Tie::IxHash',
4649 'prospect' => '7e0079', #'000000', #black? naw, purple
4650 'active' => '00CC00', #green
4651 'ordered' => '009999', #teal? cyan?
4652 'inactive' => '0000CC', #blue
4653 'suspended' => 'FF9900', #yellow
4654 'cancelled' => 'FF0000', #red
4657 sub statuscolor { shift->cust_statuscolor(@_); }
4659 sub cust_statuscolor {
4661 $statuscolor{$self->cust_status};
4666 Returns an array of hashes representing the customer's RT tickets.
4673 my $num = $conf->config('cust_main-max_tickets') || 10;
4676 if ( $conf->config('ticket_system') ) {
4677 unless ( $conf->config('ticket_system-custom_priority_field') ) {
4679 @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4683 foreach my $priority (
4684 $conf->config('ticket_system-custom_priority_field-values'), ''
4686 last if scalar(@tickets) >= $num;
4688 @{ FS::TicketSystem->customer_tickets( $self->custnum,
4689 $num - scalar(@tickets),
4699 # Return services representing svc_accts in customer support packages
4700 sub support_services {
4702 my %packages = map { $_ => 1 } $conf->config('support_packages');
4704 grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4705 grep { $_->part_svc->svcdb eq 'svc_acct' }
4706 map { $_->cust_svc }
4707 grep { exists $packages{ $_->pkgpart } }
4708 $self->ncancelled_pkgs;
4712 # Return a list of latitude/longitude for one of the services (if any)
4713 sub service_coordinates {
4717 grep { $_->latitude && $_->longitude }
4719 map { $_->cust_svc }
4720 $self->ncancelled_pkgs;
4722 scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4727 Returns a masked version of the named field
4732 my ($self,$field) = @_;
4736 'x'x(length($self->getfield($field))-4).
4737 substr($self->getfield($field), (length($self->getfield($field))-4));
4743 =head1 CLASS METHODS
4749 Class method that returns the list of possible status strings for customers
4750 (see L<the status method|/status>). For example:
4752 @statuses = FS::cust_main->statuses();
4757 #my $self = shift; #could be class...
4763 Returns an SQL expression identifying prospective cust_main records (customers
4764 with no packages ever ordered)
4768 use vars qw($select_count_pkgs);
4769 $select_count_pkgs =
4770 "SELECT COUNT(*) FROM cust_pkg
4771 WHERE cust_pkg.custnum = cust_main.custnum";
4773 sub select_count_pkgs_sql {
4778 " 0 = ( $select_count_pkgs ) ";
4783 Returns an SQL expression identifying ordered cust_main records (customers with
4784 recurring packages not yet setup).
4789 FS::cust_main->none_active_sql.
4790 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
4795 Returns an SQL expression identifying active cust_main records (customers with
4796 active recurring packages).
4801 " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4804 =item none_active_sql
4806 Returns an SQL expression identifying cust_main records with no active
4807 recurring packages. This includes customers of status prospect, ordered,
4808 inactive, and suspended.
4812 sub none_active_sql {
4813 " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4818 Returns an SQL expression identifying inactive cust_main records (customers with
4819 no active recurring packages, but otherwise unsuspended/uncancelled).
4824 FS::cust_main->none_active_sql.
4825 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4831 Returns an SQL expression identifying suspended cust_main records.
4836 sub suspended_sql { susp_sql(@_); }
4838 FS::cust_main->none_active_sql.
4839 " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4845 Returns an SQL expression identifying cancelled cust_main records.
4849 sub cancelled_sql { cancel_sql(@_); }
4852 my $recurring_sql = FS::cust_pkg->recurring_sql;
4853 my $cancelled_sql = FS::cust_pkg->cancelled_sql;
4856 0 < ( $select_count_pkgs )
4857 AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql )
4858 AND 0 = ( $select_count_pkgs AND $recurring_sql
4859 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4861 AND 0 = ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4867 =item uncancelled_sql
4869 Returns an SQL expression identifying un-cancelled cust_main records.
4873 sub uncancelled_sql { uncancel_sql(@_); }
4874 sub uncancel_sql { "
4875 ( 0 < ( $select_count_pkgs
4876 AND ( cust_pkg.cancel IS NULL
4877 OR cust_pkg.cancel = 0
4880 OR 0 = ( $select_count_pkgs )
4886 Returns an SQL fragment to retreive the balance.
4891 ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4892 WHERE cust_bill.custnum = cust_main.custnum )
4893 - ( SELECT COALESCE( SUM(paid), 0 ) FROM cust_pay
4894 WHERE cust_pay.custnum = cust_main.custnum )
4895 - ( SELECT COALESCE( SUM(amount), 0 ) FROM cust_credit
4896 WHERE cust_credit.custnum = cust_main.custnum )
4897 + ( SELECT COALESCE( SUM(refund), 0 ) FROM cust_refund
4898 WHERE cust_refund.custnum = cust_main.custnum )
4901 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4903 Returns an SQL fragment to retreive the balance for this customer, optionally
4904 considering invoices with date earlier than START_TIME, and not
4905 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4906 total_unapplied_payments).
4908 Times are specified as SQL fragments or numeric
4909 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4910 L<Date::Parse> for conversion functions. The empty string can be passed
4911 to disable that time constraint completely.
4913 Available options are:
4917 =item unapplied_date
4919 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)
4924 set to true to remove all customer comparison clauses, for totals
4929 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4934 JOIN clause (typically used with the total option)
4938 An absolute cutoff time. Payments, credits, and refunds I<applied> after this
4939 time will be ignored. Note that START_TIME and END_TIME only limit the date
4940 range for invoices and I<unapplied> payments, credits, and refunds.
4946 sub balance_date_sql {
4947 my( $class, $start, $end, %opt ) = @_;
4949 my $cutoff = $opt{'cutoff'};
4951 my $owed = FS::cust_bill->owed_sql($cutoff);
4952 my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4953 my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4954 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4956 my $j = $opt{'join'} || '';
4958 my $owed_wh = $class->_money_table_where( 'cust_bill', $start,$end,%opt );
4959 my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4960 my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4961 my $pay_wh = $class->_money_table_where( 'cust_pay', $start,$end,%opt );
4963 " ( SELECT COALESCE(SUM($owed), 0) FROM cust_bill $j $owed_wh )
4964 + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4965 - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4966 - ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $j $pay_wh )
4971 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4973 Returns an SQL fragment to retreive the total unapplied payments for this
4974 customer, only considering invoices with date earlier than START_TIME, and
4975 optionally not later than END_TIME.
4977 Times are specified as SQL fragments or numeric
4978 UNIX timestamps; see L<perlfunc/"time">). Also see L<Time::Local> and
4979 L<Date::Parse> for conversion functions. The empty string can be passed
4980 to disable that time constraint completely.
4982 Available options are:
4986 sub unapplied_payments_date_sql {
4987 my( $class, $start, $end, %opt ) = @_;
4989 my $cutoff = $opt{'cutoff'};
4991 my $unapp_pay = FS::cust_pay->unapplied_sql($cutoff);
4993 my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4994 'unapplied_date'=>1 );
4996 " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4999 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5001 Helper method for balance_date_sql; name (and usage) subject to change
5002 (suggestions welcome).
5004 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5005 cust_refund, cust_credit or cust_pay).
5007 If TABLE is "cust_bill" or the unapplied_date option is true, only
5008 considers records with date earlier than START_TIME, and optionally not
5009 later than END_TIME .
5013 sub _money_table_where {
5014 my( $class, $table, $start, $end, %opt ) = @_;
5017 push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5018 if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5019 push @where, "$table._date <= $start" if defined($start) && length($start);
5020 push @where, "$table._date > $end" if defined($end) && length($end);
5022 push @where, @{$opt{'where'}} if $opt{'where'};
5023 my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5029 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5030 use FS::cust_main::Search;
5033 FS::cust_main::Search->search(@_);
5042 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
5046 sub append_fuzzyfiles {
5047 #my( $first, $last, $company ) = @_;
5049 &check_and_rebuild_fuzzyfiles;
5051 use Fcntl qw(:flock);
5053 my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5055 foreach my $field (@fuzzyfields) {
5060 open(CACHE,">>$dir/cust_main.$field")
5061 or die "can't open $dir/cust_main.$field: $!";
5062 flock(CACHE,LOCK_EX)
5063 or die "can't lock $dir/cust_main.$field: $!";
5065 print CACHE "$value\n";
5067 flock(CACHE,LOCK_UN)
5068 or die "can't unlock $dir/cust_main.$field: $!";
5083 #warn join('-',keys %$param);
5084 my $fh = $param->{filehandle};
5085 my $agentnum = $param->{agentnum};
5086 my $format = $param->{format};
5088 my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
5091 if ( $format eq 'simple' ) {
5092 @fields = qw( custnum agent_custid amount pkg );
5094 die "unknown format $format";
5097 eval "use Text::CSV_XS;";
5100 my $csv = new Text::CSV_XS;
5107 local $SIG{HUP} = 'IGNORE';
5108 local $SIG{INT} = 'IGNORE';
5109 local $SIG{QUIT} = 'IGNORE';
5110 local $SIG{TERM} = 'IGNORE';
5111 local $SIG{TSTP} = 'IGNORE';
5112 local $SIG{PIPE} = 'IGNORE';
5114 my $oldAutoCommit = $FS::UID::AutoCommit;
5115 local $FS::UID::AutoCommit = 0;
5118 #while ( $columns = $csv->getline($fh) ) {
5120 while ( defined($line=<$fh>) ) {
5122 $csv->parse($line) or do {
5123 $dbh->rollback if $oldAutoCommit;
5124 return "can't parse: ". $csv->error_input();
5127 my @columns = $csv->fields();
5128 #warn join('-',@columns);
5131 foreach my $field ( @fields ) {
5132 $row{$field} = shift @columns;
5135 if ( $row{custnum} && $row{agent_custid} ) {
5136 dbh->rollback if $oldAutoCommit;
5137 return "can't specify custnum with agent_custid $row{agent_custid}";
5141 if ( $row{agent_custid} && $agentnum ) {
5142 %hash = ( 'agent_custid' => $row{agent_custid},
5143 'agentnum' => $agentnum,
5147 if ( $row{custnum} ) {
5148 %hash = ( 'custnum' => $row{custnum} );
5151 unless ( scalar(keys %hash) ) {
5152 $dbh->rollback if $oldAutoCommit;
5153 return "can't find customer without custnum or agent_custid and agentnum";
5156 my $cust_main = qsearchs('cust_main', { %hash } );
5157 unless ( $cust_main ) {
5158 $dbh->rollback if $oldAutoCommit;
5159 my $custnum = $row{custnum} || $row{agent_custid};
5160 return "unknown custnum $custnum";
5163 if ( $row{'amount'} > 0 ) {
5164 my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5166 $dbh->rollback if $oldAutoCommit;
5170 } elsif ( $row{'amount'} < 0 ) {
5171 my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5174 $dbh->rollback if $oldAutoCommit;
5184 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5186 return "Empty file!" unless $imported;
5192 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5194 Deprecated. Use event notification and message templates
5195 (L<FS::msg_template>) instead.
5197 Sends a templated email notification to the customer (see L<Text::Template>).
5199 OPTIONS is a hash and may include
5201 I<from> - the email sender (default is invoice_from)
5203 I<to> - comma-separated scalar or arrayref of recipients
5204 (default is invoicing_list)
5206 I<subject> - The subject line of the sent email notification
5207 (default is "Notice from company_name")
5209 I<extra_fields> - a hashref of name/value pairs which will be substituted
5212 The following variables are vavailable in the template.
5214 I<$first> - the customer first name
5215 I<$last> - the customer last name
5216 I<$company> - the customer company
5217 I<$payby> - a description of the method of payment for the customer
5218 # would be nice to use FS::payby::shortname
5219 I<$payinfo> - the account information used to collect for this customer
5220 I<$expdate> - the expiration of the customer payment in seconds from epoch
5225 my ($self, $template, %options) = @_;
5227 return unless $conf->exists($template);
5229 my $from = $conf->config('invoice_from', $self->agentnum)
5230 if $conf->exists('invoice_from', $self->agentnum);
5231 $from = $options{from} if exists($options{from});
5233 my $to = join(',', $self->invoicing_list_emailonly);
5234 $to = $options{to} if exists($options{to});
5236 my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5237 if $conf->exists('company_name', $self->agentnum);
5238 $subject = $options{subject} if exists($options{subject});
5240 my $notify_template = new Text::Template (TYPE => 'ARRAY',
5241 SOURCE => [ map "$_\n",
5242 $conf->config($template)]
5244 or die "can't create new Text::Template object: Text::Template::ERROR";
5245 $notify_template->compile()
5246 or die "can't compile template: Text::Template::ERROR";
5248 $FS::notify_template::_template::company_name =
5249 $conf->config('company_name', $self->agentnum);
5250 $FS::notify_template::_template::company_address =
5251 join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5253 my $paydate = $self->paydate || '2037-12-31';
5254 $FS::notify_template::_template::first = $self->first;
5255 $FS::notify_template::_template::last = $self->last;
5256 $FS::notify_template::_template::company = $self->company;
5257 $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5258 my $payby = $self->payby;
5259 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5260 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5262 #credit cards expire at the end of the month/year of their exp date
5263 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5264 $FS::notify_template::_template::payby = 'credit card';
5265 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5266 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5268 }elsif ($payby eq 'COMP') {
5269 $FS::notify_template::_template::payby = 'complimentary account';
5271 $FS::notify_template::_template::payby = 'current method';
5273 $FS::notify_template::_template::expdate = $expire_time;
5275 for (keys %{$options{extra_fields}}){
5277 ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5280 send_email(from => $from,
5282 subject => $subject,
5283 body => $notify_template->fill_in( PACKAGE =>
5284 'FS::notify_template::_template' ),
5289 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5291 Generates a templated notification to the customer (see L<Text::Template>).
5293 OPTIONS is a hash and may include
5295 I<extra_fields> - a hashref of name/value pairs which will be substituted
5296 into the template. These values may override values mentioned below
5297 and those from the customer record.
5299 The following variables are available in the template instead of or in addition
5300 to the fields of the customer record.
5302 I<$payby> - a description of the method of payment for the customer
5303 # would be nice to use FS::payby::shortname
5304 I<$payinfo> - the masked account information used to collect for this customer
5305 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5306 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5310 # a lot like cust_bill::print_latex
5311 sub generate_letter {
5312 my ($self, $template, %options) = @_;
5314 return unless $conf->exists($template);
5316 my $letter_template = new Text::Template
5318 SOURCE => [ map "$_\n", $conf->config($template)],
5319 DELIMITERS => [ '[@--', '--@]' ],
5321 or die "can't create new Text::Template object: Text::Template::ERROR";
5323 $letter_template->compile()
5324 or die "can't compile template: Text::Template::ERROR";
5326 my %letter_data = map { $_ => $self->$_ } $self->fields;
5327 $letter_data{payinfo} = $self->mask_payinfo;
5329 #my $paydate = $self->paydate || '2037-12-31';
5330 my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5332 my $payby = $self->payby;
5333 my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5334 my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5336 #credit cards expire at the end of the month/year of their exp date
5337 if ($payby eq 'CARD' || $payby eq 'DCRD') {
5338 $letter_data{payby} = 'credit card';
5339 ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5340 $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5342 }elsif ($payby eq 'COMP') {
5343 $letter_data{payby} = 'complimentary account';
5345 $letter_data{payby} = 'current method';
5347 $letter_data{expdate} = $expire_time;
5349 for (keys %{$options{extra_fields}}){
5350 $letter_data{$_} = $options{extra_fields}->{$_};
5353 unless(exists($letter_data{returnaddress})){
5354 my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5355 $self->agent_template)
5357 if ( length($retadd) ) {
5358 $letter_data{returnaddress} = $retadd;
5359 } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5360 $letter_data{returnaddress} =
5361 join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5365 ( $conf->config('company_name', $self->agentnum),
5366 $conf->config('company_address', $self->agentnum),
5370 $letter_data{returnaddress} = '~';
5374 $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5376 $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5378 my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5380 my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5384 ) or die "can't open temp file: $!\n";
5385 print $lh $conf->config_binary('logo.eps', $self->agentnum)
5386 or die "can't write temp file: $!\n";
5388 $letter_data{'logo_file'} = $lh->filename;
5390 my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5394 ) or die "can't open temp file: $!\n";
5396 $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5398 $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5399 return ($1, $letter_data{'logo_file'});
5403 =item print_ps TEMPLATE
5405 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5411 my($file, $lfile) = $self->generate_letter(@_);
5412 my $ps = FS::Misc::generate_ps($file);
5413 unlink($file.'.tex');
5419 =item print TEMPLATE
5421 Prints the filled in template.
5423 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5427 sub queueable_print {
5430 my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5431 or die "invalid customer number: " . $opt{custvnum};
5433 my $error = $self->print( $opt{template} );
5434 die $error if $error;
5438 my ($self, $template) = (shift, shift);
5439 do_print [ $self->print_ps($template) ];
5442 #these three subs should just go away once agent stuff is all config overrides
5444 sub agent_template {
5446 $self->_agent_plandata('agent_templatename');
5449 sub agent_invoice_from {
5451 $self->_agent_plandata('agent_invoice_from');
5454 sub _agent_plandata {
5455 my( $self, $option ) = @_;
5457 #yuck. this whole thing needs to be reconciled better with 1.9's idea of
5458 #agent-specific Conf
5460 use FS::part_event::Condition;
5462 my $agentnum = $self->agentnum;
5464 my $regexp = regexp_sql();
5466 my $part_event_option =
5468 'select' => 'part_event_option.*',
5469 'table' => 'part_event_option',
5471 LEFT JOIN part_event USING ( eventpart )
5472 LEFT JOIN part_event_option AS peo_agentnum
5473 ON ( part_event.eventpart = peo_agentnum.eventpart
5474 AND peo_agentnum.optionname = 'agentnum'
5475 AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5477 LEFT JOIN part_event_condition
5478 ON ( part_event.eventpart = part_event_condition.eventpart
5479 AND part_event_condition.conditionname = 'cust_bill_age'
5481 LEFT JOIN part_event_condition_option
5482 ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5483 AND part_event_condition_option.optionname = 'age'
5486 #'hashref' => { 'optionname' => $option },
5487 #'hashref' => { 'part_event_option.optionname' => $option },
5489 " WHERE part_event_option.optionname = ". dbh->quote($option).
5490 " AND action = 'cust_bill_send_agent' ".
5491 " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5492 " AND peo_agentnum.optionname = 'agentnum' ".
5493 " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5495 CASE WHEN part_event_condition_option.optionname IS NULL
5497 ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5499 , part_event.weight".
5503 unless ( $part_event_option ) {
5504 return $self->agent->invoice_template || ''
5505 if $option eq 'agent_templatename';
5509 $part_event_option->optionvalue;
5513 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5515 Subroutine (not a method), designed to be called from the queue.
5517 Takes a list of options and values.
5519 Pulls up the customer record via the custnum option and calls bill_and_collect.
5524 my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5526 my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5527 warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5529 $cust_main->bill_and_collect( %args );
5532 sub process_bill_and_collect {
5534 my $param = thaw(decode_base64(shift));
5535 my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5536 or die "custnum '$param->{custnum}' not found!\n";
5537 $param->{'job'} = $job;
5538 $param->{'fatal'} = 1; # runs from job queue, will be caught
5539 $param->{'retry'} = 1;
5541 $cust_main->bill_and_collect( %$param );
5544 sub _upgrade_data { #class method
5545 my ($class, %opts) = @_;
5547 my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
5548 my $sth = dbh->prepare($sql) or die dbh->errstr;
5549 $sth->execute or die $sth->errstr;
5551 local($ignore_expired_card) = 1;
5552 local($ignore_illegal_zip) = 1;
5553 local($ignore_illegal_zip) = 1;
5554 local($ignore_banned_card) = 1;
5555 $class->_upgrade_otaker(%opts);
5565 The delete method should possibly take an FS::cust_main object reference
5566 instead of a scalar customer number.
5568 Bill and collect options should probably be passed as references instead of a
5571 There should probably be a configuration file with a list of allowed credit
5574 No multiple currency support (probably a larger project than just this module).
5576 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5578 Birthdates rely on negative epoch values.
5580 The payby for card/check batches is broken. With mixed batching, bad
5583 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5587 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5588 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5589 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.