X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=03300a07531f2ae768c7e543d7a9cf9df62abdb5;hp=c7f40f2c4fa5867b736a2e73413b2a2474a674d2;hb=77ed60f65f8d0ac605ccb3bbc3adfbfba203612d;hpb=b15d420a27a17ea71f4d975775dabc79380ced1a diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index c7f40f2c4..03300a075 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -14,7 +14,7 @@ use base qw( FS::cust_main::Packages FS::cust_main::Status FS::o2m_Common FS::Record ); -use vars qw( $DEBUG $me $conf +use vars qw( $DEBUG $me $conf $default_agent_custid $custnum_display_length @encrypted_fields $import $ignore_expired_card $ignore_banned_card $ignore_illegal_zip @@ -32,11 +32,12 @@ use Digest::MD5 qw(md5_base64); use Date::Format; #use Date::Manip; use File::Temp; #qw( tempfile ); +use Email::Address; use Business::CreditCard 0.28; -use Locale::Country; +use Try::Tiny; 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 money_pretty ); +use FS::Misc qw( generate_email send_email generate_ps do_print money_pretty card_types ); use FS::Msgcat qw(gettext); use FS::CurrentUser; use FS::TicketSystem; @@ -76,6 +77,8 @@ use FS::cust_attachment; use FS::contact; use FS::Locales; use FS::upgrade_journal; +use FS::reason; +use FS::DBI; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -98,7 +101,8 @@ sub nohistory_fields { ('payinfo', 'paycvv'); } #$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) + $default_agent_custid = $conf->exists('cust_main-default_agent_custid'); + $custnum_display_length = $conf->config('cust_main-custnum-display_length'); }; sub _cache { @@ -238,6 +242,10 @@ Name on card or billing name IP address from which payment information was received +=item paycardtype + +The credit card type (deduced from the card number). + =item tax Tax exempt, empty or `Y' @@ -260,7 +268,7 @@ Enable individual CDR spooling, empty or `Y' =item dundate -A suggestion to events (see L) to delay until this unix timestamp +A suggestion to events (see L) to delay until this unix timestamp =item squelch_cdr @@ -456,7 +464,8 @@ sub insert { $self->auto_agent_custid() if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid; - my $error = $self->SUPER::insert; + my $error = $self->check_payinfo_cardtype + || $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "inserting cust_main record (transaction rolled back): $error"; @@ -541,6 +550,16 @@ sub insert { } + # validate card (needs custnum already set) + if ( $self->payby =~ /^(CARD|DCRD)$/ + && $conf->exists('business-onlinepayment-verification') ) { + $error = $self->realtime_verify_bop({ 'method'=>'CC' }); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + warn " setting contacts\n" if $DEBUG > 1; @@ -1194,7 +1213,7 @@ sub delete { $ticket_dbh = $dbh; } elsif ($conf->config('ticket_system') eq 'RT_External') { my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc'); - $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); + $ticket_dbh = FS::DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); #or die "RT_External DBI->connect error: $DBI::errstr\n"; } @@ -1440,7 +1459,7 @@ sub merge { $ticket_dbh = $dbh; } elsif ($conf->config('ticket_system') eq 'RT_External') { my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc'); - $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); + $ticket_dbh = FS::DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 }); #or die "RT_External DBI->connect error: $DBI::errstr\n"; } @@ -1531,6 +1550,33 @@ sub replace { || $old->payby =~ /^(CHEK|DCHK)$/ && $self->payby =~ /^(CHEK|DCHK)$/ ) && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask ); + if ( $self->payby =~ /^(CARD|DCRD)$/ + && $old->payinfo ne $self->payinfo + && $old->paymask ne $self->paymask ) + { + my $error = $self->check_payinfo_cardtype; + return $error if $error; + + if ( $conf->exists('business-onlinepayment-verification') ) { + #need to standardize paydate for this, false laziness with 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 { + return "Illegal expiration date: ". $self->paydate; + } + $m = sprintf('%02d',$m); + $self->paydate("$y-$m-01"); + + $error = $self->realtime_verify_bop({ 'method'=>'CC' }); + return $error if $error; + } + } + return "Invoicing locale is required" if $old->locale && ! $self->locale @@ -1810,6 +1856,7 @@ sub check { || $self->ut_floatn('credit_limit') || $self->ut_numbern('billday') || $self->ut_numbern('prorate_day') + || $self->ut_flag('force_prorate_day') || $self->ut_flag('edit_subject') || $self->ut_flag('calling_list_exempt') || $self->ut_flag('invoice_noemail') @@ -1923,9 +1970,23 @@ sub check { validate($payinfo) or return gettext('invalid_card'); # . ": ". $self->payinfo; - return gettext('unknown_card_type') - if $self->payinfo !~ /^99\d{14}$/ #token - && cardtype($self->payinfo) eq "Unknown"; + my $cardtype = $self->paycardtype; + if ( $payinfo =~ /^99\d{14}$/ ) { + $self->set('is_tokenized', 'Y'); #so we don't try to do it again + if ( $self->paymask =~ /^\d+x/ ) { + $cardtype = cardtype($self->paymask); + } else { + #return "paycardtype required ". + # "(can't derive from a token and no paymask w/prefix provided)" + # unless $cardtype; + } + } else { + $cardtype = cardtype($self->payinfo); + } + + return gettext('unknown_card_type') if $cardtype eq 'Unknown'; + + $self->set('paycardtype', $cardtype); unless ( $ignore_banned_card ) { my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } ); @@ -1947,7 +2008,7 @@ sub check { } if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { - if ( cardtype($self->payinfo) eq 'American Express card' ) { + if ( $cardtype eq 'American Express card' ) { $self->paycvv =~ /^(\d{4})$/ or return "CVV2 (CID) for American Express cards is four digits."; $self->paycvv($1); @@ -1960,7 +2021,6 @@ sub check { $self->paycvv(''); } - my $cardtype = cardtype($payinfo); if ( $cardtype =~ /^(Switch|Solo)$/i ) { return "Start date or issue number is required for $cardtype cards" @@ -2057,6 +2117,11 @@ sub check { unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); $self->paycvv(''); + } elsif ( $self->payby =~ /^CARD|DCRD$/ and $self->paymask ) { + # either ignoring invalid cards, or we can't decrypt the payinfo, but + # try to detect the card type anyway. this never returns failure, so + # the contract of $ignore_invalid_cards is maintained. + $self->set('paycardtype', cardtype($self->paymask)); } if ( $self->paydate eq '' || $self->paydate eq '-' ) { @@ -2082,6 +2147,10 @@ sub check { if !$import && !$ignore_expired_card && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); + + if ( my $error = $self->ut_daten('paydate') ) { + return $error; + } } if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && @@ -2108,6 +2177,10 @@ sub check { && ! $self->custnum && $conf->exists('cust_main-require_locale'); + return "Please select a customer class" + if ! $self->classnum + && $conf->exists('cust_main-require_classnum'); + 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); @@ -2121,6 +2194,28 @@ sub check { $self->SUPER::check; } +sub check_payinfo_cardtype { + my $self = shift; + + return '' unless $self->payby =~ /^(CARD|DCRD)$/; + + my $payinfo = $self->payinfo; + $payinfo =~ s/\D//g; + + if ( $payinfo =~ /^99\d{14}$/ ) { + return ''; + } + + my %bop_card_types = map { $_=>1 } values %{ card_types() }; + my $cardtype = cardtype($payinfo); + $self->set('paycardtype', $cardtype); + + return "$cardtype not accepted" unless $bop_card_types{$cardtype}; + + ''; + +} + =item replace_check Additional checks for replace only. @@ -2210,7 +2305,7 @@ Returns a list: an empty list on success or a list of errors. sub unsuspend { my $self = shift; - grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs; + grep { ($_->get('setup')) && $_->unsuspend } $self->suspended_pkgs(@_); } =item release_hold @@ -2306,33 +2401,64 @@ sub suspend_unless_pkgpart { =item cancel [ OPTION => VALUE ... ] Cancels all uncancelled packages (see L) for this customer. +The cancellation time will be now. -Available options are: +=back + +Always returns a list: an empty list on success or a list of errors. + +=cut + +sub cancel { + my $self = shift; + my %opt = @_; + warn "$me cancel called on customer ". $self->custnum. " with options ". + join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n" + if $DEBUG; + my @pkgs = $self->ncancelled_pkgs; + + $self->cancel_pkgs( %opt, 'cust_pkg' => \@pkgs ); +} + +=item cancel_pkgs OPTIONS + +Cancels a specified list of packages. OPTIONS can include: =over 4 +=item cust_pkg - an arrayref of the packages. Required. + +=item time - the cancellation time, used to calculate final bills and +unused-time credits if any. Will be passed through to the bill() and +FS::cust_pkg::cancel() methods. + =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 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 cust_pkg_reason - can be an arrayref of L objects +for the individual packages, parallel to the C argument. The +reason and reason_otaker arguments will be taken from those objects. =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 { +sub cancel_pkgs { my( $self, %opt ) = @_; - warn "$me cancel called on customer ". $self->custnum. " with options ". - join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n" - if $DEBUG; + # we're going to cancel services, which is not reversible + # but on 3.x, don't strictly enforce this + warn "cancel_pkgs should not be run inside a transaction" + if $FS::UID::AutoCommit == 0; + + local $FS::UID::AutoCommit = 0; return ( 'access denied' ) unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); @@ -2346,24 +2472,91 @@ sub cancel { my $ban = new FS::banned_pay $self->_new_banned_pay_hashref; my $error = $ban->insert; - return ( $error ) if $error; + if ($error) { + dbh->rollback; + return ( $error ); + } } - my @pkgs = $self->ncancelled_pkgs; + my @pkgs = @{ delete $opt{'cust_pkg'} }; + my $cancel_time = $opt{'time'} || time; + # bill all packages first, so we don't lose usage, service counts for + # bulk billing, etc. 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; + my $error = $self->bill( 'pkg_list' => [ @pkgs ], + 'cancel' => 1, + 'time' => $cancel_time ); + if ($error) { + warn "Error billing during cancel, custnum ". $self->custnum. ": $error"; + dbh->rollback; + return ( "Error billing during cancellation: $error" ); + } + } + dbh->commit; + + my @errors; + # try to cancel each service, the same way we would for individual packages, + # but in cancel weight order. + my @cust_svc = map { $_->cust_svc } @pkgs; + my @sorted_cust_svc = + map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; } @cust_svc + ; + warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ". + $self->custnum."\n" + if $DEBUG; + foreach my $cust_svc (@sorted_cust_svc) { + my $part_svc = $cust_svc->part_svc; + next if ( defined($part_svc) and $part_svc->preserve ); + # immediate cancel, no date option + # transactionize individually + my $error = try { $cust_svc->cancel } catch { $_ }; + if ( $error ) { + dbh->rollback; + push @errors, $error; + } else { + dbh->commit; + } + } + if (@errors) { + return @errors; } - warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/". - scalar(@pkgs). " packages for customer ". $self->custnum. "\n" + warn "$me cancelling ". scalar(@pkgs) ." package(s) for customer ". + $self->custnum. "\n" if $DEBUG; - grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs; + my @cprs; + if ($opt{'cust_pkg_reason'}) { + @cprs = @{ delete $opt{'cust_pkg_reason'} }; + } + my $null_reason; + foreach (@pkgs) { + my %lopt = %opt; + if (@cprs) { + my $cpr = shift @cprs; + if ( $cpr ) { + $lopt{'reason'} = $cpr->reasonnum; + $lopt{'reason_otaker'} = $cpr->otaker; + } else { + warn "no reason found when canceling package ".$_->pkgnum."\n"; + $lopt{'reason'} = ''; + } + } + my $error = $_->cancel(%lopt); + if ( $error ) { + dbh->rollback; + push @errors, 'pkgnum '.$_->pkgnum.': '.$error; + } else { + dbh->commit; + } + } + + return @errors; } sub _banned_pay_hashref { @@ -2564,7 +2757,13 @@ sub batch_card { }else{ $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments); } - return '' unless $amount > 0; + if ($amount <= 0) { + warn(sprintf("Customer balance %.2f - in transit amount %.2f is <= 0.\n", + $self->balance, + $self->in_transit_payments + )); + return; + } my $invnum = delete $options{invnum}; my $payby = $options{payby} || $self->payby; #still dubious @@ -2576,6 +2775,10 @@ sub batch_card { ); } + my $paycode = $options{paycode} || ''; + my $batch_type = "DEBIT"; + $batch_type = "CREDIT" if $paycode eq 'C'; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -2588,6 +2791,7 @@ sub batch_card { my %pay_batch = ( 'status' => 'O', 'payby' => FS::payby->payby2payment($payby), + 'type' => $batch_type, ); $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent'); @@ -2608,7 +2812,7 @@ sub batch_card { } ); foreach (qw( address1 address2 city state zip country latitude longitude - payby payinfo paydate payname )) + payby payinfo paydate payname paycode paytype )) { $options{$_} = '' unless exists($options{$_}); } @@ -2632,9 +2836,15 @@ sub batch_card { 'country' => $options{country} || $loc->country, 'payby' => $options{payby} || $self->payby, 'payinfo' => $options{payinfo} || $self->payinfo, + 'paymask' => ( $options{payinfo} + ? FS::payinfo_Mixin->mask_payinfo( $options{payby}, + $options{payinfo} ) + : $self->paymask + ), 'exp' => $options{paydate} || $self->paydate, 'payname' => $options{payname} || $self->payname, 'amount' => $amount, # consolidating + 'paycode' => $options{paycode} || '', } ); $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum) @@ -2652,6 +2862,62 @@ sub batch_card { die $error; } + if ($options{'processing-fee'} > 0) { + my $pf_cust_pkg; + my $processing_fee_text = 'Payment Processing Fee'; + + unless ( $invnum ) { # probably from a payment screen + # do we have any open invoices? pick earliest + # uses the fact that cust_main->cust_bill sorts by date ascending + my @open = $self->open_cust_bill; + $invnum = $open[0]->invnum if scalar(@open); + } + + unless ( $invnum ) { # still nothing? pick last closed invoice + # again uses fact that cust_main->cust_bill sorts by date ascending + my @closed = $self->cust_bill; + $invnum = $closed[$#closed]->invnum if scalar(@closed); + } + + unless ( $invnum ) { + # XXX: unlikely case - pre-paying before any invoices generated + # what it should do is create a new invoice and pick it + warn '\PROCESS FEE AND NO INVOICES PICKED TO APPLY IT!'; + return ''; + } + + my $pf_change_error = $self->charge({ + 'amount' => $options{'processing-fee'}, + 'pkg' => $processing_fee_text, + 'setuptax' => 'Y', + 'cust_pkg_ref' => \$pf_cust_pkg, + }); + + if($pf_change_error) { + warn 'Unable to add payment processing fee'; + return ''; + } + + $pf_cust_pkg->setup(time); + my $pf_error = $pf_cust_pkg->replace; + if($pf_error) { + warn 'Unable to set setup time on cust_pkg for processing fee'; + # but keep going... + } + + my $cust_bill = qsearchs('cust_bill', { 'invnum' => $invnum }); + unless ( $cust_bill ) { + warn "race condition + invoice deletion just happened"; + return ''; + } + + my $grand_pf_error = + $cust_bill->add_cc_surcharge($pf_cust_pkg->pkgnum,$options{'processing-fee'}); + + warn "cannot add Processing fee to invoice #$invnum: $grand_pf_error" + if $grand_pf_error; + } + my $unapplied = $self->total_unapplied_credits + $self->total_unapplied_payments + $self->in_transit_payments; @@ -2913,7 +3179,7 @@ UNIX timestamps; see L). Also see L and L for conversion functions. The empty string can be passed to disable that time constraint completely. -Accepts the same options as L: +Accepts the same options as L: =over 4 @@ -2974,6 +3240,7 @@ sub in_transit_payments { foreach my $cust_pay_batch ( qsearch('cust_pay_batch', { 'batchnum' => $pay_batch->batchnum, 'custnum' => $self->custnum, + 'status' => '', } ) ) { $in_transit_payments += $cust_pay_batch->amount; } @@ -3328,6 +3595,93 @@ sub invoicing_list_emailonly_scalar { join(', ', $self->invoicing_list_emailonly); } +=item contact_list [ CLASSNUM, ... ] + +Returns a list of contacts (L objects) for the customer. If +a list of contact classnums is given, returns only contacts in those +classes. If '0' is given, also returns contacts with no class. + +If no arguments are given, returns all contacts for the customer. + +=cut + +sub contact_list { + my $self = shift; + my $search = { + table => 'contact', + select => 'contact.*', + extra_sql => ' WHERE contact.custnum = '.$self->custnum, + }; + + my @orwhere; + my @classnums; + foreach (@_) { + if ( $_ eq '0' ) { + push @orwhere, 'contact.classnum is null'; + } elsif ( /^\d+$/ ) { + push @classnums, $_; + } else { + die "bad classnum argument '$_'"; + } + } + + if (@classnums) { + push @orwhere, 'contact.classnum IN ('.join(',', @classnums).')'; + } + if (@orwhere) { + $search->{extra_sql} .= ' AND (' . + join(' OR ', map "( $_ )", @orwhere) . + ')'; + } + + qsearch($search); +} + +=item contact_list_email [ CLASSNUM, ... ] + +Same as L, but returns email destinations instead of contact +objects. Also accepts 'invoice' as an argument, in which case this will also +return the invoice email address if any. + +=cut + +sub contact_list_email { + my $self = shift; + my @classnums; + my $and_invoice; + foreach (@_) { + if (/^invoice$/) { + $and_invoice = 1; + } else { + push @classnums, $_; + } + } + my %emails; + # if the only argument passed was 'invoice' then no classnums are + # intended, so skip this. + if ( @classnums ) { + my @contacts = $self->contact_list(@classnums); + foreach my $contact (@contacts) { + foreach my $contact_email ($contact->contact_email) { + # unlike on 4.x, we have a separate list of invoice email + # destinations. + # make sure they're not redundant with contact emails + $emails{ $contact_email->emailaddress } = + Email::Address->new( $contact->firstlast, + $contact_email->emailaddress + )->format; + } + } + } + if ( $and_invoice ) { + foreach my $email ($self->invoicing_list_emailonly) { + $emails{ $email } ||= + Email::Address->new( $self->name_short, $email )->format; + } + } + values %emails; +} + =item referral_custnum_cust_main Returns the customer who referred this customer (or the empty string, if @@ -4060,34 +4414,16 @@ cust_main-default_agent_custid is set and it has a value, custnum otherwise. sub display_custnum { my $self = shift; + return $self->agent_custid + if $default_agent_custid && $self->agent_custid; + my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || ''; - if ( my $special = $conf->config('cust_main-custnum-display_special') ) { - if ( $special eq 'CoStAg' ) { - $prefix = uc( join('', - $self->country, - ($self->state =~ /^(..)/), - $prefix || ($self->agent->agent =~ /^(..)/) - ) ); - } - elsif ( $special eq 'CoStCl' ) { - $prefix = uc( join('', - $self->country, - ($self->state =~ /^(..)/), - ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__') - ) ); - } - # add any others here if needed - } - my $length = $conf->config('cust_main-custnum-display_length'); - if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){ - return $self->agent_custid; - } elsif ( $prefix ) { - $length = 8 if !defined($length); + if ( $prefix ) { return $prefix . - sprintf('%0'.$length.'d', $self->custnum) - } elsif ( $length ) { - return sprintf('%0'.$length.'d', $self->custnum); + sprintf('%0'.($custnum_display_length||8).'d', $self->custnum) + } elsif ( $custnum_display_length ) { + return sprintf('%0'.$custnum_display_length.'d', $self->custnum); } else { return $self->custnum; } @@ -4214,26 +4550,14 @@ sub ship_contact_firstlast { $contact->get('first') . ' '. $contact->get('last'); } -#XXX this doesn't work in 3.x+ -#=item country_full -# -#Returns this customer's full country name -# -#=cut -# -#sub country_full { -# my $self = shift; -# code2country($self->country); -#} - sub bill_country_full { my $self = shift; - code2country($self->bill_location->country); + $self->bill_location->country_full; } sub ship_country_full { my $self = shift; - code2country($self->ship_location->country); + $self->ship_location->country_full; } =item county_state_county [ PREFIX ] @@ -4292,13 +4616,17 @@ sub status { shift->cust_status(@_); } sub cust_status { my $self = shift; + return $self->hashref->{cust_status} if $self->hashref->{cust_status}; for my $status ( FS::cust_main->statuses() ) { my $method = $status.'_sql'; my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; $sth->execute( ($self->custnum) x $numnum ) or die "Error executing 'SELECT $sql': ". $sth->errstr; - return $status if $sth->fetchrow_arrayref->[0]; + if ( $sth->fetchrow_arrayref->[0] ) { + $self->hashref->{cust_status} = $status; + return $status; + } } } @@ -4395,6 +4723,30 @@ sub tickets { (@tickets); } +=item appointments [ STATUS ] + +Returns an array of hashes representing the customer's RT tickets which +are appointments. + +=cut + +sub appointments { + my $self = shift; + my $status = ( @_ && $_[0] ) ? shift : ''; + + return () unless $conf->config('ticket_system'); + + my $queueid = $conf->config('ticket_system-appointment-queueid'); + + @{ FS::TicketSystem->customer_tickets( $self->custnum, + 99, + undef, + $status, + $queueid, + ) + }; +} + # Return services representing svc_accts in customer support packages sub support_services { my $self = shift; @@ -4748,15 +5100,10 @@ Returns an SQL expression identifying un-cancelled cust_main records. =cut sub uncancelled_sql { uncancel_sql(@_); } -sub uncancel_sql { " - ( 0 < ( $select_count_pkgs - AND ( cust_pkg.cancel IS NULL - OR cust_pkg.cancel = 0 - ) - ) - OR 0 = ( $select_count_pkgs ) - ) -"; } +sub uncancel_sql { + my $self = shift; + "( NOT (".$self->cancelled_sql.") )"; #sensitive to cust_main-status_module +} =item balance_sql @@ -4916,121 +5263,6 @@ sub search { =over 4 -=item batch_charge - -=cut - -sub batch_charge { - my $param = shift; - #warn join('-',keys %$param); - my $fh = $param->{filehandle}; - my $agentnum = $param->{agentnum}; - my $format = $param->{format}; - - my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql; - - my @fields; - if ( $format eq 'simple' ) { - @fields = qw( custnum agent_custid amount pkg ); - } else { - die "unknown format $format"; - } - - eval "use Text::CSV_XS;"; - die $@ if $@; - - my $csv = new Text::CSV_XS; - #warn $csv; - #warn $fh; - - my $imported = 0; - #my $columns; - - 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; - - #while ( $columns = $csv->getline($fh) ) { - my $line; - while ( defined($line=<$fh>) ) { - - $csv->parse($line) or do { - $dbh->rollback if $oldAutoCommit; - return "can't parse: ". $csv->error_input(); - }; - - my @columns = $csv->fields(); - #warn join('-',@columns); - - my %row = (); - foreach my $field ( @fields ) { - $row{$field} = shift @columns; - } - - if ( $row{custnum} && $row{agent_custid} ) { - dbh->rollback if $oldAutoCommit; - return "can't specify custnum with agent_custid $row{agent_custid}"; - } - - my %hash = (); - if ( $row{agent_custid} && $agentnum ) { - %hash = ( 'agent_custid' => $row{agent_custid}, - 'agentnum' => $agentnum, - ); - } - - if ( $row{custnum} ) { - %hash = ( 'custnum' => $row{custnum} ); - } - - unless ( scalar(keys %hash) ) { - $dbh->rollback if $oldAutoCommit; - return "can't find customer without custnum or agent_custid and agentnum"; - } - - my $cust_main = qsearchs('cust_main', { %hash } ); - unless ( $cust_main ) { - $dbh->rollback if $oldAutoCommit; - my $custnum = $row{custnum} || $row{agent_custid}; - return "unknown custnum $custnum"; - } - - if ( $row{'amount'} > 0 ) { - my $error = $cust_main->charge($row{'amount'}, $row{'pkg'}); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } elsif ( $row{'amount'} < 0 ) { - my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ), - $row{'pkg'} ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - $imported++; - } else { - #hmm? - } - - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - return "Empty file!" unless $imported; - - ''; #no error - -} - =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS Deprecated. Use event notification and message templates @@ -5481,6 +5713,185 @@ sub _upgrade_data { #class method $class->_upgrade_otaker(%opts); + # turn on encryption as part of regular upgrade, so all new records are immediately encrypted + # existing records will be encrypted in queueable_upgrade (below) + unless ($conf->exists('encryptionpublickey') || $conf->exists('encryptionprivatekey')) { + eval "use FS::Setup"; + die $@ if $@; + FS::Setup::enable_encryption(); + } + + $class->_upgrade_data_paydate_edgebug; +} + +=item _upgrade_data_paydate_edgebug + +Correct bad data injected into payment expire date column by Edge browser bug + +The month and year values may have an extra character injected into form POST +data by Edge browser. It was possible for some bad month values to slip +past data validation. + +If the stored value was out of range, it was causing payments screen to crash. +We can detect and fix this by dropping the second digit. + +If the stored value is is 11 or 12, it's possible the user inputted a 1. In +this case, the payment method will fail to authorize, but the record will +not cause crashdumps for being out of range. + +In short, check for any expiration month > 12, and drop the extra digit + +=cut + +sub _upgrade_data_paydate_edgebug { + my $journal_label = 'cust_main_paydate_edgebug'; + return if FS::upgrade_journal->is_done( $journal_label ); + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + + for my $row ( + FS::Record::qsearch( + cust_main => { paydate => { op => '!=', value => '' }} + ) + ) { + next unless $row->ut_daten('paydate'); + + # paydate column stored in database has failed date validation + my $bad_paydate = $row->paydate; + + my @date = split /[\-\/]/, $bad_paydate; + @date = @date[2,0,1] if $date[2] > 1900; + + # Only autocorrecting when month > 12 - notify operator + unless ( $date[1] > 12 ) { + die sprintf( + 'Unable to correct bad paydate stored in cust_main row '. + 'custnum(%s) paydate(%s)', + $row->custnum, + $bad_paydate, + ); + } + + $date[1] = substr( $date[1], 0, 1 ); + $row->paydate( join('-', @date )); + + if ( my $error = $row->replace ) { + die sprintf( + 'Failed to autocorrect bad paydate stored in cust_main row '. + 'custnum(%s) paydate(%s) - error: %s', + $row->custnum, + $bad_paydate, + $error + ); + } + + warn sprintf( + 'Autocorrected bad paydate stored in cust_main row '. + "custnum(%s) old-paydate(%s) new-paydate(%s)\n", + $row->custnum, + $bad_paydate, + $row->paydate, + ); + + } + + FS::upgrade_journal->set_done( $journal_label ); + dbh->commit unless $oldAutoCommit; +} + + +sub queueable_upgrade { + my $class = shift; + + ### encryption gets turned on in _upgrade_data, above + + eval "use FS::upgrade_journal"; + die $@ if $@; + + # prior to 2013 (commit f16665c9) payinfo was stored in history if not encrypted, + # clear that out before encrypting/tokenizing anything else + if (!FS::upgrade_journal->is_done('clear_payinfo_history')) { + foreach my $table ('cust_main','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') { + my $sql = 'UPDATE h_'.$table.' SET payinfo = NULL WHERE payinfo IS NOT NULL'; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + } + FS::upgrade_journal->set_done('clear_payinfo_history'); + } + + # fix Tokenized paycardtype and encrypt old records + if ( ! FS::upgrade_journal->is_done('paycardtype_Tokenized') + || ! FS::upgrade_journal->is_done('encryption_check') + ) + { + + # allow replacement of closed cust_pay/cust_refund records + local $FS::payinfo_Mixin::allow_closed_replace = 1; + + # because it looks like nothing's changing + local $FS::Record::no_update_diff = 1; + + # commit everything immediately + local $FS::UID::AutoCommit = 1; + + # encrypt what's there + foreach my $table ('cust_main','cust_pay_pending','cust_pay','cust_pay_void','cust_refund') { + my $tclass = 'FS::'.$table; + my $lastrecnum = 0; + my @recnums = (); + while (my $recnum = _upgrade_next_recnum(dbh,$table,\$lastrecnum,\@recnums)) { + my $record = $tclass->by_key($recnum); + next unless $record; # small chance it's been deleted, that's ok + next unless grep { $record->payby eq $_ } @FS::Record::encrypt_payby; + # window for possible conflict is practically nonexistant, + # but just in case... + $record = $record->select_for_update; + if (!$record->custnum && $table eq 'cust_pay_pending') { + $record->set('custnum_pending',1); + } + $record->paycardtype('') if $record->paycardtype eq 'Tokenized'; + + local($ignore_expired_card) = 1; + local($ignore_banned_card) = 1; + local($skip_fuzzyfiles) = 1; + local($import) = 1;#prevent automatic geocoding (need its own variable?) + + my $error = $record->replace; + die "Error replacing $table ".$record->get($record->primary_key).": $error" if $error; + } + } + + FS::upgrade_journal->set_done('paycardtype_Tokenized'); + FS::upgrade_journal->set_done('encryption_check') if $conf->exists('encryption'); + } + +} + +# not entirely false laziness w/ Billing_Realtime::_token_check_next_recnum +# cust_payby might get deleted while this runs +# not a method! +sub _upgrade_next_recnum { + my ($dbh,$table,$lastrecnum,$recnums) = @_; + my $recnum = shift @$recnums; + return $recnum if $recnum; + my $tclass = 'FS::'.$table; + my $paycardtypecheck = ($table ne 'cust_pay_pending') ? q( OR paycardtype = 'Tokenized') : ''; + my $sql = 'SELECT '.$tclass->primary_key. + ' FROM '.$table. + ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum. + " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ". + " AND ( length(payinfo) < 80$paycardtypecheck ) ". + ' ORDER BY '.$tclass->primary_key.' LIMIT 500'; + my $sth = $dbh->prepare($sql) or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + my @recnums; + while (my $rec = $sth->fetchrow_hashref) { + push @$recnums, $rec->{$tclass->primary_key}; + } + $sth->finish(); + $$lastrecnum = $$recnums[-1]; + return shift @$recnums; } =back