suspend event option to skip packages with a start_date, RT#83847
[freeside.git] / FS / FS / cust_main.pm
index b8d8f10..9e305c7 100644 (file)
@@ -79,6 +79,8 @@ use FS::sales;
 use FS::cust_payby;
 use FS::contact;
 use FS::reason;
+use FS::Misc::Savepoint;
+use FS::DBI;
 
 # 1 is mostly method/subroutine entry and options
 # 2 traces progress of some operations
@@ -271,7 +273,7 @@ Enable individual CDR spooling, empty or `Y'
 
 =item dundate
 
-A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
+A suggestion to events (see L<FS::part_bill_event>) to delay until this unix timestamp
 
 =item squelch_cdr
 
@@ -742,20 +744,6 @@ sub insert {
     }
   }
 
-  # FS::geocode_Mixin::after_insert or something?
-  if ( $conf->config('tax_district_method') and !$import ) {
-    # if anything non-empty, try to look it up
-    my $queue = new FS::queue {
-      'job'     => 'FS::geocode_Mixin::process_district_update',
-      'custnum' => $self->custnum,
-    };
-    my $error = $queue->insert( ref($self), $self->custnum );
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "queueing tax district update: $error";
-    }
-  }
-
   # cust_main exports!
   warn "  exporting\n" if $DEBUG > 1;
 
@@ -1259,7 +1247,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";
   }
 
@@ -2063,7 +2051,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
@@ -2087,8 +2075,14 @@ Returns a list: an empty list on success or a list of errors.
 =cut
 
 sub suspend {
-  my $self = shift;
-  grep { $_->suspend(@_) } $self->unsuspended_pkgs;
+  my($self, %opt) = @_;
+
+  my @pkgs = $self->unsuspended_pkgs;
+
+  @pkgs = grep { ! $_->get('start_date') } @pkgs
+    if $opt{skip_future_startdate};
+
+  grep { $_->suspend(%opt) } @pkgs;
 }
 
 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
@@ -2192,7 +2186,7 @@ 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
+=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>)
@@ -2212,11 +2206,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 +2231,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 +2252,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 +2272,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 +2303,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 +2328,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;
     }
   }
 
@@ -2726,7 +2737,7 @@ UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
 L<Date::Parse> for conversion functions.  The empty string can be passed
 to disable that time constraint completely.
 
-Accepts the same options as L<balance_date_sql>:
+Accepts the same options as L</balance_date_sql>:
 
 =over 4
 
@@ -3033,7 +3044,7 @@ 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 invoice_message flags are
+If given, contacts who's invoice_dest and/or message_dest flags are
 not set to 'Y' will be excluded.
 
 =cut
@@ -3072,14 +3083,15 @@ sub contact_list {
 
   # WHERE ...
   # AND (
-  #   ( cust_contact.classnum IN (1,2,3) )
-  #   OR
-  #   ( cust_contact.classnum IS NULL )
-  #
+  #   (
+  #     cust_contact.classnum IN (1,2,3)
+  #     OR
+  #     cust_contact.classnum IS NULL
+  #   )
   #   AND (
-  #     ( cust_contact.invoice_dest = 'Y' )
+  #     cust_contact.invoice_dest = 'Y'
   #     OR
-  #     ( cust_contact.message_dest = 'Y' )
+  #     cust_contact.message_dest = 'Y'
   #   )
   # )
 
@@ -3105,12 +3117,14 @@ sub contact_list {
     $search->{extra_sql} .= ' AND ( ';
 
       if (@or_classnum) {
-        $search->{extra_sql} .= join ' OR ', map {" ($_) "} @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} .= join ' OR ', map {" $_ "} @and_dest;
         $search->{extra_sql} .= ' ) ' if @or_classnum;
       }
 
@@ -3143,6 +3157,127 @@ sub contact_list_email {
   @emails;
 }
 
+=item contact_list_email_destinations
+
+Returns a list of emails and whether they receive invoices or messages destinations.
+{ emailaddress => 'email.com', invoice => 'Y', message => '', }
+
+=cut
+
+sub contact_list_email_destinations {
+  my $self = shift;
+  warn "$me contact_list_email_destinations"
+    if $DEBUG;
+  return () if !$self->custnum; # not yet inserted
+  return map { $_ }
+    qsearch({
+        table     => 'cust_contact',
+        select    => 'emailaddress, cust_contact.invoice_dest as invoice, cust_contact.message_dest as message',
+        addl_from => ' JOIN contact USING (contactnum) '.
+                     ' JOIN contact_email USING (contactnum)',
+        hashref   => { 'custnum' => $self->custnum, },
+        order_by  => 'ORDER BY custcontactnum DESC',
+        extra_sql => '',
+    });
+}
+
+=item contact_list_name_phones
+
+Returns a list of contact phone numbers.
+{ phonetypenum => '1', phonenum => 'xxxxxxxxxx', first => 'firstname', last => 'lastname', countrycode => '1' }
+
+=cut
+
+sub contact_list_name_phones {
+  my $self = shift;
+  my $phone_type = shift;
+
+  warn "$me contact_list_phones" if $DEBUG;
+
+  return () if !$self->custnum; # not yet inserted
+  return map { $_ }
+    qsearch({
+        table     => 'cust_contact',
+        select    => 'phonetypenum, phonenum, first, last, countrycode',
+        addl_from => ' JOIN contact USING (contactnum) '.
+                     ' JOIN contact_phone USING (contactnum)',
+        hashref   => { 'custnum' => $self->custnum, 'phonetypenum' => $phone_type, },
+        order_by  => 'ORDER BY custcontactnum DESC',
+        extra_sql => '',
+    });
+}
+
+=item contact_list_emailonly
+
+Returns an array of hashes containing the emails. Used for displaying contact email field in advanced customer reports.
+[ { data => 'email.com', }, ]
+
+=cut
+
+sub contact_list_emailonly {
+  my $self = shift;
+  warn "$me contact_list_emailonly called"
+    if $DEBUG;
+  my @emails;
+  foreach ($self->contact_list_email_destinations) {
+    my $data = [
+      {
+        'data'  => $_->emailaddress,
+      },
+    ];
+    push @emails, $data;
+  }
+  return \@emails;
+}
+
+=item contact_list_cust_invoice_only
+
+Returns an array of hashes containing cust_contact.invoice_dest.  Does this email receive invoices. Used for displaying email Invoice field in advanced customer reports.
+[ { data => 'Yes', }, ]
+
+=cut
+
+sub contact_list_cust_invoice_only {
+  my $self = shift;
+  warn "$me contact_list_cust_invoice_only called"
+    if $DEBUG;
+  my @emails;
+  foreach ($self->contact_list_email_destinations) {
+    my $invoice = $_->invoice ? 'Yes' : 'No';
+    my $data = [
+      {
+        'data'  => $invoice,
+      },
+    ];
+    push @emails, $data;
+  }
+  return \@emails;
+}
+
+=item contact_list_cust_message_only
+
+Returns an array of hashes containing cust_contact.message_dest.  Does this email receive message notifications. Used for displaying email Message field in advanced customer reports.
+[ { data => 'Yes', }, ]
+
+=cut
+
+sub contact_list_cust_message_only {
+  my $self = shift;
+  warn "$me contact_list_cust_message_only called"
+    if $DEBUG;
+  my @emails;
+  foreach ($self->contact_list_email_destinations) {
+    my $message = $_->message ? 'Yes' : 'No';
+    my $data = [
+      {
+        'data'  => $message,
+      },
+    ];
+    push @emails, $data;
+  }
+  return \@emails;
+}
+
 =item referral_custnum_cust_main
 
 Returns the customer who referred this customer (or the empty string, if
@@ -3919,6 +4054,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'
@@ -5387,7 +5543,68 @@ sub process_bill_and_collect {
   $param->{'fatal'} = 1; # runs from job queue, will be caught
   $param->{'retry'} = 1;
 
-  $cust_main->bill_and_collect( %$param );
+  local $@;
+  eval { $cust_main->bill_and_collect( %$param) };
+  if ( $@ ) {
+    die $@ =~ /cancel_pkgs cannot be run inside a transaction/
+      ? "Bill Now unavailable for customer with pending package expiration\n"
+      : $@;
+  }
+}
+
+=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'" );
+}
+
+=item cust_locations_missing_district
+
+Always returns empty list, unless tax_district_method eq 'wa_sales'
+
+Return cust_location rows for this customer, associated with active
+customer packages, where tax district column is empty.  Presense of
+these rows should block billing, because invoice would be generated
+with incorrect taxes
+
+=cut
+
+sub cust_locations_missing_district {
+  my ( $self ) = @_;
+
+  my $tax_district_method = FS::Conf->new->config('tax_district_method');
+
+  return ()
+    unless $tax_district_method
+        && $tax_district_method eq 'wa_sales';
+
+  qsearch({
+    table => 'cust_location',
+    select => 'cust_location.*',
+    addl_from => '
+      LEFT JOIN cust_main USING (custnum)
+      LEFT JOIN cust_pkg ON cust_location.locationnum = cust_pkg.locationnum
+    ',
+    extra_sql => sprintf(q{
+        WHERE cust_location.state = 'WA'
+        AND   cust_location.custnum = %s
+        AND (
+             cust_location.district IS NULL
+          or cust_location.district = ''
+        )
+        AND cust_pkg.pkgnum IS NOT NULL
+        AND (
+             cust_pkg.cancel > %s
+          OR cust_pkg.cancel IS NULL
+        )
+      },
+      $self->custnum, time()
+    ),
+  });
 }
 
 #starting to take quite a while for big dbs