X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=abf51fa2f02958d8899eb9dea40201d6ea9d4101;hb=93e7186ecd347c46a09bdc88ca391e8f0d1ab7da;hp=32bf2a333b858944fe6ebf383e5e36cc940691dc;hpb=00f903db5078b4137495a3fb6b650890ce92fb5c;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 32bf2a333..abf51fa2f 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -32,6 +32,7 @@ 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 FS::UID qw( getotaker dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); @@ -75,6 +76,7 @@ use FS::cust_attachment; use FS::contact; use FS::Locales; use FS::upgrade_journal; +use FS::reason; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -238,6 +240,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' @@ -1848,6 +1854,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') @@ -1961,9 +1968,11 @@ 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 = cardtype($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 } ); @@ -1985,7 +1994,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); @@ -1998,7 +2007,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" @@ -2095,6 +2103,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 '-' ) { @@ -2146,6 +2159,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); @@ -2167,10 +2184,13 @@ sub check_payinfo_cardtype { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; - return '' if $payinfo =~ /^99\d{14}$/; #token + 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}; @@ -2363,36 +2383,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 ) = @_; - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; + # 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; - warn "$me cancel called on customer ". $self->custnum. " with options ". - join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n" - if $DEBUG; + local $FS::UID::AutoCommit = 0; return ( 'access denied' ) unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer'); @@ -2407,35 +2455,39 @@ sub cancel { my $ban = new FS::banned_pay $self->_new_banned_pay_hashref; my $error = $ban->insert; if ($error) { - dbh->rollback if $oldAutoCommit; + 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 ); + my $error = $self->bill( 'pkg_list' => [ @pkgs ], + 'cancel' => 1, + 'time' => $cancel_time ); if ($error) { - # we should return an error and exit in this case, yes? warn "Error billing during cancel, custnum ". $self->custnum. ": $error"; - dbh->rollback if $oldAutoCommit; + dbh->rollback; return ( "Error billing during cancellation: $error" ); } } + dbh->commit; + $FS::UID::AutoCommit = 1; my @errors; - # now cancel all services, the same way we would for individual packages + # now cancel all services, the same way we would for individual packages. + # if any of them fail, cancel the rest anyway. 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 + 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" @@ -2447,8 +2499,6 @@ sub cancel { push @errors, $error if $error; } if (@errors) { - # then we won't get to the point of canceling packages - dbh->rollback if $oldAutoCommit; return @errors; } @@ -2456,13 +2506,28 @@ sub cancel { $self->custnum. "\n" if $DEBUG; - @errors = grep { $_ } map { $_->cancel(%opt) } @pkgs; - if (@errors) { - dbh->rollback if $oldAutoCommit; - return @errors; + 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); + push @errors, 'pkgnum '.$_->pkgnum.': '.$error if $error; } - return; + return @errors; } sub _banned_pay_hashref { @@ -3505,15 +3570,17 @@ sub contact_list_email { # unlike on 4.x, we have a separate list of invoice email # destinations. # make sure they're not redundant with contact emails - my $dest = $contact->firstlast . ' <' . $contact_email->emailaddress . '>'; - $emails{ $contact_email->emailaddress } = $dest; + $emails{ $contact_email->emailaddress } = + Email::Address->new( $contact->firstlast, + $contact_email->emailaddress + )->format; } } } if ( $and_invoice ) { foreach my $email ($self->invoicing_list_emailonly) { - my $dest = $self->name_short . ' <' . $email . '>'; - $emails{ $email } ||= $dest; + $emails{ $email } ||= + Email::Address->new( $self->name_short, $email )->format; } } values %emails; @@ -4937,15 +5004,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 @@ -5670,6 +5732,106 @@ 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(); + } + +} + +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 $sql = 'SELECT '.$tclass->primary_key. + ' FROM '.$table. + ' WHERE '.$tclass->primary_key.' > '.$$lastrecnum. + " AND payby IN ( 'CARD', 'DCRD', 'CHEK', 'DCHK' ) ". + " AND ( length(payinfo) < 80 OR paycardtype = 'Tokenized' ) ". + ' 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