add option to limit automatic unsuspensions to a specific suspension reason type...
[freeside.git] / FS / FS / cust_main.pm
index f8157c4..fb4b153 100644 (file)
@@ -79,6 +79,7 @@ use FS::sales;
 use FS::cust_payby;
 use FS::contact;
 use FS::reason;
+use FS::Misc::Savepoint;
 
 # 1 is mostly method/subroutine entry and options
 # 2 traces progress of some operations
@@ -2063,7 +2064,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
@@ -2212,11 +2213,15 @@ sub cancel_pkgs {
   my( $self, %opt ) = @_;
 
   # we're going to cancel services, which is not reversible
+  #   unless exports are suppressed
   die "cancel_pkgs cannot be run inside a transaction"
-    if $FS::UID::AutoCommit == 0;
+    if !$FS::UID::AutoCommit && !$FS::svc_Common::noexport_hack;
 
+  my $oldAutoCommit = $FS::UID::AutoCommit;
   local $FS::UID::AutoCommit = 0;
 
+  savepoint_create('cancel_pkgs');
+
   return ( 'access denied' )
     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
 
@@ -2233,7 +2238,8 @@ sub cancel_pkgs {
       my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
       my $error = $ban->insert;
       if ($error) {
-        dbh->rollback;
+        savepoint_rollback_and_release('cancel_pkgs');
+        dbh->rollback if $oldAutoCommit;
         return ( $error );
       }
 
@@ -2253,11 +2259,13 @@ sub cancel_pkgs {
                              'time'     => $cancel_time );
     if ($error) {
       warn "Error billing during cancel, custnum ". $self->custnum. ": $error";
-      dbh->rollback;
+      savepoint_rollback_and_release('cancel_pkgs');
+      dbh->rollback if $oldAutoCommit;
       return ( "Error billing during cancellation: $error" );
     }
   }
-  dbh->commit;
+  savepoint_release('cancel_pkgs');
+  dbh->commit if $oldAutoCommit;
 
   my @errors;
   # try to cancel each service, the same way we would for individual packages,
@@ -2271,17 +2279,22 @@ sub cancel_pkgs {
   warn "$me removing ".scalar(@sorted_cust_svc)." service(s) for customer ".
     $self->custnum."\n"
     if $DEBUG;
+  my $i = 0;
   foreach my $cust_svc (@sorted_cust_svc) {
+    my $savepoint = 'cancel_pkgs_'.$i++;
+    savepoint_create( $savepoint );
     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;
+      savepoint_rollback_and_release( $savepoint );
+      dbh->rollback if $oldAutoCommit;
       push @errors, $error;
     } else {
-      dbh->commit;
+      savepoint_release( $savepoint );
+      dbh->commit if $oldAutoCommit;
     }
   }
   if (@errors) {
@@ -2297,8 +2310,11 @@ sub cancel_pkgs {
     @cprs = @{ delete $opt{'cust_pkg_reason'} };
   }
   my $null_reason;
+  $i = 0;
   foreach (@pkgs) {
     my %lopt = %opt;
+    my $savepoint = 'cancel_pkgs_'.$i++;
+    savepoint_create( $savepoint );
     if (@cprs) {
       my $cpr = shift @cprs;
       if ( $cpr ) {
@@ -2319,10 +2335,12 @@ sub cancel_pkgs {
     }
     my $error = $_->cancel(%lopt);
     if ( $error ) {
-      dbh->rollback;
+      savepoint_rollback_and_release( $savepoint );
+      dbh->rollback if $oldAutoCommit;
       push @errors, 'pkgnum '.$_->pkgnum.': '.$error;
     } else {
-      dbh->commit;
+      savepoint_release( $savepoint );
+      dbh->commit if $oldAutoCommit;
     }
   }
 
@@ -3022,48 +3040,104 @@ sub invoicing_list_emailonly_scalar {
   join(', ', $self->invoicing_list_emailonly);
 }
 
-=item contact_list [ CLASSNUM, ... ]
+=item contact_list [ CLASSNUM, DEST_FLAG... ]
 
-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.
+Returns a list of contacts (L<FS::contact> objects) for the customer.
 
 If no arguments are given, returns all contacts for the customer.
 
+Arguments may contain classnums.  When classnums are specified, only
+contacts with a matching cust_contact.classnum are returned.  When a
+classnum of 0 is given, contacts with a null classnum are also included.
+
+Arguments may also contain the dest flag names 'invoice' or 'message'.
+If given, contacts who's invoice_dest and/or message_dest flags are
+not set to 'Y' will be excluded.
+
 =cut
 
 sub contact_list {
   my $self = shift;
   my $search = {
     table       => 'contact',
-    select      => 'contact.*, cust_contact.invoice_dest',
+    select      => join(', ',(
+                    'contact.*',
+                    'cust_contact.invoice_dest',
+                    'cust_contact.message_dest',
+    )),
     addl_from   => ' JOIN cust_contact USING (contactnum)',
     extra_sql   => ' WHERE cust_contact.custnum = '.$self->custnum,
   };
 
-  my @orwhere;
+  # Bugfix notes:
+  #   Calling methods were relying on this method to use invoice_dest to
+  #   block e-mail messages.  Depending on parameters, this may or may not
+  #   have actually happened.
+  #
+  #   The bug could cause this SQL to be used to filter e-mail addresses:
+  #
+  #   AND (
+  #     cust_contact.classnums IN (1,2,3)
+  #     OR cust_contact.invoice_dest = 'Y'
+  #   )
+  #
+  #   improperly including everybody with the opt-in flag AND everybody
+  #   in the contact classes
+  #
+  # Possibility to introduce new bugs:
+  #   If callers of this method called it incorrectly, and didn't notice
+  #   because it seemed to send the e-mails they wanted.
+
+  # WHERE ...
+  # AND (
+  #   (
+  #     cust_contact.classnum IN (1,2,3)
+  #     OR
+  #     cust_contact.classnum IS NULL
+  #   )
+  #   AND (
+  #     cust_contact.invoice_dest = 'Y'
+  #     OR
+  #     cust_contact.message_dest = 'Y'
+  #   )
+  # )
+
+  my @and_dest;
+  my @or_classnum;
   my @classnums;
-  foreach (@_) {
-    if ( $_ eq 'invoice' ) {
-      push @orwhere, 'cust_contact.invoice_dest = \'Y\'';
-    } elsif ( $_ eq '0' ) {
-      push @orwhere, 'cust_contact.classnum is null';
+  for (@_) {
+    if ($_ eq 'invoice' || $_ eq 'message') {
+      push @and_dest, " cust_contact.${_}_dest = 'Y' ";
+    } elsif ($_ eq '0') {
+      push @or_classnum, ' cust_contact.classnum IS NULL ';
     } elsif ( /^\d+$/ ) {
       push @classnums, $_;
     } else {
-      die "bad classnum argument '$_'";
+      croak "bad classnum argument '$_'";
     }
   }
 
-  if (@classnums) {
-    push @orwhere, 'cust_contact.classnum IN ('.join(',', @classnums).')';
-  }
-  if (@orwhere) {
-    $search->{extra_sql} .= ' AND (' .
-                            join(' OR ', map "( $_ )", @orwhere) .
-                            ')';
+  push @or_classnum, 'cust_contact.classnum IN ('.join(',',@classnums).')'
+    if @classnums;
+
+  if (@or_classnum || @and_dest) { # catch, no arguments given
+    $search->{extra_sql} .= ' AND ( ';
+
+      if (@or_classnum) {
+        $search->{extra_sql} .= ' ( ';
+        $search->{extra_sql} .= join ' OR ', map {" $_ "} @or_classnum;
+        $search->{extra_sql} .= ' ) ';
+        $search->{extra_sql} .= ' AND ( ' if @and_dest;
+      }
+
+      if (@and_dest) {
+        $search->{extra_sql} .= join ' OR ', map {" $_ "} @and_dest;
+        $search->{extra_sql} .= ' ) ' if @or_classnum;
+      }
+
+    $search->{extra_sql} .= ' ) ';
+
+    warn "\$extra_sql: $search->{extra_sql} \n" if $DEBUG;
   }
 
   qsearch($search);
@@ -3866,6 +3940,27 @@ sub name {
   $name;
 }
 
+=item batch_payment_payname
+
+Returns a name string for this customer, either "cust_batch_payment->payname" or "First Last" or "Company,
+based on if a company name exists and is the account being used a business account.
+
+=cut
+
+sub batch_payment_payname {
+  my $self = shift;
+  my $cust_pay_batch = shift;
+  my $name;
+
+  if ($cust_pay_batch->{Hash}->{payby} eq "CARD") { $name = $cust_pay_batch->payname; }
+  else { $name = $self->first .' '. $self->last; }
+
+  $name = $self->company
+    if (($cust_pay_batch->{Hash}->{paytype} eq "Business checking" || $cust_pay_batch->{Hash}->{paytype} eq "Business savings") && $self->company);
+
+  $name;
+}
+
 =item service_contact
 
 Returns the L<FS::contact> object for this customer that has the 'Service'
@@ -4617,6 +4712,8 @@ PAYBYLOOP:
         next if grep(/^$field$/, qw( custpaybynum payby weight ) );
         next if grep(/^$field$/, @preserve );
         next PAYBYLOOP unless $new->get($field) eq $cust_payby->get($field);
+        # check if paymask exists,  if so stop and don't save, no need for a duplicate.
+        return '' if $new->get('paymask') eq $cust_payby->get('paymask');
       }
       # now check fields that can replace if one value is blank
       my $replace = 0;
@@ -5335,6 +5432,16 @@ sub process_bill_and_collect {
   $cust_main->bill_and_collect( %$param );
 }
 
+=item pending_invoice_count
+
+Return number of cust_bill with pending=Y for this customer
+
+=cut
+
+sub pending_invoice_count {
+  FS::cust_bill->count( 'custnum = '.shift->custnum."AND pending = 'Y'" );
+}
+
 #starting to take quite a while for big dbs
 #   (JRNL: journaled so it only happens once per database)
 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
@@ -5538,4 +5645,3 @@ L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
 =cut
 
 1;
-