X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=5859727b188a32f052964c16a0b719d734c82425;hb=3a2d8bbc434fbcb96563bd4d437b31db38c76f09;hp=5bb3d2aa1920ea5ccc3c40ef9c074e3cd4126f5e;hpb=55ef5977a4319b9b79e265d99306a141a96eb250;p=freeside.git

diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 5bb3d2aa1..5859727b1 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -106,6 +106,8 @@ FS::cust_pkg - Object methods for cust_pkg objects
 
   $seconds = $record->seconds_since($timestamp);
 
+  #bulk cancel+order... perhaps slightly deprecated, only used by the bulk
+  # cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
   $error = FS::cust_pkg::order( $custnum, \@pkgparts );
   $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
 
@@ -785,14 +787,9 @@ to a different pkgpart or location, and probably shouldn't be in any other
 case.  If it's not set, the 'unused_credit_cancel' part_pkg option will 
 be used.
 
-=item delay_cancel - for internal use, to allow proper handling of
-supplemental packages when the main package is flagged to suspend 
-before cancelling, probably shouldn't be used otherwise (set the
-corresponding package option instead)
-
-=item no_delay_cancel - for internal use, prevents delay_cancel behavior
+=item no_delay_cancel - prevents delay_cancel behavior
 no matter what other options say, for use when changing packages (or any
-other time you're really sure you want an unadulterated cancel)
+other time you're really sure you want an immediate cancel)
 
 =back
 
@@ -800,6 +797,12 @@ If there is an error, returns the error, otherwise returns false.
 
 =cut
 
+#NOT DOCUMENTING - this should only be used when calling recursively
+#=item delay_cancel - for internal use, to allow proper handling of
+#supplemental packages when the main package is flagged to suspend 
+#before cancelling, probably shouldn't be used otherwise (set the
+#corresponding package option instead)
+
 sub cancel {
   my( $self, %options ) = @_;
   my $error;
@@ -1331,6 +1334,7 @@ sub suspend {
       if $error;
   }
 
+  my $cust_pkg_reason;
   if ( $options{'reason'} ) {
     $error = $self->insert_reason( 'reason' => $options{'reason'},
                                    'action' => $date ? 'adjourn' : 'suspend',
@@ -1341,6 +1345,11 @@ sub suspend {
       dbh->rollback if $oldAutoCommit;
       return "Error inserting cust_pkg_reason: $error";
     }
+    $cust_pkg_reason = qsearchs('cust_pkg_reason', {
+        'date'    => $date ? $date : $suspend_time,
+        'action'  => $date ? 'A' : 'S',
+        'pkgnum'  => $self->pkgnum,
+    });
   }
 
   # if a reasonnum was passed, get the actual reason object so we can check
@@ -1395,29 +1404,53 @@ sub suspend {
       }
     }
 
-    my @labels = ();
+    my @cust_svc = qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
+
+    #attempt ordering ala cust_svc_suspend_cascade (without infinite-looping
+    # on the circular dep case)
+    #  (this is too simple for multi-level deps, we need to use something
+    #   to resolve the DAG properly when possible)
+    my %svcpart = ();
+    $svcpart{$_->svcpart} = 0 foreach @cust_svc;
+    foreach my $svcpart ( keys %svcpart ) {
+      foreach my $part_svc_link (
+        FS::part_svc_link->by_agentnum($self->cust_main->agentnum,
+                                         src_svcpart => $svcpart,
+                                         link_type => 'cust_svc_suspend_cascade'
+                                      )
+      ) {
+        $svcpart{$part_svc_link->dst_svcpart} = max(
+          $svcpart{$part_svc_link->dst_svcpart},
+          $svcpart{$part_svc_link->src_svcpart} + 1
+        );
+      }
+    }
+    @cust_svc = sort { $svcpart{ $a->svcpart } <=> $svcpart{ $b->svcpart } }
+                  @cust_svc;
 
-    foreach my $cust_svc (
-      qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
-    ) {
-      my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
+    my @labels = ();
+    foreach my $cust_svc ( @cust_svc ) {
+      $cust_svc->suspend( 'labels_arrayref' => \@labels );
+    }
 
-      $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
-        $dbh->rollback if $oldAutoCommit;
-        return "Illegal svcdb value in part_svc!";
-      };
-      my $svcdb = $1;
-      require "FS/$svcdb.pm";
+    # suspension fees: if there is a feepart, and it's not an unsuspend fee,
+    # and this is not a suspend-before-cancel
+    if ( $cust_pkg_reason ) {
+      my $reason_obj = $cust_pkg_reason->reason;
+      if ( $reason_obj->feepart and
+           ! $reason_obj->fee_on_unsuspend and
+           ! $options{'from_cancel'} ) {
 
-      my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
-      if ($svc) {
-        $error = $svc->suspend;
-        if ( $error ) {
-          $dbh->rollback if $oldAutoCommit;
-          return $error;
-        }
-        my( $label, $value ) = $cust_svc->label;
-        push @labels, "$label: $value";
+        # register the need to charge a fee, cust_main->bill will do the rest
+        warn "registering suspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
+          if $DEBUG;
+        my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
+            'pkgreasonnum'  => $cust_pkg_reason->num,
+            'pkgnum'        => $self->pkgnum,
+            'feepart'       => $reason->feepart,
+            'nextbill'      => $reason->fee_hold,
+        });
+        $error ||= $cust_pkg_reason_fee->insert;
       }
     }
 
@@ -1718,23 +1751,39 @@ sub unsuspend {
 
   my $unsusp_pkg;
 
-  if ( $reason && $reason->unsuspend_pkgpart ) {
-    my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
-      or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
-                  " not found.";
-    my $start_date = $self->cust_main->next_bill_date 
-      if $reason->unsuspend_hold;
-
-    if ( $part_pkg ) {
-      $unsusp_pkg = FS::cust_pkg->new({
-          'custnum'     => $self->custnum,
-          'pkgpart'     => $reason->unsuspend_pkgpart,
-          'start_date'  => $start_date,
-          'locationnum' => $self->locationnum,
-          # discount? probably not...
+  if ( $reason ) {
+    if ( $reason->unsuspend_pkgpart ) {
+      warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n";
+      my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
+        or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
+                    " not found.";
+      my $start_date = $self->cust_main->next_bill_date 
+        if $reason->unsuspend_hold;
+
+      if ( $part_pkg ) {
+        $unsusp_pkg = FS::cust_pkg->new({
+            'custnum'     => $self->custnum,
+            'pkgpart'     => $reason->unsuspend_pkgpart,
+            'start_date'  => $start_date,
+            'locationnum' => $self->locationnum,
+            # discount? probably not...
+        });
+
+        $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+      }
+    }
+    # new way, using fees
+    if ( $reason->feepart and $reason->fee_on_unsuspend ) {
+      # register the need to charge a fee, cust_main->bill will do the rest
+      warn "registering unsuspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
+        if $DEBUG;
+      my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
+          'pkgreasonnum'  => $cust_pkg_reason->num,
+          'pkgnum'        => $self->pkgnum,
+          'feepart'       => $reason->feepart,
+          'nextbill'      => $reason->fee_hold,
       });
-      
-      $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
+      $error ||= $cust_pkg_reason_fee->insert;
     }
 
     if ( $error ) {
@@ -1921,6 +1970,40 @@ sub change {
 
   my $error;
 
+  if ( $opt->{'cust_location'} ) {
+    $error = $opt->{'cust_location'}->find_or_insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "creating location record: $error";
+    }
+    $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
+  }
+
+  # Before going any further here: if the package is still in the pre-setup
+  # state, it's safe to modify it in place. No need to charge/credit for 
+  # partial period, transfer services, transfer usage pools, copy invoice
+  # details, or change any dates.
+  if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
+    foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) {
+      if ( length($opt->{$_}) ) {
+        $self->set($_, $opt->{$_});
+      }
+    }
+    # almost. if the new pkgpart specifies start/adjourn/expire timers, 
+    # apply those.
+    if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
+      $self->set_initial_timers;
+    }
+    $error = $self->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "modifying package: $error";
+    } else {
+      $dbh->commit if $oldAutoCommit;
+      return '';
+    }
+  }
+
   my %hash = (); 
 
   my $time = time;
@@ -1931,15 +2014,6 @@ sub change {
   $hash{"change_$_"}  = $self->$_()
     foreach qw( pkgnum pkgpart locationnum );
 
-  if ( $opt->{'cust_location'} ) {
-    $error = $opt->{'cust_location'}->find_or_insert;
-    if ( $error ) {
-      $dbh->rollback if $oldAutoCommit;
-      return "creating location record: $error";
-    }
-    $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
-  }
-
   if ( $opt->{'cust_pkg'} ) {
     # treat changing to a package with a different pkgpart as a 
     # pkgpart change (because it is)
@@ -1954,6 +2028,7 @@ sub change {
 
   my $unused_credit = 0;
   my $keep_dates = $opt->{'keep_dates'};
+
   # Special case.  If the pkgpart is changing, and the customer is
   # going to be credited for remaining time, don't keep setup, bill, 
   # or last_bill dates, and DO pass the flag to cancel() to credit 
@@ -1967,14 +2042,15 @@ sub change {
   }
 
   if ( $keep_dates ) {
-    foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire 
-                          resume start_date contract_end ) ) {
+    foreach my $date ( qw(setup bill last_bill) ) {
       $hash{$date} = $self->getfield($date);
     }
   }
-  # always keep this date, regardless of anything
-  # (the date of the package change is in a different field)
-  $hash{'order_date'} = $self->getfield('order_date');
+  # always keep the following dates
+  foreach my $date (qw(order_date susp adjourn cancel expire resume 
+                    start_date contract_end)) {
+    $hash{$date} = $self->getfield($date);
+  }
 
   # allow $opt->{'locationnum'} = '' to specifically set it to null
   # (i.e. customer default location)
@@ -1986,6 +2062,9 @@ sub change {
   # 2. (more importantly) changing a package before it's billed
   $hash{'waive_setup'} = $self->waive_setup;
 
+  # if this package is scheduled for a future package change, preserve that
+  $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
+
   my $custnum = $self->custnum;
   if ( $opt->{cust_main} ) {
     my $cust_main = $opt->{cust_main};
@@ -2007,10 +2086,15 @@ sub change {
     # changed from this package.
     $cust_pkg = $opt->{'cust_pkg'};
 
-    foreach ( qw( pkgnum pkgpart locationnum ) ) {
-      $cust_pkg->set("change_$_", $self->get($_));
+    # follow all the above rules for date changes, etc.
+    foreach (keys %hash) {
+      $cust_pkg->set($_, $hash{$_});
+    }
+    # except those that implement the future package change behavior
+    foreach (qw(change_to_pkgnum start_date expire)) {
+      $cust_pkg->set($_, '');
     }
-    $cust_pkg->set('change_date', $time);
+
     $error = $cust_pkg->replace;
 
   } else {
@@ -2032,7 +2116,9 @@ sub change {
   }
 
   # Transfer services and cancel old package.
-
+  # Enforce service limits only if this is a pkgpart change.
+  local $FS::cust_svc::ignore_quantity;
+  $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart;
   $error = $self->transfer($cust_pkg);
   if ($error and $error == 0) {
     # $old_pkg->transfer failed.
@@ -3412,6 +3498,9 @@ 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.
 
+Accepts option I<part_pkg-delay_cancel-days> which should be
+the value of the config setting, to avoid looking it up again.
+
 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.
@@ -3419,15 +3508,18 @@ really the whole point of the delay_cancel option.
 =cut
 
 sub is_status_delay_cancel {
-  my ($self) = @_;
+  my ($self,%opt) = @_;
   if ( $self->main_pkgnum and $self->pkglinknum ) {
     return $self->main_pkg->is_status_delay_cancel;
   }
   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 $expdays = $opt{'part_pkg-delay_cancel-days'};
+  unless ($expdays) {
+    my $conf = new FS::Conf;
+    $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
+  }
   my $expsecs = 60*60*24*$expdays;
   return 0 unless $self->expire < time + $expsecs;
   return 1;
@@ -4684,6 +4776,9 @@ sub _X_show_zero {
 
 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
 
+Bulk cancel + order subroutine.  Perhaps slightly deprecated, only used by the
+bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
+
 CUSTNUM is a customer (see L<FS::cust_main>)
 
 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see