X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=1cc83b6a0795eba4a7c394c172619b7cbc685c1b;hb=4d0db1129018d2f598091edbbffeb09b23c64d99;hp=6d3ed2e508d1fc515f22e850015dddfe964ec24f;hpb=edea94b6bd41a3fceac47267a3df3dc7fcf7c565;p=freeside.git

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 6d3ed2e50..1cc83b6a0 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -795,7 +795,9 @@ sub cancel {
   my $error;
 
   # pass all suspend/cancel actions to the main package
-  if ( $self->main_pkgnum and !$options{'from_main'} ) {
+  # (unless the pkglinknum has been removed, then the link is defunct and
+  # this package can be canceled on its own)
+  if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
     return $self->main_pkg->cancel(%options);
   }
 
@@ -821,6 +823,20 @@ sub cancel {
   my $date = $options{'date'} if $options{'date'}; # expire/cancel later
   $date = '' if ($date && $date <= $cancel_time);      # complain instead?
 
+  my $delay_cancel = undef;
+  if ( !$date && $self->part_pkg->option('delay_cancel',1)
+       && (($self->status eq 'active') || ($self->status eq 'suspended'))
+  ) {
+    my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+    my $expsecs = 60*60*24*$expdays;
+    my $suspfor = $self->susp ? $cancel_time - $self->susp : 0;
+    $expsecs = $expsecs - $suspfor if $suspfor;
+    unless ($expsecs <= 0) { #if it's already been suspended long enough, don't re-suspend
+      $delay_cancel = 1;
+      $date = $cancel_time + $expsecs;
+    }
+  }
+
   #race condition: usage could be ongoing until unprovisioned
   #resolved by performing a change package instead (which unprovisions) and
   #later cancelling
@@ -891,11 +907,22 @@ sub cancel {
   my %hash = $self->hash;
   if ( $date ) {
     $hash{'expire'} = $date;
+    if ($delay_cancel) {
+      $hash{'susp'} = $cancel_time unless $self->susp;
+      $hash{'adjourn'} = undef;
+      $hash{'resume'} = undef;
+    }
   } else {
     $hash{'cancel'} = $cancel_time;
   }
   $hash{'change_custnum'} = $options{'change_custnum'};
 
+  # if this is a supplemental package that's lost its part_pkg_link, and it's
+  # being canceled for real, unlink it completely
+  if ( !$date and ! $self->pkglinknum ) {
+    $hash{main_pkgnum} = '';
+  }
+
   my $new = new FS::cust_pkg ( \%hash );
   $error = $new->replace( $self, options => { $self->options } );
   if ( $self->change_to_pkgnum ) {
@@ -939,7 +966,7 @@ sub cancel {
     }
     else {
       $error = send_email(
-        'from'    => $conf->config('invoice_from', $self->cust_main->agentnum),
+        'from'    => $conf->invoice_from_full( $self->cust_main->agentnum ),
         'to'      => \@invoicing_list,
         'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
         'body'    => [ map "$_\n", $conf->config('cancelmessage') ],
@@ -1199,7 +1226,7 @@ Available options are:
 
 =over 4
 
-=item reason - can be set to a cancellation reason (see L<FS: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>
@@ -1289,6 +1316,16 @@ sub suspend {
     }
   }
 
+  # if a reasonnum was passed, get the actual reason object so we can check
+  # unused_credit
+  # (passing a reason hashref is still allowed, but it can't be used with
+  # the fancy behavioral options.)
+
+  my $reason;
+  if ($options{'reason'} =~ /^\d+$/) {
+    $reason = FS::reason->by_key($options{'reason'});
+  }
+
   my %hash = $self->hash;
   if ( $date ) {
     $hash{'adjourn'} = $date;
@@ -1313,9 +1350,15 @@ sub suspend {
     return $error;
   }
 
-  unless ( $date ) {
+  unless ( $date ) { # then we are suspending now
+
     # credit remaining time if appropriate
-    if ( $self->part_pkg->option('unused_credit_suspend', 1) ) {
+    # (if required by the package def, or the suspend reason)
+    my $unused_credit = $self->part_pkg->option('unused_credit_suspend',1)
+                        || ( defined($reason) && $reason->unused_credit );
+
+    if ( $unused_credit ) {
+      warn "crediting unused time on pkg#".$self->pkgnum."\n" if $DEBUG;
       my $error = $self->credit_remaining('suspend', $suspend_time);
       if ($error) {
         $dbh->rollback if $oldAutoCommit;
@@ -1400,6 +1443,21 @@ are mandatory.
 
 =cut
 
+# Implementation note:
+#
+# If you pkgpart-change a package that has been billed, and it's set to give
+# credit on package change, then this method gets called and then the new
+# package will have no last_bill date. Therefore the customer will be credited
+# only once (per billing period) even if there are multiple package changes.
+#
+# If you location-change a package that has been billed, this method will NOT
+# be called and the new package WILL have the last bill date of the old
+# package.
+#
+# If the new package is then canceled within the same billing cycle, 
+# credit_remaining needs to run calc_remain on the OLD package to determine
+# the amount of unused time to credit.
+
 sub credit_remaining {
   # Add a credit for remaining service
   my ($self, $mode, $time) = @_;
@@ -1416,7 +1474,30 @@ sub credit_remaining {
       and $next_bill > 0      # the package has a next bill date
       and $next_bill >= $time # which is in the future
   ) {
-    my $remaining_value = $self->calc_remain('time' => $time);
+    my @cust_credit_source_bill_pkg = ();
+    my $remaining_value = 0;
+
+    my $remain_pkg = $self;
+    $remaining_value = $remain_pkg->calc_remain(
+      'time' => $time, 
+      'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
+    );
+
+    # we may have to walk back past some package changes to get to the 
+    # one that actually has unused time
+    while ( $remaining_value == 0 ) {
+      if ( $remain_pkg->change_pkgnum ) {
+        $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum);
+      } else {
+        # the package has really never been billed
+        return;
+      }
+      $remaining_value = $remain_pkg->calc_remain(
+        'time' => $time, 
+        'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
+      );
+    }
+
     if ( $remaining_value > 0 ) {
       warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
         if $DEBUG;
@@ -1424,6 +1505,7 @@ sub credit_remaining {
         $remaining_value,
         'Credit for unused time on '. $self->part_pkg->pkg,
         'reason_type' => $reason_type,
+        'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg,
       );
       return "Error crediting customer \$$remaining_value for unused time".
         " on ". $self->part_pkg->pkg. ": $error"
@@ -1554,19 +1636,41 @@ sub unsuspend {
   my $conf = new FS::Conf;
 
   #adjust the next bill date forward
-  $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
-    if $inactive > 0
+  # increment next bill date if certain conditions are met:
+  # - it was due to be billed at some point
+  # - either the global or local config says to do this
+  my $adjust_bill = 0;
+  if (
+       $inactive > 0
     && ( $hash{'bill'} || $hash{'setup'} )
     && (    $opt{'adjust_next_bill'}
          || $conf->exists('unsuspend-always_adjust_next_bill_date')
          || $self->part_pkg->option('unsuspend_adjust_bill', 1)
        )
-    && ! $self->option('suspend_bill',1)
-    && (    ! $self->part_pkg->option('suspend_bill',1)
-         || $self->option('no_suspend_bill',1)
-       )
-    && $hash{'order_date'} != $hash{'susp'}
-  ;
+  ) {
+    $adjust_bill = 1;
+  }
+
+  # but not if:
+  # - the package billed during suspension
+  # - or it was ordered on hold
+  # - or the customer was credited for the unused time
+
+  if ( $self->option('suspend_bill',1)
+      or ( $self->part_pkg->option('suspend_bill',1)
+           and ! $self->option('no_suspend_bill',1)
+         )
+      or $hash{'order_date'} == $hash{'susp'}
+      or $self->part_pkg->option('unused_credit_suspend')
+      or ( ref($reason) and $reason->unused_credit )
+  ) {
+    $adjust_bill = 0;
+  }
+
+  # then add the length of time suspended to the bill date
+  if ( $adjust_bill ) {
+    $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
+  }
 
   $hash{'susp'} = '';
   $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
@@ -2338,29 +2442,46 @@ sub modify_charge {
   }
 
   if ( !$self->get('setup') ) {
-    # not yet billed, so allow amount and quantity
+    # not yet billed, so allow amount, setup_cost, quantity and start_date
+
+    if ( exists($opt{'amount'}) 
+          and $part_pkg->option('setup_fee') != $opt{'amount'}
+          and $opt{'amount'} > 0 ) {
+
+      $pkg_opt{'setup_fee'} = $opt{'amount'};
+      $pkg_opt_modified = 1;
+    }
+
+    if ( exists($opt{'setup_cost'}) 
+          and $part_pkg->setup_cost != $opt{'setup_cost'}
+          and $opt{'setup_cost'} > 0 ) {
+
+      $part_pkg->set('setup_cost', $opt{'setup_cost'});
+    }
+
     if ( exists($opt{'quantity'})
           and $opt{'quantity'} != $self->quantity
           and $opt{'quantity'} > 0 ) {
         
       $self->set('quantity', $opt{'quantity'});
     }
+
     if ( exists($opt{'start_date'})
           and $opt{'start_date'} != $self->start_date ) {
 
       $self->set('start_date', $opt{'start_date'});
     }
 
-    if ( exists($opt{'amount'}) 
-          and $part_pkg->option('setup_fee') != $opt{'amount'}
-          and $opt{'amount'} > 0 ) {
-
-      $pkg_opt{'setup_fee'} = $opt{'amount'};
-      $pkg_opt_modified = 1;
 
-    }
   } # else simply ignore them; the UI shouldn't allow editing the fields
 
+  
+  if ( exists($opt{'taxclass'}) 
+          and $part_pkg->taxclass ne $opt{'taxclass'}) {
+    
+      $part_pkg->set('taxclass', $opt{'taxclass'});
+  }
+
   my $error;
   if ( $part_pkg->modified or $pkg_opt_modified ) {
     # can we safely modify the package def?
@@ -2458,12 +2579,10 @@ sub modify_charge {
 
 
 
-use Storable 'thaw';
-use MIME::Base64;
 use Data::Dumper;
 sub process_bulk_cust_pkg {
   my $job = shift;
-  my $param = thaw(decode_base64(shift));
+  my $param = shift;
   warn Dumper($param) if $DEBUG;
 
   my $old_part_pkg = qsearchs('part_pkg', 
@@ -2902,12 +3021,16 @@ sub h_cust_svc {
     if $DEBUG;
 
   my ($end, $start, $mode) = @_;
+
+  local($FS::Record::qsearch_qualify_columns) = 0;
+
   my @cust_svc = $self->_sort_cust_svc(
     [ qsearch( 'h_cust_svc',
       { 'pkgnum' => $self->pkgnum, },  
       FS::h_cust_svc->sql_h_search(@_),  
     ) ]
   );
+
   if ( defined($mode) && $mode eq 'I' ) {
     my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
     return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
@@ -3239,6 +3362,31 @@ sub statuscolor {
   $statuscolor{$self->status};
 }
 
+=item is_status_delay_cancel
+
+Returns true if part_pkg has option delay_cancel, 
+cust_pkg status is 'suspended' and expire is set
+to cancel package within the next day (or however
+many days are set in global config part_pkg-delay_cancel-days.
+
+This is not a real status, this only meant for hacking display 
+values, because otherwise treating the package as suspended is 
+really the whole point of the delay_cancel option.
+
+=cut
+
+sub is_status_delay_cancel {
+  my ($self) = @_;
+  return 0 unless $self->part_pkg->option('delay_cancel',1);
+  return 0 unless $self->status eq 'suspended';
+  return 0 unless $self->expire;
+  my $conf = new FS::Conf;
+  my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+  my $expsecs = 60*60*24*$expdays;
+  return 0 unless $self->expire < time + $expsecs;
+  return 1;
+}
+
 =item pkg_label
 
 Returns a label for this package.  (Currently "pkgnum: pkg - comment" or
@@ -3866,7 +4014,7 @@ sub insert_reason {
     $reasonnum = $reason->reasonnum;
 
   } else {
-    return "Unparsable reason: ". $options{'reason'};
+    return "Unparseable reason: ". $options{'reason'};
   }
 
   my $cust_pkg_reason =
@@ -4712,6 +4860,23 @@ sub _upgrade_data {  # class method
     my $sth = dbh->prepare($sql);
     $sth->execute or die $sth->errstr;
   }
+
+  # RT31194: supplemental package links that are deleted don't clean up 
+  # linked records
+  my @pkglinknums = qsearch({
+      'select'    => 'DISTINCT cust_pkg.pkglinknum',
+      'table'     => 'cust_pkg',
+      'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ',
+      'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL 
+                        AND part_pkg_link.pkglinknum IS NULL',
+  });
+  foreach (@pkglinknums) {
+    my $pkglinknum = $_->pkglinknum;
+    warn "cleaning part_pkg_link #$pkglinknum\n";
+    my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum});
+    my $error = $part_pkg_link->remove_linked;
+    die $error if $error;
+  }
 }
 
 =back