package FS::cust_main; require 5.006; use strict; use base qw( FS::otaker_Mixin FS::payinfo_Mixin FS::Record ); use vars qw( @EXPORT_OK $DEBUG $me $conf @encrypted_fields $import $ignore_expired_card $skip_fuzzyfiles @fuzzyfields @paytypes ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; use Exporter; use Scalar::Util qw( blessed ); use List::Util qw( min ); use Time::Local qw(timelocal); use Data::Dumper; use Tie::IxHash; use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; use File::Temp qw( tempfile ); use String::Approx qw(amatch); use Business::CreditCard 0.28; use Locale::Country; use FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Misc qw( generate_email send_email generate_ps do_print ); use FS::Msgcat qw(gettext); use FS::payby; use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_bill_pkg_display; use FS::cust_bill_pkg_tax_location; use FS::cust_bill_pkg_tax_rate_location; use FS::cust_pay; use FS::cust_pay_pending; use FS::cust_pay_void; use FS::cust_pay_batch; use FS::cust_credit; use FS::cust_refund; use FS::part_referral; use FS::cust_main_county; use FS::cust_location; use FS::cust_class; use FS::cust_main_exemption; use FS::cust_tax_adjustment; use FS::tax_rate; use FS::tax_rate_location; use FS::cust_tax_location; use FS::part_pkg_taxrate; use FS::agent; use FS::cust_main_invoice; use FS::cust_credit_bill; use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; use FS::part_pkg; use FS::part_event; use FS::part_event_condition; #use FS::cust_event; use FS::type_pkgs; use FS::payment_gateway; use FS::agent_payment_gateway; use FS::banned_pay; use FS::TicketSystem; @EXPORT_OK = qw( smart_search ); $realtime_bop_decline_quiet = 0; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations # 3 is even more information including possibly sensitive data $DEBUG = 0; $me = '[FS::cust_main]'; $import = 0; $ignore_expired_card = 0; $skip_fuzzyfiles = 0; @fuzzyfields = ( 'first', 'last', 'company', 'address1' ); @encrypted_fields = ('payinfo', 'paycvv'); sub nohistory_fields { ('paycvv'); } @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings'); #ask FS::UID to run this stuff for us later #$FS::UID::callback{'FS::cust_main'} = sub { install_callback FS::UID sub { $conf = new FS::Conf; #yes, need it for stuff below (prolly should be cached) }; sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; if ( exists $hashref->{'pkgnum'} ) { #@{ $self->{'_pkgnum'} } = (); my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum}); $self->{'_pkgnum'} = $subcache; #push @{ $self->{'_pkgnum'} }, FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum}; } } =head1 NAME FS::cust_main - Object methods for cust_main records =head1 SYNOPSIS use FS::cust_main; $record = new FS::cust_main \%hash; $record = new FS::cust_main { 'column' => 'value' }; $error = $record->insert; $error = $new_record->replace($old_record); $error = $record->delete; $error = $record->check; @cust_pkg = $record->all_pkgs; @cust_pkg = $record->ncancelled_pkgs; @cust_pkg = $record->suspended_pkgs; $error = $record->bill; $error = $record->bill %options; $error = $record->bill 'time' => $time; $error = $record->collect; $error = $record->collect %options; $error = $record->collect 'invoice_time' => $time, ; =head1 DESCRIPTION An FS::cust_main object represents a customer. FS::cust_main inherits from FS::Record. The following fields are currently supported: =over 4 =item custnum Primary key (assigned automatically for new customers) =item agentnum Agent (see L) =item refnum Advertising source (see L) =item first First name =item last Last name =item ss Cocial security number (optional) =item company (optional) =item address1 =item address2 (optional) =item city =item county (optional, see L) =item state (see L) =item zip =item country (see L) =item daytime phone (optional) =item night phone (optional) =item fax phone (optional) =item ship_first Shipping first name =item ship_last Shipping last name =item ship_company (optional) =item ship_address1 =item ship_address2 (optional) =item ship_city =item ship_county (optional, see L) =item ship_state (see L) =item ship_zip =item ship_country (see L) =item ship_daytime phone (optional) =item ship_night phone (optional) =item ship_fax phone (optional) =item payby Payment Type (See L for valid payby values) =item payinfo Payment Information (See L for data format) =item paymask Masked payinfo (See L for how this works) =item paycvv 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 =item paydate Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy =item paystart_month Start date month (maestro/solo cards only) =item paystart_year Start date year (maestro/solo cards only) =item payissue Issue number (maestro/solo cards only) =item payname Name on card or billing name =item payip IP address from which payment information was received =item tax Tax exempt, empty or `Y' =item usernum Order taker (see L) =item comments Comments (optional) =item referral_custnum Referring customer number =item spool_cdr Enable individual CDR spooling, empty or `Y' =item dundate A suggestion to events (see L) to delay until this unix timestamp =item squelch_cdr Discourage individual CDR printing, empty or `Y' =back =head1 METHODS =over 4 =item new HASHREF Creates a new customer. To add the customer to the database, see L<"insert">. Note that this stores the hash reference, not a distinct copy of the hash it points to. You can ask the object for a copy with the I method. =cut sub table { 'cust_main'; } =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] Adds this customer to the database. If there is an error, returns the error, otherwise returns false. CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert method containing FS::cust_pkg and FS::svc_I objects, all records are inserted atomicly, or the transaction is rolled back. Passing an empty hash reference is equivalent to not supplying this parameter. There should be a better explanation of this, but until then, here's an example: use Tie::RefHash; tie %hash, 'Tie::RefHash'; #this part is important %hash = ( $cust_pkg => [ $svc_acct ], ... ); $cust_main->insert( \%hash ); INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will be set as the invoicing list (see L<"invoicing_list">). Errors return as expected and rollback the entire transaction; it is not necessary to call check_invoicing_list first. The invoicing_list is set after the records in the CUST_PKG_HASHREF above are inserted, so it is now possible to set an invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); Currently available options are: I, I and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). This can be used to defer provisioning until some action completes (such as running the customer's credit card successfully). The I option is deprecated. If I is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with the B method.) The I option can be set to an arrayref of tax names. FS::cust_main_exemption records will be created and inserted. =cut sub insert { my $self = shift; my $cust_pkgs = @_ ? shift : {}; my $invoicing_list = @_ ? shift : ''; my %options = @_; warn "$me insert called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; my $prepay_identifier = ''; my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0); my $payby = ''; if ( $self->payby eq 'PREPAY' ) { $self->payby('BILL'); $prepay_identifier = $self->payinfo; $self->payinfo(''); warn " looking up prepaid card $prepay_identifier\n" if $DEBUG > 1; my $error = $self->get_prepay( $prepay_identifier, 'amount_ref' => \$amount, 'seconds_ref' => \$seconds, 'upbytes_ref' => \$upbytes, 'downbytes_ref' => \$downbytes, 'totalbytes_ref' => \$totalbytes, ); if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "error applying prepaid card (transaction rolled back): $error"; return $error; } $payby = 'PREP' if $amount; } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) { $payby = $1; $self->payby('BILL'); $amount = $self->paid; } warn " inserting $self\n" if $DEBUG > 1; $self->signupdate(time) unless $self->signupdate; $self->auto_agent_custid() if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid; my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "inserting cust_main record (transaction rolled back): $error"; return $error; } warn " setting invoicing list\n" if $DEBUG > 1; if ( $invoicing_list ) { $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "checking invoicing_list (transaction rolled back): $error"; return $error; } $self->invoicing_list( $invoicing_list ); } warn " setting cust_main_exemption\n" if $DEBUG > 1; my $tax_exemption = delete $options{'tax_exemption'}; if ( $tax_exemption ) { foreach my $taxname ( @$tax_exemption ) { my $cust_main_exemption = new FS::cust_main_exemption { 'custnum' => $self->custnum, 'taxname' => $taxname, }; my $error = $cust_main_exemption->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_main_exemption (transaction rolled back): $error"; } } } if ( $conf->config('cust_main-skeleton_tables') && $conf->config('cust_main-skeleton_custnum') ) { warn " inserting skeleton records\n" if $DEBUG > 1; my $error = $self->start_copy_skel; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } warn " ordering packages\n" if $DEBUG > 1; $error = $self->order_pkgs( $cust_pkgs, %options, 'seconds_ref' => \$seconds, 'upbytes_ref' => \$upbytes, 'downbytes_ref' => \$downbytes, 'totalbytes_ref' => \$totalbytes, ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } if ( $seconds ) { $dbh->rollback if $oldAutoCommit; return "No svc_acct record to apply pre-paid time"; } if ( $upbytes || $downbytes || $totalbytes ) { $dbh->rollback if $oldAutoCommit; return "No svc_acct record to apply pre-paid data"; } if ( $amount ) { warn " inserting initial $payby payment of $amount\n" if $DEBUG > 1; $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting payment (transaction rolled back): $error"; } } unless ( $import || $skip_fuzzyfiles ) { warn " queueing fuzzyfiles update\n" if $DEBUG > 1; $error = $self->queue_fuzzyfiles_update; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "updating fuzzy search cache: $error"; } } warn " insert complete; committing transaction\n" if $DEBUG > 1; $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } use File::CounterFile; sub auto_agent_custid { my $self = shift; my $format = $conf->config('cust_main-auto_agent_custid'); my $agent_custid; if ( $format eq '1YMMXXXXXXXX' ) { my $counter = new File::CounterFile 'cust_main.agent_custid'; $counter->lock; my $ym = 100000000000 + time2str('%y%m00000000', time); if ( $ym > $counter->value ) { $counter->{'value'} = $agent_custid = $ym; $counter->{'updated'} = 1; } else { $agent_custid = $counter->inc; } $counter->unlock; } else { die "Unknown cust_main-auto_agent_custid format: $format"; } $self->agent_custid($agent_custid); } sub start_copy_skel { my $self = shift; #'mg_user_preference' => {}, #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, }, #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' }, #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' }, #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } }, my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables'))); die $@ if $@; _copy_skel( 'cust_main', #tablename $conf->config('cust_main-skeleton_custnum'), #sourceid $self->custnum, #destid @tables, #child tables ); } #recursive subroutine, not a method sub _copy_skel { my( $table, $sourceid, $destid, %child_tables ) = @_; my $primary_key; if ( $table =~ /^(\w+)\.(\w+)$/ ) { ( $table, $primary_key ) = ( $1, $2 ); } else { my $dbdef_table = dbdef->table($table); $primary_key = $dbdef_table->primary_key or return "$table has no primary key". " (or do you need to run dbdef-create?)"; } warn " _copy_skel: $table.$primary_key $sourceid to $destid for ". join (', ', keys %child_tables). "\n" if $DEBUG > 2; foreach my $child_table_def ( keys %child_tables ) { my $child_table; my $child_pkey = ''; if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) { ( $child_table, $child_pkey ) = ( $1, $2 ); } else { $child_table = $child_table_def; $child_pkey = dbdef->table($child_table)->primary_key; # or return "$table has no primary key". # " (or do you need to run dbdef-create?)\n"; } my $sequence = ''; if ( keys %{ $child_tables{$child_table_def} } ) { return "$child_table has no primary key". " (run dbdef-create or try specifying it?)\n" unless $child_pkey; #false laziness w/Record::insert and only works on Pg #refactor the proper last-inserted-id stuff out of Record::insert if this # ever gets use for anything besides a quick kludge for one customer my $default = dbdef->table($child_table)->column($child_pkey)->default; $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i or return "can't parse $child_table.$child_pkey default value ". " for sequence name: $default"; $sequence = $1; } my @sel_columns = grep { $_ ne $primary_key } dbdef->table($child_table)->columns; my $sel_columns = join(', ', @sel_columns ); my @ins_columns = grep { $_ ne $child_pkey } @sel_columns; my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) '; my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) '; my $sel_st = "SELECT $sel_columns FROM $child_table". " WHERE $primary_key = $sourceid"; warn " $sel_st\n" if $DEBUG > 2; my $sel_sth = dbh->prepare( $sel_st ) or return dbh->errstr; $sel_sth->execute or return $sel_sth->errstr; while ( my $row = $sel_sth->fetchrow_hashref ) { warn " selected row: ". join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n" if $DEBUG > 2; my $statement = "INSERT INTO $child_table $ins_columns VALUES $placeholders"; my $ins_sth =dbh->prepare($statement) or return dbh->errstr; my @param = ( $destid, map $row->{$_}, @ins_columns ); warn " $statement: [ ". join(', ', @param). " ]\n" if $DEBUG > 2; $ins_sth->execute( @param ) or return $ins_sth->errstr; #next unless keys %{ $child_tables{$child_table} }; next unless $sequence; #another section of that laziness my $seq_sql = "SELECT currval('$sequence')"; my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr; $seq_sth->execute or return $seq_sth->errstr; my $insertid = $seq_sth->fetchrow_arrayref->[0]; # don't drink soap! recurse! recurse! okay! my $error = _copy_skel( $child_table_def, $row->{$child_pkey}, #sourceid $insertid, #destid %{ $child_tables{$child_table_def} }, ); return $error if $error; } } return ''; } =item order_pkg HASHREF | OPTION => VALUE ... Orders a single package. Options may be passed as a list of key/value pairs or as a hash reference. Options are: =over 4 =item cust_pkg FS::cust_pkg object =item cust_location Optional FS::cust_location object =item svcs Optional arryaref of FS::svc_* service objects. =item depend_jobnum If this option is set to a job queue jobnum (see L), all provisioning jobs will have a dependancy on the supplied job (they will not run until the specific job completes). This can be used to defer provisioning until some action completes (such as running the customer's credit card successfully). =item ticket_subject Optional subject for a ticket created and attached to this customer =item ticket_subject Optional queue name for ticket additions =back =cut sub order_pkg { my $self = shift; my $opt = ref($_[0]) ? shift : { @_ }; warn "$me order_pkg called with options ". join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n" if $DEBUG; my $cust_pkg = $opt->{'cust_pkg'}; my $svcs = $opt->{'svcs'} || []; my %svc_options = (); $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'} if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'}; my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () } qw( ticket_subject ticket_queue ); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; if ( $opt->{'cust_location'} && ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) { my $error = $opt->{'cust_location'}->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_location (transaction rolled back): $error"; } $cust_pkg->locationnum($opt->{'cust_location'}->locationnum); } $cust_pkg->custnum( $self->custnum ); my $error = $cust_pkg->insert( %insert_params ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_pkg (transaction rolled back): $error"; } foreach my $svc_something ( @{ $opt->{'svcs'} } ) { if ( $svc_something->svcnum ) { my $old_cust_svc = $svc_something->cust_svc; my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash }; $new_cust_svc->pkgnum( $cust_pkg->pkgnum); $error = $new_cust_svc->replace($old_cust_svc); } else { $svc_something->pkgnum( $cust_pkg->pkgnum ); if ( $svc_something->isa('FS::svc_acct') ) { foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } } qw( seconds upbytes downbytes totalbytes ) ) { $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } ); ${ $opt->{$_.'_ref'} } = 0; } } $error = $svc_something->insert(%svc_options); } if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting svc_ (transaction rolled back): $error"; } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ] =item order_pkgs HASHREF [ , OPTION => VALUE ... ] Like the insert method on an existing record, this method orders multiple packages and included services atomicaly. Pass a Tie::RefHash data structure to this method containing FS::cust_pkg and FS::svc_I objects. There should be a better explanation of this, but until then, here's an example: use Tie::RefHash; tie %hash, 'Tie::RefHash'; #this part is important %hash = ( $cust_pkg => [ $svc_acct ], ... ); $cust_main->order_pkgs( \%hash, 'noexport'=>1 ); Services can be new, in which case they are inserted, or existing unaudited services, in which case they are linked to the newly-created package. Currently available options are: I, I, I, I, I, and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). This can be used to defer provisioning until some action completes (such as running the customer's credit card successfully). The I option is deprecated. If I is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with the B method for each cust_pkg object. Using the B method on the cust_main object is not recommended, as existing services will also be reexported.) If I, I, I, or I is provided, the scalars (provided by references) will be incremented by the values of the prepaid card.` =cut sub order_pkgs { my $self = shift; my $cust_pkgs = shift; my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated my %options = @_; $seconds_ref ||= $options{'seconds_ref'}; warn "$me order_pkgs called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; foreach my $cust_pkg ( keys %$cust_pkgs ) { my $error = $self->order_pkg( 'cust_pkg' => $cust_pkg, 'svcs' => $cust_pkgs->{$cust_pkg}, 'seconds_ref' => $seconds_ref, map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref depend_jobnum ) ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ] Recharges this (existing) customer with the specified prepaid card (see L), specified either by I or as an FS::prepay_credit object. If there is an error, returns the error, otherwise returns false. Optionally, five scalar references can be passed as well. They will have their values filled in with the amount, number of seconds, and number of upload, download, and total bytes applied by this prepaid card. =cut #the ref bullshit here should be refactored like get_prepay. MyAccount.pm is #the only place that uses these args sub recharge_prepay { my( $self, $prepay_credit, $amountref, $secondsref, $upbytesref, $downbytesref, $totalbytesref ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 ); my $error = $self->get_prepay( $prepay_credit, 'amount_ref' => \$amount, 'seconds_ref' => \$seconds, 'upbytes_ref' => \$upbytes, 'downbytes_ref' => \$downbytes, 'totalbytes_ref' => \$totalbytes, ) || $self->increment_seconds($seconds) || $self->increment_upbytes($upbytes) || $self->increment_downbytes($downbytes) || $self->increment_totalbytes($totalbytes) || $self->insert_cust_pay_prepay( $amount, ref($prepay_credit) ? $prepay_credit->identifier : $prepay_credit ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } if ( defined($amountref) ) { $$amountref = $amount; } if ( defined($secondsref) ) { $$secondsref = $seconds; } if ( defined($upbytesref) ) { $$upbytesref = $upbytes; } if ( defined($downbytesref) ) { $$downbytesref = $downbytes; } if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ] Looks up and deletes a prepaid card (see L), specified either by I or as an FS::prepay_credit object. Available options are: I, I, I, I, and I. The scalars (provided by references) will be incremented by the values of the prepaid card. If the prepaid card specifies an I (see L), it is used to check or set this customer's I. If there is an error, returns the error, otherwise returns false. =cut sub get_prepay { my( $self, $prepay_credit, %opt ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; unless ( ref($prepay_credit) ) { my $identifier = $prepay_credit; $prepay_credit = qsearchs( 'prepay_credit', { 'identifier' => $prepay_credit }, '', 'FOR UPDATE' ); unless ( $prepay_credit ) { $dbh->rollback if $oldAutoCommit; return "Invalid prepaid card: ". $identifier; } } if ( $prepay_credit->agentnum ) { if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) { $dbh->rollback if $oldAutoCommit; return "prepaid card not valid for agent ". $self->agentnum; } $self->agentnum($prepay_credit->agentnum); } my $error = $prepay_credit->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "removing prepay_credit (transaction rolled back): $error"; } ${ $opt{$_.'_ref'} } += $prepay_credit->$_() for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes ); $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } =item increment_upbytes SECONDS Updates this customer's single or primary account (see L) by the specified number of upbytes. If there is an error, returns the error, otherwise returns false. =cut sub increment_upbytes { _increment_column( shift, 'upbytes', @_); } =item increment_downbytes SECONDS Updates this customer's single or primary account (see L) by the specified number of downbytes. If there is an error, returns the error, otherwise returns false. =cut sub increment_downbytes { _increment_column( shift, 'downbytes', @_); } =item increment_totalbytes SECONDS Updates this customer's single or primary account (see L) by the specified number of totalbytes. If there is an error, returns the error, otherwise returns false. =cut sub increment_totalbytes { _increment_column( shift, 'totalbytes', @_); } =item increment_seconds SECONDS Updates this customer's single or primary account (see L) by the specified number of seconds. If there is an error, returns the error, otherwise returns false. =cut sub increment_seconds { _increment_column( shift, 'seconds', @_); } =item _increment_column AMOUNT Updates this customer's single or primary account (see L) by the specified number of seconds or bytes. If there is an error, returns the error, otherwise returns false. =cut sub _increment_column { my( $self, $column, $amount ) = @_; warn "$me increment_column called: $column, $amount\n" if $DEBUG; return '' unless $amount; my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') } $self->ncancelled_pkgs; if ( ! @cust_pkg ) { return 'No packages with primary or single services found'. ' to apply pre-paid time'; } elsif ( scalar(@cust_pkg) > 1 ) { #maybe have a way to specify the package/account? return 'Multiple packages found to apply pre-paid time'; } my $cust_pkg = $cust_pkg[0]; warn " found package pkgnum ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; my @cust_svc = $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') ); if ( ! @cust_svc ) { return 'No account found to apply pre-paid time'; } elsif ( scalar(@cust_svc) > 1 ) { return 'Multiple accounts found to apply pre-paid time'; } my $svc_acct = $cust_svc[0]->svc_x; warn " found service svcnum ". $svc_acct->pkgnum. ' ('. $svc_acct->email. ")\n" if $DEBUG > 1; $column = "increment_$column"; $svc_acct->$column($amount); } =item insert_cust_pay_prepay AMOUNT [ PAYINFO ] Inserts a prepayment in the specified amount for this customer. An optional second argument can specify the prepayment identifier for tracking purposes. If there is an error, returns the error, otherwise returns false. =cut sub insert_cust_pay_prepay { shift->insert_cust_pay('PREP', @_); } =item insert_cust_pay_cash AMOUNT [ PAYINFO ] Inserts a cash payment in the specified amount for this customer. An optional second argument can specify the payment identifier for tracking purposes. If there is an error, returns the error, otherwise returns false. =cut sub insert_cust_pay_cash { shift->insert_cust_pay('CASH', @_); } =item insert_cust_pay_west AMOUNT [ PAYINFO ] Inserts a Western Union payment in the specified amount for this customer. An optional second argument can specify the prepayment identifier for tracking purposes. If there is an error, returns the error, otherwise returns false. =cut sub insert_cust_pay_west { shift->insert_cust_pay('WEST', @_); } sub insert_cust_pay { my( $self, $payby, $amount ) = splice(@_, 0, 3); my $payinfo = scalar(@_) ? shift : ''; my $cust_pay = new FS::cust_pay { 'custnum' => $self->custnum, 'paid' => sprintf('%.2f', $amount), #'_date' => #date the prepaid card was purchased??? 'payby' => $payby, 'payinfo' => $payinfo, }; $cust_pay->insert; } =item reexport This method is deprecated. See the I option to the insert and order_pkgs methods for a better way to defer provisioning. Re-schedules all exports by calling the B method of all associated packages (see L). If there is an error, returns the error; otherwise returns false. =cut sub reexport { my $self = shift; carp "WARNING: FS::cust_main::reexport is deprectated; ". "use the depend_jobnum option to insert or order_pkgs to delay export"; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; foreach my $cust_pkg ( $self->ncancelled_pkgs ) { my $error = $cust_pkg->reexport; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } =item delete NEW_CUSTNUM This deletes the customer. If there is an error, returns the error, otherwise returns false. This will completely remove all traces of the customer record. This is not what you want when a customer cancels service; for that, cancel all of the customer's packages (see L). If the customer has any uncancelled packages, you need to pass a new (valid) customer number for those packages to be transferred to. Cancelled packages will be deleted. Did I mention that this is NOT what you want when a customer cancels service and that you really should be looking see L? You can't delete a customer with invoices (see L), or credits (see L), payments (see L) or refunds (see L). =cut sub delete { my $self = shift; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; if ( $self->cust_bill ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with invoices"; } if ( $self->cust_credit ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with credits"; } if ( $self->cust_pay ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with payments"; } if ( $self->cust_refund ) { $dbh->rollback if $oldAutoCommit; return "Can't delete a customer with refunds"; } my @cust_pkg = $self->ncancelled_pkgs; if ( @cust_pkg ) { my $new_custnum = shift; unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { $dbh->rollback if $oldAutoCommit; return "Invalid new customer number: $new_custnum"; } foreach my $cust_pkg ( @cust_pkg ) { my %hash = $cust_pkg->hash; $hash{'custnum'} = $new_custnum; my $new_cust_pkg = new FS::cust_pkg ( \%hash ); my $error = $new_cust_pkg->replace($cust_pkg, options => { $cust_pkg->options }, ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } } my @cancelled_cust_pkg = $self->all_pkgs; foreach my $cust_pkg ( @cancelled_cust_pkg ) { my $error = $cust_pkg->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } foreach my $cust_main_invoice ( #(email invoice destinations, not invoices) qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) ) { my $error = $cust_main_invoice->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } foreach my $cust_main_exemption ( qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } ) ) { my $error = $cust_main_exemption->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } my $error = $self->SUPER::delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ] Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will be set as the invoicing list (see L<"invoicing_list">). Errors return as expected and rollback the entire transaction; it is not necessary to call check_invoicing_list first. Here's an example: $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); Currently available options are: I. The I option can be set to an arrayref of tax names. FS::cust_main_exemption records will be deleted and inserted as appropriate. =cut sub replace { my $self = shift; my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) ? shift : $self->replace_old; my @param = @_; warn "$me replace called\n" if $DEBUG; my $curuser = $FS::CurrentUser::CurrentUser; if ( $self->payby eq 'COMP' && $self->payby ne $old->payby && ! $curuser->access_right('Complimentary customer') ) { return "You are not permitted to create complimentary accounts."; } local($ignore_expired_card) = 1 if $old->payby =~ /^(CARD|DCRD)$/ && $self->payby =~ /^(CARD|DCRD)$/ && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; my $error = $self->SUPER::replace($old); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF my $invoicing_list = shift @param; $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } $self->invoicing_list( $invoicing_list ); } my %options = @param; my $tax_exemption = delete $options{'tax_exemption'}; if ( $tax_exemption ) { my %cust_main_exemption = map { $_->taxname => $_ } qsearch('cust_main_exemption', { 'custnum' => $old->custnum } ); foreach my $taxname ( @$tax_exemption ) { next if delete $cust_main_exemption{$taxname}; my $cust_main_exemption = new FS::cust_main_exemption { 'custnum' => $self->custnum, 'taxname' => $taxname, }; my $error = $cust_main_exemption->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting cust_main_exemption (transaction rolled back): $error"; } } foreach my $cust_main_exemption ( values %cust_main_exemption ) { my $error = $cust_main_exemption->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "deleting cust_main_exemption (transaction rolled back): $error"; } } } if ( $self->payby =~ /^(CARD|CHEK|LECB)$/ && grep { $self->get($_) ne $old->get($_) } qw(payinfo paydate payname) ) { # card/check/lec info has changed, want to retry realtime_ invoice events my $error = $self->retry_realtime; if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } } unless ( $import || $skip_fuzzyfiles ) { $error = $self->queue_fuzzyfiles_update; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "updating fuzzy search cache: $error"; } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } =item queue_fuzzyfiles_update Used by insert & replace to update the fuzzy search cache =cut sub queue_fuzzyfiles_update { my $self = shift; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; my $error = $queue->insert( map $self->getfield($_), @fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } if ( $self->ship_last ) { $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } =item check Checks all fields to make sure this is a valid customer record. If there is an error, returns the error, otherwise returns false. Called by the insert and replace methods. =cut sub check { my $self = shift; warn "$me check BEFORE: \n". $self->_dump if $DEBUG > 2; my $error = $self->ut_numbern('custnum') || $self->ut_number('agentnum') || $self->ut_textn('agent_custid') || $self->ut_number('refnum') || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum') || $self->ut_textn('custbatch') || $self->ut_name('last') || $self->ut_name('first') || $self->ut_snumbern('birthdate') || $self->ut_snumbern('signupdate') || $self->ut_textn('company') || $self->ut_text('address1') || $self->ut_textn('address2') || $self->ut_text('city') || $self->ut_textn('county') || $self->ut_textn('state') || $self->ut_country('country') || $self->ut_anything('comments') || $self->ut_numbern('referral_custnum') || $self->ut_textn('stateid') || $self->ut_textn('stateid_state') || $self->ut_textn('invoice_terms') || $self->ut_alphan('geocode') || $self->ut_floatn('cdr_termination_percentage') ; #barf. need message catalogs. i18n. etc. $error .= "Please select an advertising source." if $error =~ /^Illegal or empty \(numeric\) refnum: /; return $error if $error; return "Unknown agent" unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); return "Unknown refnum" unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); return "Unknown referring custnum: ". $self->referral_custnum unless ! $self->referral_custnum || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); if ( $self->censustract ne '' ) { $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/ or return "Illegal census tract: ". $self->censustract; $self->censustract("$1.$2"); } if ( $self->ss eq '' ) { $self->ss(''); } else { my $ss = $self->ss; $ss =~ s/\D//g; $ss =~ /^(\d{3})(\d{2})(\d{4})$/ or return "Illegal social security number: ". $self->ss; $self->ss("$1-$2-$3"); } # bad idea to disable, causes billing to fail because of no tax rates later # unless ( $import ) { unless ( qsearch('cust_main_county', { 'country' => $self->country, 'state' => '', } ) ) { return "Unknown state/county/country: ". $self->state. "/". $self->county. "/". $self->country unless qsearch('cust_main_county',{ 'state' => $self->state, 'county' => $self->county, 'country' => $self->country, } ); } # } $error = $self->ut_phonen('daytime', $self->country) || $self->ut_phonen('night', $self->country) || $self->ut_phonen('fax', $self->country) || $self->ut_zip('zip', $self->country) ; return $error if $error; if ( $conf->exists('cust_main-require_phone') && ! length($self->daytime) && ! length($self->night) ) { my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/ ? 'Day Phone' : FS::Msgcat::_gettext('daytime'); my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/ ? 'Night Phone' : FS::Msgcat::_gettext('night'); return "$daytime_label or $night_label is required" } if ( $self->has_ship_address && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } $self->addr_fields ) ) { my $error = $self->ut_name('ship_last') || $self->ut_name('ship_first') || $self->ut_textn('ship_company') || $self->ut_text('ship_address1') || $self->ut_textn('ship_address2') || $self->ut_text('ship_city') || $self->ut_textn('ship_county') || $self->ut_textn('ship_state') || $self->ut_country('ship_country') ; return $error if $error; #false laziness with above unless ( qsearchs('cust_main_county', { 'country' => $self->ship_country, 'state' => '', } ) ) { return "Unknown ship_state/ship_county/ship_country: ". $self->ship_state. "/". $self->ship_county. "/". $self->ship_country unless qsearch('cust_main_county',{ 'state' => $self->ship_state, 'county' => $self->ship_county, 'country' => $self->ship_country, } ); } #eofalse $error = $self->ut_phonen('ship_daytime', $self->ship_country) || $self->ut_phonen('ship_night', $self->ship_country) || $self->ut_phonen('ship_fax', $self->ship_country) || $self->ut_zip('ship_zip', $self->ship_country) ; return $error if $error; return "Unit # is required." if $self->ship_address2 =~ /^\s*$/ && $conf->exists('cust_main-require_address2'); } else { # ship_ info eq billing info, so don't store dup info in database $self->setfield("ship_$_", '') foreach $self->addr_fields; return "Unit # is required." if $self->address2 =~ /^\s*$/ && $conf->exists('cust_main-require_address2'); } #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ # or return "Illegal payby: ". $self->payby; #$self->payby($1); FS::payby->can_payby($self->table, $self->payby) or return "Illegal payby: ". $self->payby; $error = $self->ut_numbern('paystart_month') || $self->ut_numbern('paystart_year') || $self->ut_numbern('payissue') || $self->ut_textn('paytype') ; return $error if $error; if ( $self->payip eq '' ) { $self->payip(''); } else { $error = $self->ut_ip('payip'); return $error if $error; } # If it is encrypted and the private key is not availaible then we can't # check the credit card. my $check_payinfo = 1; if ($self->is_encrypted($self->payinfo)) { $check_payinfo = 0; } if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; $payinfo =~ /^(\d{13,16})$/ or return gettext('invalid_card'); # . ": ". $self->payinfo; $payinfo = $1; $self->payinfo($payinfo); validate($payinfo) or return gettext('invalid_card'); # . ": ". $self->payinfo; return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); if ( $ban ) { return 'Banned credit card: banned on '. time2str('%a %h %o at %r', $ban->_date). ' by '. $ban->otaker. ' (ban# '. $ban->bannum. ')'; } if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { if ( cardtype($self->payinfo) eq 'American Express card' ) { $self->paycvv =~ /^(\d{4})$/ or return "CVV2 (CID) for American Express cards is four digits."; $self->paycvv($1); } else { $self->paycvv =~ /^(\d{3})$/ or return "CVV2 (CVC2/CID) is three digits."; $self->paycvv($1); } } else { $self->paycvv(''); } my $cardtype = cardtype($payinfo); if ( $cardtype =~ /^(Switch|Solo)$/i ) { return "Start date or issue number is required for $cardtype cards" unless $self->paystart_month && $self->paystart_year or $self->payissue; return "Start month must be between 1 and 12" if $self->paystart_month and $self->paystart_month < 1 || $self->paystart_month > 12; return "Start year must be 1990 or later" if $self->paystart_year and $self->paystart_year < 1990; return "Issue number must be beween 1 and 99" if $self->payissue and $self->payissue < 1 || $self->payissue > 99; } else { $self->paystart_month(''); $self->paystart_year(''); $self->payissue(''); } } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/[^\d\@]//g; if ( $conf->exists('echeck-nonus') ) { $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; $payinfo = "$1\@$2"; } else { $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; $payinfo = "$1\@$2"; } $self->payinfo($payinfo); $self->paycvv(''); my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); if ( $ban ) { return 'Banned ACH account: banned on '. time2str('%a %h %o at %r', $ban->_date). ' by '. $ban->otaker. ' (ban# '. $ban->bannum. ')'; } } elsif ( $self->payby eq 'LECB' ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number'; $payinfo = $1; $self->payinfo($payinfo); $self->paycvv(''); } elsif ( $self->payby eq 'BILL' ) { $error = $self->ut_textn('payinfo'); return "Illegal P.O. number: ". $self->payinfo if $error; $self->paycvv(''); } elsif ( $self->payby eq 'COMP' ) { my $curuser = $FS::CurrentUser::CurrentUser; if ( ! $self->custnum && ! $curuser->access_right('Complimentary customer') ) { return "You are not permitted to create complimentary accounts." } $error = $self->ut_textn('payinfo'); return "Illegal comp account issuer: ". $self->payinfo if $error; $self->paycvv(''); } elsif ( $self->payby eq 'PREPAY' ) { my $payinfo = $self->payinfo; $payinfo =~ s/\W//g; #anything else would just confuse things $self->payinfo($payinfo); $error = $self->ut_alpha('payinfo'); return "Illegal prepayment identifier: ". $self->payinfo if $error; return "Unknown prepayment identifier" unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); $self->paycvv(''); } if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expiration date required" unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; $self->paydate(''); } else { my( $m, $y ); if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) { ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" ); } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { ( $m, $y ) = ( $2, "19$1" ); } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) { ( $m, $y ) = ( $3, "20$2" ); } else { return "Illegal expiration date: ". $self->paydate; } $self->paydate("$y-$m-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') if !$import && !$ignore_expired_card && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && ( ! $conf->exists('require_cardname') || $self->payby !~ /^(CARD|DCRD)$/ ) ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { $self->payname =~ /^([\w \,\.\-\'\&]+)$/ or return gettext('illegal_name'). " payname: ". $self->payname; $self->payname($1); } foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) { $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); $self->$flag($1); } $self->otaker(getotaker) unless $self->otaker; warn "$me check AFTER: \n". $self->_dump if $DEBUG > 2; $self->SUPER::check; } =item addr_fields Returns a list of fields which have ship_ duplicates. =cut sub addr_fields { qw( last first company address1 address2 city county state zip country daytime night fax ); } =item has_ship_address Returns true if this customer record has a separate shipping address. =cut sub has_ship_address { my $self = shift; scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields ); } =item location_hash Returns a list of key/value pairs, with the following keys: address1, adddress2, city, county, state, zip, country. The shipping address is used if present. =cut #geocode? dependent on tax-ship_address config, not available in cust_location #mostly. not yet then. sub location_hash { my $self = shift; my $prefix = $self->has_ship_address ? 'ship_' : ''; map { $_ => $self->get($prefix.$_) } qw( address1 address2 city county state zip country geocode ); #fields that cust_location has } =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all packages (see L) for this customer. =cut sub all_pkgs { my $self = shift; my $extra_qsearch = ref($_[0]) ? shift : {}; return $self->num_pkgs unless wantarray || keys(%$extra_qsearch); my @cust_pkg = (); if ( $self->{'_pkgnum'} ) { @cust_pkg = values %{ $self->{'_pkgnum'}->cache }; } else { @cust_pkg = $self->_cust_pkg($extra_qsearch); } sort sort_packages @cust_pkg; } =item cust_pkg Synonym for B. =cut sub cust_pkg { shift->all_pkgs(@_); } =item cust_location Returns all locations (see L) for this customer. =cut sub cust_location { my $self = shift; qsearch('cust_location', { 'custnum' => $self->custnum } ); } =item location_label [ OPTION => VALUE ... ] Returns the label of the service location (see analog in L) for this customer. Options are =over 4 =item join_string used to separate the address elements (defaults to ', ') =item escape_function a callback used for escaping the text of the address elements =back =cut # false laziness with FS::cust_location::line sub location_label { my $self = shift; my %opt = @_; my $separator = $opt{join_string} || ', '; my $escape = $opt{escape_function} || sub{ shift }; my $line = ''; my $cydefault = FS::conf->new->config('countrydefault') || 'US'; my $prefix = length($self->ship_last) ? 'ship_' : ''; my $notfirst = 0; foreach (qw ( address1 address2 ) ) { my $method = "$prefix$_"; $line .= ($notfirst ? $separator : ''). &$escape($self->$method) if $self->$method; $notfirst++; } $notfirst = 0; foreach (qw ( city county state zip ) ) { my $method = "$prefix$_"; if ( $self->$method ) { $line .= ' (' if $method eq 'county'; $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method); $line .= ' )' if $method eq 'county'; $notfirst++; } } $line .= $separator. &$escape(code2country($self->country)) if $self->country ne $cydefault; $line; } =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all non-cancelled packages (see L) for this customer. =cut sub ncancelled_pkgs { my $self = shift; my $extra_qsearch = ref($_[0]) ? shift : {}; return $self->num_ncancelled_pkgs unless wantarray; my @cust_pkg = (); if ( $self->{'_pkgnum'} ) { warn "$me ncancelled_pkgs: returning cached objects" if $DEBUG > 1; @cust_pkg = grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache }; } else { warn "$me ncancelled_pkgs: searching for packages with custnum ". $self->custnum. "\n" if $DEBUG > 1; $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) '; @cust_pkg = $self->_cust_pkg($extra_qsearch); } sort sort_packages @cust_pkg; } sub _cust_pkg { my $self = shift; my $extra_qsearch = ref($_[0]) ? shift : {}; $extra_qsearch->{'select'} ||= '*'; $extra_qsearch->{'select'} .= ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum ) AS _num_cust_svc'; map { $_->{'_num_cust_svc'} = $_->get('_num_cust_svc'); $_; } qsearch({ %$extra_qsearch, 'table' => 'cust_pkg', 'hashref' => { 'custnum' => $self->custnum }, }); } # This should be generalized to use config options to determine order. sub sort_packages { my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 ); return $locationsort if $locationsort; if ( $a->get('cancel') xor $b->get('cancel') ) { return -1 if $b->get('cancel'); return 1 if $a->get('cancel'); #shouldn't get here... return 0; } else { my $a_num_cust_svc = $a->num_cust_svc; my $b_num_cust_svc = $b->num_cust_svc; return 0 if !$a_num_cust_svc && !$b_num_cust_svc; return -1 if $a_num_cust_svc && !$b_num_cust_svc; return 1 if !$a_num_cust_svc && $b_num_cust_svc; my @a_cust_svc = $a->cust_svc; my @b_cust_svc = $b->cust_svc; $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label; } } =item suspended_pkgs Returns all suspended packages (see L) for this customer. =cut sub suspended_pkgs { my $self = shift; grep { $_->susp } $self->ncancelled_pkgs; } =item unflagged_suspended_pkgs Returns all unflagged suspended packages (see L) for this customer (thouse packages without the `manual_flag' set). =cut sub unflagged_suspended_pkgs { my $self = shift; return $self->suspended_pkgs unless dbdef->table('cust_pkg')->column('manual_flag'); grep { ! $_->manual_flag } $self->suspended_pkgs; } =item unsuspended_pkgs Returns all unsuspended (and uncancelled) packages (see L) for this customer. =cut sub unsuspended_pkgs { my $self = shift; grep { ! $_->susp } $self->ncancelled_pkgs; } =item next_bill_date Returns the next date this customer will be billed, as a UNIX timestamp, or undef if no active package has a next bill date. =cut sub next_bill_date { my $self = shift; min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs ); } =item num_cancelled_pkgs Returns the number of cancelled packages (see L) for this customer. =cut sub num_cancelled_pkgs { shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"); } sub num_ncancelled_pkgs { shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )"); } sub num_pkgs { my( $self ) = shift; my $sql = scalar(@_) ? shift : ''; $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i; my $sth = dbh->prepare( "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql" ) or die dbh->errstr; $sth->execute($self->custnum) or die $sth->errstr; $sth->fetchrow_arrayref->[0]; } =item unsuspend Unsuspends all unflagged suspended packages (see L and L) for this customer. Always returns a list: an empty list on success or a list of errors. =cut sub unsuspend { my $self = shift; grep { $_->unsuspend } $self->suspended_pkgs; } =item suspend Suspends all unsuspended packages (see L) for this customer. Returns a list: an empty list on success or a list of errors. =cut sub suspend { my $self = shift; grep { $_->suspend(@_) } $self->unsuspended_pkgs; } =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) matching the listed PKGPARTs (see L). Preferred usage is to pass a hashref instead of a list of pkgparts; the hashref has the following keys: =over 4 =item pkgparts - listref of pkgparts =item (other options are passed to the suspend method) =back Returns a list: an empty list on success or a list of errors. =cut sub suspend_if_pkgpart { my $self = shift; my (@pkgparts, %opt); if (ref($_[0]) eq 'HASH'){ @pkgparts = @{$_[0]{pkgparts}}; %opt = %{$_[0]}; }else{ @pkgparts = @_; } grep { $_->suspend(%opt) } grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } $self->unsuspended_pkgs; } =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) unless they match the given PKGPARTs (see L). Preferred usage is to pass a hashref instead of a list of pkgparts; the hashref has the following keys: =over 4 =item pkgparts - listref of pkgparts =item (other options are passed to the suspend method) =back Returns a list: an empty list on success or a list of errors. =cut sub suspend_unless_pkgpart { my $self = shift; my (@pkgparts, %opt); if (ref($_[0]) eq 'HASH'){ @pkgparts = @{$_[0]{pkgparts}}; %opt = %{$_[0]}; }else{ @pkgparts = @_; } grep { $_->suspend(%opt) } grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts } $self->unsuspended_pkgs; } =item cancel [ OPTION => VALUE ... ] Cancels all uncancelled packages (see L) for this customer. Available options are: =over 4 =item quiet - can be set true to supress email cancellation notices. =item reason - can be set to a cancellation reason (see L), 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, reason - Text of the new reason. =item ban - can be set true to ban this customer's credit card or ACH information, if present. =item nobill - can be set true to skip billing if it might otherwise be done. =back Always returns a list: an empty list on success or a list of errors. =cut # nb that dates are not specified as valid options to this method sub cancel { my( $self, %opt ) = @_; warn "$me cancel called on customer ". $self->custnum. " with options ". join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n" if $DEBUG; return ( 'access denied' ) unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { #should try decryption (we might have the private key) # and if not maybe queue a job for the server that does? return ( "Can't (yet) ban encrypted credit cards" ) if $self->is_encrypted($self->payinfo); my $ban = new FS::banned_pay $self->_banned_pay_hashref; my $error = $ban->insert; return ( $error ) if $error; } my @pkgs = $self->ncancelled_pkgs; if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) { $opt{nobill} = 1; my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 ); warn "Error billing during cancel, custnum ". $self->custnum. ": $error" if $error; } warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/". scalar(@pkgs). " packages for customer ". $self->custnum. "\n" if $DEBUG; grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs; } sub _banned_pay_hashref { my $self = shift; my %payby2ban = ( 'CARD' => 'CARD', 'DCRD' => 'CARD', 'CHEK' => 'CHEK', 'DCHK' => 'CHEK' ); { 'payby' => $payby2ban{$self->payby}, 'payinfo' => md5_base64($self->payinfo), #don't ever *search* on reason! #'reason' => }; } =item notes Returns all notes (see L) for this customer. =cut sub notes { my $self = shift; #order by? qsearch( 'cust_main_note', { 'custnum' => $self->custnum }, '', 'ORDER BY _DATE DESC' ); } =item agent Returns the agent (see L) for this customer. =cut sub agent { my $self = shift; qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } =item cust_class Returns the customer class, as an FS::cust_class object, or the empty string if there is no customer class. =cut sub cust_class { my $self = shift; if ( $self->classnum ) { qsearchs('cust_class', { 'classnum' => $self->classnum } ); } else { return ''; } } =item categoryname Returns the customer category name, or the empty string if there is no customer category. =cut sub categoryname { my $self = shift; my $cust_class = $self->cust_class; $cust_class ? $cust_class->categoryname : ''; } =item classname Returns the customer class name, or the empty string if there is no customer class. =cut sub classname { my $self = shift; my $cust_class = $self->cust_class; $cust_class ? $cust_class->classname : ''; } =item bill_and_collect Cancels and suspends any packages due, generates bills, applies payments and credits, and applies collection events to run cards, send bills and notices, etc. By default, warns on errors and continues with the next operation (but see the "fatal" flag below). Options are passed as name-value pairs. Currently available options are: =over 4 =item time Bills the customer as if it were that time. Specified as a UNIX timestamp; see L). Also see L and L for conversion functions. For example: use Date::Parse; ... $cust_main->bill( 'time' => str2time('April 20th, 2001') ); =item invoice_time Used in conjunction with the I