X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=3fb0a87fb54869a464f900fb87af75ef8f4f7b1e;hb=3cbdd85a96348a287623e3b97c937c7749e99392;hp=5af1b31bd7bf11b9745d3c04c8d6af9b618ce17f;hpb=a9a0e9deba329f2427082e5c30a308d11118b5e0;p=freeside.git

diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index 5af1b31bd..3fb0a87fb 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -2126,36 +2126,59 @@ 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 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 ) = @_;
 
-  my $oldAutoCommit = $FS::UID::AutoCommit;
-  local $FS::UID::AutoCommit = 0;
+  # we're going to cancel services, which is not reversible
+  die "cancel_pkgs cannot 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');
@@ -2173,7 +2196,7 @@ sub cancel {
       my $ban = new FS::banned_pay $cust_payby->_new_banned_pay_hashref;
       my $error = $ban->insert;
       if ($error) {
-        dbh->rollback if $oldAutoCommit;
+        dbh->rollback;
         return ( $error );
       }
 
@@ -2181,29 +2204,33 @@ sub cancel {
 
   }
 
-  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"
@@ -2215,8 +2242,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;
   }
 
@@ -2224,13 +2249,22 @@ 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'} };
+  }
+  foreach (@pkgs) {
+    my %lopt = %opt;
+    if (@cprs) {
+      my $cpr = shift @cprs;
+      $lopt{'reason'}        = $cpr->reasonnum;
+      $lopt{'reason_otaker'} = $cpr->otaker;
+    }
+    my $error = $_->cancel(%lopt);
+    push @errors, 'pkgnum '.$_->pkgnum.': '.$error if $error;
   }
 
-  return;
+  return @errors;
 }
 
 sub _banned_pay_hashref {
@@ -4735,15 +4769,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