X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=ea523785a8cd460be3e556e08e725c800506c9a7;hb=357b4e26965895666685590d59f72de331fecb08;hp=65ccb343b9618c70b4fb05573664e24a987b8a16;hpb=c363307c1af959dce2ab4821ff5dfa697e3f0e19;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 65ccb343b..638036a15 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,39 +1,52 @@ package FS::cust_main; +require 5.006; use strict; use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields - $import $skip_fuzzyfiles $ignore_expired_card ); + $import $skip_fuzzyfiles $ignore_expired_card @paytypes); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; use Exporter; -BEGIN { - eval "use Time::Local;"; - die "Time::Local minimum version 1.05 required with Perl versions before 5.6" - if $] < 5.006 && !defined($Time::Local::VERSION); - #eval "use Time::Local qw(timelocal timelocal_nocheck);"; - eval "use Time::Local qw(timelocal_nocheck);"; -} +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::Parse; #use Date::Manip; +use File::Temp qw( tempfile ); use String::Approx qw(amatch); use Business::CreditCard 0.28; -use FS::UID qw( getotaker dbh ); +use Locale::Country; +use FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef ); -use FS::Misc qw( send_email ); +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_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; @@ -41,16 +54,17 @@ use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; use FS::part_pkg; -use FS::part_bill_event; -use FS::cust_bill_event; -use FS::cust_tax_exempt; -use FS::cust_tax_exempt_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::payinfo_Mixin; +use FS::TicketSystem; -@ISA = qw( FS::Record ); +@ISA = qw( FS::payinfo_Mixin FS::Record ); @EXPORT_OK = qw( smart_search ); @@ -67,6 +81,9 @@ $skip_fuzzyfiles = 0; $ignore_expired_card = 0; @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 { @@ -79,7 +96,7 @@ sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; if ( exists $hashref->{'pkgnum'} ) { -# #@{ $self->{'_pkgnum'} } = (); + #@{ $self->{'_pkgnum'} } = (); my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum}); $self->{'_pkgnum'} = $subcache; #push @{ $self->{'_pkgnum'} }, @@ -128,163 +145,181 @@ FS::Record. The following fields are currently supported: =over 4 -=item custnum - primary key (assigned automatically for new customers) +=item custnum + +Primary key (assigned automatically for new customers) + +=item agentnum + +Agent (see L) + +=item refnum + +Advertising source (see L) + +=item first -=item agentnum - agent (see L) +First name -=item refnum - Advertising source (see L) +=item last -=item first - name +Last name -=item last - name +=item ss -=item ss - social security number (optional) +Cocial security number (optional) -=item company - (optional) +=item company + +(optional) =item address1 -=item address2 - (optional) +=item address2 + +(optional) =item city -=item county - (optional, see L) +=item county + +(optional, see L) + +=item state -=item state - (see L) +(see L) =item zip -=item country - (see L) +=item country + +(see L) + +=item daytime + +phone (optional) + +=item night -=item daytime - phone (optional) +phone (optional) -=item night - phone (optional) +=item fax -=item fax - phone (optional) +phone (optional) -=item ship_first - name +=item ship_first -=item ship_last - name +Shipping first name -=item ship_company - (optional) +=item ship_last + +Shipping last name + +=item ship_company + +(optional) =item ship_address1 -=item ship_address2 - (optional) +=item ship_address2 + +(optional) =item ship_city -=item ship_county - (optional, see L) +=item ship_county -=item ship_state - (see L) +(optional, see L) + +=item ship_state + +(see L) =item ship_zip -=item ship_country - (see L) +=item ship_country -=item ship_daytime - phone (optional) +(see L) -=item ship_night - phone (optional) +=item ship_daytime -=item ship_fax - phone (optional) +phone (optional) -=item payby +=item ship_night -I (credit card - automatic), I (credit card - on-demand), I (electronic check - automatic), I (electronic check - on-demand), I (Phone bill billing), I (billing), I (free), or I (special billing type: applies a credit - see L and sets billing type to I) +phone (optional) -=item payinfo +=item ship_fax -Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) +phone (optional) -=cut +=item payby -sub payinfo { - my($self,$payinfo) = @_; - if ( defined($payinfo) ) { - $self->paymask($payinfo); - $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter' - } else { - $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter' - return $payinfo; - } -} +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 -=cut +=item paydate -=item paymask - Masked payment type +Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy -=over 4 +=item paystart_month -=item Credit Cards +Start date month (maestro/solo cards only) -Mask all but the last four characters. +=item paystart_year -=item Checks +Start date year (maestro/solo cards only) -Mask all but last 2 of account number and bank routing number. +=item payissue -=item Others +Issue number (maestro/solo cards only) -Do nothing, return the unmasked string. +=item payname -=back +Name on card or billing name -=cut +=item payip -sub paymask { - my($self,$value)=@_; +IP address from which payment information was received - # If it doesn't exist then generate it - my $paymask=$self->getfield('paymask'); - if (!defined($value) && (!defined($paymask) || $paymask eq '')) { - $value = $self->payinfo; - } +=item tax - if ( defined($value) && !$self->is_encrypted($value)) { - my $payinfo = $value; - my $payby = $self->payby; - if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four) - $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); - } elsif ($payby eq 'CHEK' || - $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank) - my( $account, $aba ) = split('@', $payinfo ); - $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba; - } else { # Tie up loose ends - $paymask = $payinfo; - } - $self->setfield('paymask', $paymask); # This is okay since we are the 'setter' - } elsif (defined($value) && $self->is_encrypted($value)) { - $paymask = 'N/A'; - } - return $paymask; -} +Tax exempt, empty or `Y' -=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy +=item otaker -=item paystart_month - start date month (maestro/solo cards only) +Order taker (assigned automatically, see L) -=item paystart_year - start date year (maestro/solo cards only) +=item comments -=item payissue - issue number (maestro/solo cards only) +Comments (optional) -=item payname - name on card or billing name +=item referral_custnum -=item payip - IP address from which payment information was received +Referring customer number -=item tax - tax exempt, empty or `Y' +=item spool_cdr -=item otaker - order taker (assigned automatically, see L) +Enable individual CDR spooling, empty or `Y' -=item comments - comments (optional) +=item dundate -=item referral_custnum - referring customer number +A suggestion to events (see L) to delay until this unix timestamp -=item spool_cdr - Enable individual CDR spooling, empty or `Y' +=item squelch_cdr + +Discourage individual CDR printing, empty or `Y' =back @@ -331,7 +366,7 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); -Currently available options are: I and I. +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). @@ -342,6 +377,9 @@ 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 { @@ -365,7 +403,7 @@ sub insert { my $dbh = dbh; my $prepay_identifier = ''; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0); my $payby = ''; if ( $self->payby eq 'PREPAY' ) { @@ -376,7 +414,13 @@ sub insert { warn " looking up prepaid card $prepay_identifier\n" if $DEBUG > 1; - my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds); + 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"; @@ -396,6 +440,11 @@ sub insert { 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; @@ -410,15 +459,54 @@ sub insert { $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "checking invoicing_list (transaction rolled back): $error"; + #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, \$seconds, %options); + $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; @@ -428,6 +516,10 @@ sub insert { $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" @@ -457,12 +549,285 @@ sub insert { } -=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] +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 a package -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: +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 @@ -470,12 +835,13 @@ be a better explanation of this, but until then, here's an example: $cust_pkg => [ $svc_acct ], ... ); - $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); + $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 and I. +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). @@ -488,16 +854,19 @@ 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 = shift; + my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated my %options = @_; - my %svc_options = (); - $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} - if exists $options{'depend_jobnum'}; + $seconds_ref ||= $options{'seconds_ref'}; + warn "$me order_pkgs called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -516,53 +885,44 @@ sub order_pkgs { local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; foreach my $cust_pkg ( keys %$cust_pkgs ) { - $cust_pkg->custnum( $self->custnum ); - my $error = $cust_pkg->insert; + + 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 "inserting cust_pkg (transaction rolled back): $error"; - } - foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - 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 ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $$seconds ); - $$seconds = 0; - } - $error = $svc_something->insert(%svc_options); - } - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - #return "inserting svc_ (transaction rolled back): $error"; - return $error; - } + return $error; } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } -=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ] +=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, two scalar references can be passed as well. They will have their -values filled in with the amount and number of seconds applied by this prepaid -card. +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 ) = @_; + my( $self, $prepay_credit, $amountref, $secondsref, + $upbytesref, $downbytesref, $totalbytesref ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -575,10 +935,19 @@ sub recharge_prepay { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my( $amount, $seconds ) = ( 0, 0 ); + my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 ); - my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds) + 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 @@ -592,19 +961,22 @@ sub recharge_prepay { 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 , AMOUNTREF, SECONDSREF +=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. -References to I and I scalars should be passed as arguments -and will be incremented by the values of the prepaid card. +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. @@ -615,7 +987,7 @@ If there is an error, returns the error, otherwise returns false. sub get_prepay { - my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + my( $self, $prepay_credit, %opt ) = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -660,14 +1032,50 @@ sub get_prepay { return "removing prepay_credit (transaction rolled back): $error"; } - $$amountref += $prepay_credit->amount; - $$secondsref += $prepay_credit->seconds; + ${ $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 @@ -677,10 +1085,24 @@ otherwise returns false. =cut sub increment_seconds { - my( $self, $seconds ) = @_; - warn "$me increment_seconds called: $seconds seconds\n" + _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; @@ -710,7 +1132,8 @@ sub increment_seconds { ' ('. $svc_acct->email. ")\n" if $DEBUG > 1; - $svc_acct->increment_seconds($seconds); + $column = "increment_$column"; + $svc_acct->$column($amount); } @@ -868,7 +1291,9 @@ sub delete { 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); + my $error = $new_cust_pkg->replace($cust_pkg, + options => { $cust_pkg->options }, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -894,6 +1319,16 @@ sub delete { } } + 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; @@ -905,7 +1340,8 @@ sub delete { } -=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ] +=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. @@ -917,15 +1353,39 @@ 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 = 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'; @@ -933,27 +1393,6 @@ sub replace { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - # If the mask is blank then try to set it - if we can... - if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') { - $self->paymask($self->payinfo); - } - - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); - } - - if ( $self->payby eq 'COMP' && $self->payby ne $old->payby - && $conf->config('users-allow_comp') ) { - return "You are not permitted to create complimentary accounts." - unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); - } - - local($ignore_expired_card) = 1 - if $old->payby =~ /^(CARD|DCRD)$/ - && $self->payby =~ /^(CARD|DCRD)$/ - && $old->payinfo eq $self->payinfo; - my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -965,7 +1404,7 @@ sub replace { return $error; } - if ( @param ) { # INVOICING_LIST_ARYREF + if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF my $invoicing_list = shift @param; $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { @@ -975,9 +1414,43 @@ sub replace { $self->invoicing_list( $invoicing_list ); } - 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 %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; @@ -1019,15 +1492,19 @@ sub queue_fuzzyfiles_update { my $dbh = dbh; my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - my $error = $queue->insert($self->getfield('last'), $self->company); + my $error = $queue->insert( map $self->getfield($_), + qw(first last company) + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; } - if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { + if ( $self->ship_last ) { $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; - $error = $queue->insert($self->getfield('ship_last'), $self->ship_company); + $error = $queue->insert( map $self->getfield("ship_$_"), + qw(first last company) + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "queueing job (transaction rolled back): $error"; @@ -1056,9 +1533,13 @@ sub check { my $error = $self->ut_numbern('custnum') || $self->ut_number('agentnum') + || $self->ut_textn('agent_custid') || $self->ut_number('refnum') + || $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') @@ -1068,7 +1549,13 @@ sub check { || $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: /; @@ -1084,6 +1571,13 @@ sub check { 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 { @@ -1119,66 +1613,87 @@ sub check { ; return $error if $error; - my @addfields = qw( - last first company address1 address2 city county state zip - country daytime night fax - ); + if ( $conf->exists('cust_main-require_phone') + && ! length($self->daytime) && ! length($self->night) + ) { - if ( defined $self->dbdef_table->column('ship_last') ) { - if ( scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } - @addfields ) - && scalar ( grep { $self->getfield("ship_$_") ne '' } @addfields ) - ) - { - 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; + 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" + + } - #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; + 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; - } else { # ship_ info eq billing info, so don't store dup info in database - $self->setfield("ship_$_", '') - foreach qw( last first company address1 address2 city county state zip - country daytime night fax ); + #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)$/ + #$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; @@ -1198,8 +1713,6 @@ sub check { $check_payinfo = 0; } - $self->payby($1); - if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { my $payinfo = $self->payinfo; @@ -1215,22 +1728,25 @@ sub check { if cardtype($self->payinfo) eq "Unknown"; my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - return "Banned credit card" if $ban; - - if ( defined $self->dbdef_table->column('paycvv') ) { - 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); - } + 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(''); + $self->paycvv =~ /^(\d{3})$/ + or return "CVV2 (CVC2/CID) is three digits."; + $self->paycvv($1); } + } else { + $self->paycvv(''); } my $cardtype = cardtype($payinfo); @@ -1269,10 +1785,15 @@ sub check { $payinfo = "$1\@$2"; } $self->payinfo($payinfo); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); - return "Banned ACH account" if $ban; + 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' ) { @@ -1281,24 +1802,27 @@ sub check { $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number'; $payinfo = $1; $self->payinfo($payinfo); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } elsif ( $self->payby eq 'BILL' ) { $error = $self->ut_textn('payinfo'); return "Illegal P.O. number: ". $self->payinfo if $error; - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } elsif ( $self->payby eq 'COMP' ) { - if ( !$self->custnum && $conf->config('users-allow_comp') ) { + my $curuser = $FS::CurrentUser::CurrentUser; + if ( ! $self->custnum + && ! $curuser->access_right('Complimentary customer') + ) + { return "You are not permitted to create complimentary accounts." - unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); } $error = $self->ut_textn('payinfo'); return "Illegal comp account issuer: ". $self->payinfo if $error; - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } elsif ( $self->payby eq 'PREPAY' ) { @@ -1309,7 +1833,7 @@ sub check { return "Illegal prepayment identifier: ". $self->payinfo if $error; return "Unknown prepayment identifier" unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); - $self->paycvv('') if $self->dbdef_table->column('paycvv'); + $self->paycvv(''); } @@ -1321,6 +1845,8 @@ sub check { 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 { @@ -1345,7 +1871,7 @@ sub check { $self->payname($1); } - foreach my $flag (qw( tax spool_cdr )) { + 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); } @@ -1358,7 +1884,31 @@ sub check { $self->SUPER::check; } -=item all_pkgs +=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 all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all packages (see L) for this customer. @@ -1366,14 +1916,42 @@ Returns all packages (see L) for this customer. 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'} ) { - values %{ $self->{'_pkgnum'}->cache }; + @cust_pkg = values %{ $self->{'_pkgnum'}->cache }; } else { - qsearch( 'cust_pkg', { 'custnum' => $self->custnum }); + @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 ncancelled_pkgs +=item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all non-cancelled packages (see L) for this customer. @@ -1381,20 +1959,75 @@ Returns all non-cancelled packages (see L) for this customer. 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'} ) { - grep { ! $_->getfield('cancel') } values %{ $self->{'_pkgnum'}->cache }; + + warn "$me ncancelled_pkgs: returning cached objects" + if $DEBUG > 1; + + @cust_pkg = grep { ! $_->getfield('cancel') } + values %{ $self->{'_pkgnum'}->cache }; + } else { - @{ [ # force list context - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }), - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }), - ] }; + + 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 { + + 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 @@ -1434,6 +2067,18 @@ sub unsuspended_pkgs { 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 @@ -1442,14 +2087,19 @@ customer. =cut sub num_cancelled_pkgs { - my $self = shift; - $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0"); + 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, $sql ) = @_; + 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 = ? AND $sql" + "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql" ) or die dbh->errstr; $sth->execute($self->custnum) or die $sth->errstr; $sth->fetchrow_arrayref->[0]; @@ -1478,13 +2128,23 @@ Returns a list: an empty list on success or a list of errors. sub suspend { my $self = shift; - grep { $_->suspend } $self->unsuspended_pkgs; + grep { $_->suspend(@_) } $self->unsuspended_pkgs; } -=item suspend_if_pkgpart PKGPART [ , PKGPART ... ] +=item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) matching the listed -PKGPARTs (see L). +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. @@ -1492,16 +2152,31 @@ Returns a list: an empty list on success or a list of errors. sub suspend_if_pkgpart { my $self = shift; - my @pkgparts = @_; - grep { $_->suspend } + 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 PKGPART [ , PKGPART ... ] +=item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) unless they match the -listed PKGPARTs (see L). +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. @@ -1509,8 +2184,14 @@ Returns a list: an empty list on success or a list of errors. sub suspend_unless_pkgpart { my $self = shift; - my @pkgparts = @_; - grep { $_->suspend } + 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; } @@ -1519,22 +2200,35 @@ sub suspend_unless_pkgpart { Cancels all uncancelled packages (see L) for this customer. -Available options are: I, I, and I +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. -I can be set true to supress email cancellation notices. +=item ban - can be set true to ban this customer's credit card or ACH information, if present. -# I can be set to a cancellation reason (see L) +=item nobill - can be set true to skip billing if it might otherwise be done. -I can be set true to ban this customer's credit card or ACH information, -if present. +=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 = shift; - my %opt = @_; + 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)$/ ) { @@ -1549,7 +2243,20 @@ sub cancel { } - grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; + 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 { @@ -1565,10 +2272,26 @@ sub _banned_pay_hashref { { 'payby' => $payby2ban{$self->payby}, 'payinfo' => md5_base64($self->payinfo), - #'reason' => + #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. @@ -1580,27 +2303,179 @@ sub agent { qsearchs( 'agent', { 'agentnum' => $self->agentnum } ); } +=item bill_and_collect + +Cancels and suspends any packages due, generates bills, applies payments and +cred + +Warns on errors (Does not currently: If there is an error, returns the error, otherwise returns false.) + +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