X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=90256bd8197a2e602355fb51bdf5fceb7fb0025b;hp=3fb0a87fb54869a464f900fb87af75ef8f4f7b1e;hb=faa774764df03c6f3280177f6adfcd2214995a13;hpb=c663e377fd2c5089e7364b1144248edbaab76fe4 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 3fb0a87fb..90256bd81 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -20,15 +20,17 @@ use base qw( FS::cust_main::Packages require 5.006; use strict; use Carp; +use Try::Tiny; use Scalar::Util qw( blessed ); -use Time::Local qw(timelocal); -use Data::Dumper; +use List::Util qw(min); use Tie::IxHash; +use File::Temp; #qw( tempfile ); +use Data::Dumper; +use Time::Local qw(timelocal); use Date::Format; #use Date::Manip; -use File::Temp; #qw( tempfile ); +use Email::Address; use Business::CreditCard 0.28; -use List::Util qw(min); use FS::UID qw( dbh driver_name ); use FS::Record qw( qsearchs qsearch dbdef regexp_sql ); use FS::Cursor; @@ -76,6 +78,7 @@ use FS::upgrade_journal; use FS::sales; use FS::cust_payby; use FS::contact; +use FS::reason; # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -596,17 +599,21 @@ sub insert { } } - my $contact = FS::contact->new({ - 'custnum' => $self->get('custnum'), - 'last' => $self->get('last'), - 'first' => $self->get('first'), - 'emailaddress' => $email, - 'invoice_dest' => 'Y', # yes, you can set this via the contact - }); - my $error = $contact->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + if ( $email ) { + + my $contact = FS::contact->new({ + 'custnum' => $self->get('custnum'), + 'last' => $self->get('last'), + 'first' => $self->get('first'), + 'emailaddress' => $email, + 'invoice_dest' => 'Y', # yes, you can set this via the contact + }); + my $error = $contact->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } } @@ -1769,6 +1776,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') @@ -1863,6 +1871,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); @@ -1884,7 +1896,7 @@ sub check_payinfo_cardtype { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; - return '' if $payinfo =~ /^99\d{14}$/; #token + return '' if $self->tokenized($payinfo); #token my %bop_card_types = map { $_=>1 } values %{ card_types() }; my $cardtype = cardtype($payinfo); @@ -2159,7 +2171,11 @@ 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 @@ -2222,10 +2238,9 @@ sub cancel_pkgs { } dbh->commit; - $FS::UID::AutoCommit = 1; my @errors; - # now cancel all services, the same way we would for individual packages. - # if any of them fail, cancel the rest anyway. + # 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] } @@ -2238,8 +2253,15 @@ sub cancel_pkgs { foreach my $cust_svc (@sorted_cust_svc) { my $part_svc = $cust_svc->part_svc; next if ( defined($part_svc) and $part_svc->preserve ); - my $error = $cust_svc->cancel; # immediate cancel, no date option - push @errors, $error if $error; + # 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; @@ -2253,15 +2275,34 @@ sub cancel_pkgs { 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; - $lopt{'reason'} = $cpr->reasonnum; - $lopt{'reason_otaker'} = $cpr->otaker; + if ( $cpr ) { + $lopt{'reason'} = $cpr->reasonnum; + $lopt{'reason_otaker'} = $cpr->otaker; + } else { + warn "no reason found when canceling package ".$_->pkgnum."\n"; + # we're not actually required to pass a reason to cust_pkg::cancel, + # but if we're getting to this point, something has gone awry. + $null_reason ||= FS::reason->new_or_existing( + reason => 'unknown reason', + type => 'Cancel Reason', + class => 'C', + ); + $lopt{'reason'} = $null_reason->reasonnum; + $lopt{'reason_otaker'} = $FS::CurrentUser::CurrentUser->username; + } } my $error = $_->cancel(%lopt); - push @errors, 'pkgnum '.$_->pkgnum.': '.$error if $error; + if ( $error ) { + dbh->rollback; + push @errors, 'pkgnum '.$_->pkgnum.': '.$error; + } else { + dbh->commit; + } } return @errors; @@ -3020,8 +3061,9 @@ sub contact_list_email { my @emails; foreach my $contact (@contacts) { foreach my $contact_email ($contact->contact_email) { - push @emails, - $contact->firstlast . ' <' . $contact_email->emailaddress . '>'; + push @emails, Email::Address->new( $contact->firstlast, + $contact_email->emailaddress + )->format; } } @emails; @@ -3364,6 +3406,22 @@ sub charge_postal_fee { $error ? $error : $cust_pkg; } +=item num_cust_attachment_deleted + +Returns the number of deleted attachments for this customer (see +L). + +=cut + +sub num_cust_attachments_deleted { + my $self = shift; + $self->scalar_sql( + " SELECT COUNT(*) FROM cust_attachment ". + " WHERE custnum = ? AND disabled IS NOT NULL AND disabled > 0", + $self->custnum + ); +} + =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ] Returns all the invoices (see L) for this customer. @@ -4404,6 +4462,10 @@ CHEK only CHEK only +=item saved_cust_payby + +scalar reference, for returning saved object + =back =cut @@ -4600,6 +4662,9 @@ PAYBYLOOP: return $error; } + ${$opt{'saved_cust_payby'}} = $new + if $opt{'saved_cust_payby'}; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -5289,6 +5354,110 @@ 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 (qw( + cust_payby 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'); + } + + # encrypt old records + if ( $conf->exists('encryption') + && ! 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 (qw( + cust_payby 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); + } + + 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('encryption_check'); + } + + # now that everything's encrypted, tokenize... + FS::cust_main::Billing_Realtime::token_check(@_); +} + +# 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. + ' 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