X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=21dce1fdac4b920f0b8da562fd0be3588c01c3f6;hb=ab83ed2eed479b689060e686098998df990dd140;hp=ef3ab61a766fe8435a34653a78948b37cafb9e61;hpb=755159a8654a2eda89badd1498f8def3a472cb15;p=freeside.git

diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index ef3ab61a7..21dce1fda 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'
@@ -542,6 +548,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;
 
@@ -1538,6 +1554,25 @@ sub replace {
   {
     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"
@@ -1819,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')
@@ -1932,9 +1968,12 @@ 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);
+    $cardtype = 'Tokenized' if $self->payinfo =~ /^99\d{14}$/; # token
+
+    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 } );
@@ -1956,7 +1995,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);
@@ -1969,7 +2008,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"
@@ -2066,6 +2104,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 '-' ) {
@@ -2117,6 +2160,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);
@@ -2138,10 +2185,14 @@ sub check_payinfo_cardtype {
   my $payinfo = $self->payinfo;
   $payinfo =~ s/\D//g;
 
-  return '' if $payinfo =~ /^99\d{14}$/; #token
+  if ( $payinfo =~ /^99\d{14}$/ ) {
+    $self->set('paycardtype', 'Tokenized');
+    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};
 
@@ -2334,33 +2385,64 @@ sub suspend_unless_pkgpart {
 =item cancel [ OPTION => VALUE ... ]
 
 Cancels all uncancelled packages (see L<FS::cust_pkg>) 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<FS:reason>), 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<FS::reason_type>, reason - Text of the new reason.
+=item reason - can be set to a cancellation reason (see L<FS:reason>), 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<FS::reason_type>)
+reason - Text of the new reason.
+
+=item cust_pkg_reason - can be an arrayref of L<FS::cust_pkg_reason> objects
+for the individual packages, parallel to the C<cust_pkg> 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');
@@ -2374,24 +2456,80 @@ 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;
+
+  $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.
+  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 );
+    my $error = $cust_svc->cancel; # immediate cancel, no date option
+    push @errors, $error if $error;
+  }
+  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);
+    push @errors, 'pkgnum '.$_->pkgnum.': '.$error if $error;
+  }
+
+  return @errors;
 }
 
 sub _banned_pay_hashref {
@@ -3367,9 +3505,7 @@ sub invoicing_list_emailonly_scalar {
 
 Returns a list of contacts (L<FS::contact> objects) for the customer. If
 a list of contact classnums is given, returns only contacts in those
-classes. If the pseudo-classnum 'invoice' is given, returns contacts that
-are marked as invoice destinations. If '0' is given, also returns contacts
-with no class.
+classes. If '0' is given, also returns contacts with no class.
 
 If no arguments are given, returns all contacts for the customer.
 
@@ -3379,18 +3515,15 @@ sub contact_list {
   my $self = shift;
   my $search = {
     table       => 'contact',
-    select      => 'contact.*, cust_contact.invoice_dest',
-    addl_from   => ' JOIN cust_contact USING (contactnum)',
-    extra_sql   => ' WHERE cust_contact.custnum = '.$self->custnum,
+    select      => 'contact.*',
+    extra_sql   => ' WHERE contact.custnum = '.$self->custnum,
   };
 
   my @orwhere;
   my @classnums;
   foreach (@_) {
-    if ( $_ eq 'invoice' ) {
-      push @orwhere, 'cust_contact.invoice_dest = \'Y\'';
-    } elsif ( $_ eq '0' ) {
-      push @orwhere, 'cust_contact.classnum is null';
+    if ( $_ eq '0' ) {
+      push @orwhere, 'contact.classnum is null';
     } elsif ( /^\d+$/ ) {
       push @classnums, $_;
     } else {
@@ -3399,7 +3532,7 @@ sub contact_list {
   }
 
   if (@classnums) {
-    push @orwhere, 'cust_contact.classnum IN ('.join(',', @classnums).')';
+    push @orwhere, 'contact.classnum IN ('.join(',', @classnums).')';
   }
   if (@orwhere) {
     $search->{extra_sql} .= ' AND (' .
@@ -3413,21 +3546,46 @@ sub contact_list {
 =item contact_list_email [ CLASSNUM, ... ]
 
 Same as L</contact_list>, but returns email destinations instead of contact
-objects.
+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 @contacts = $self->contact_list(@_);
-  my @emails;
-  foreach my $contact (@contacts) {
-    foreach my $contact_email ($contact->contact_email) {
-      push @emails,
-        $contact->firstlast . ' <' . $contact_email->emailaddress . '>';
+  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;
     }
   }
-  @emails;
+  values %emails;
 }
 
 =item referral_custnum_cust_main
@@ -4848,15 +5006,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
 
@@ -5581,6 +5734,99 @@ 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');
+  }
+
+  # 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 ('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);
+        }
+
+        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 if $error;
+      }
+    }
+
+    FS::upgrade_journal->set_done('encryption_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