when changing a package with scheduled expiration, transfer the expiration reason...
[freeside.git] / FS / FS / cust_pkg.pm
index 1cc8235..8d16fe0 100644 (file)
@@ -1129,6 +1129,166 @@ sub cancel_if_expired {
   '';
 }
 
+=item uncancel_svc_x
+
+For cancelled cust_pkg, returns a list of new, uninserted FS::svc_X records 
+for services that would be inserted by L</uncancel>.  Returned objects also
+include the field _h_svc_x, which contains the service history object.
+
+Set pkgnum before inserting.
+
+Accepts the following options:
+
+only_svcnum - arrayref of svcnum, only returns objects for these svcnum 
+(and only if they would otherwise be returned by this)
+
+=cut
+
+sub uncancel_svc_x {
+  my ($self, %opt) = @_;
+
+  die 'uncancel_svc_x called on a non-cancelled cust_pkg' unless $self->get('cancel');
+
+  #find historical services within this timeframe before the package cancel
+  # (incompatible with "time" option to cust_pkg->cancel?)
+  my $fuzz = 2 * 60; #2 minutes?  too much?   (might catch separate unprovision)
+                     #            too little? (unprovisioing export delay?)
+  my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
+  my @h_cust_svc = $self->h_cust_svc( $end, $start );
+
+  my @svc_x;
+  foreach my $h_cust_svc (@h_cust_svc) {
+    next if $opt{'only_svcnum'} && !(grep { $_ == $h_cust_svc->svcnum } @{$opt{'only_svcnum'}});
+    # filter out services that still exist on this package (ie preserved svcs)
+    # but keep services that have since been provisioned on another package (for informational purposes)
+    next if qsearchs('cust_svc',{ 'svcnum' => $h_cust_svc->svcnum, 'pkgnum' => $self->pkgnum });
+    my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
+    next unless $h_svc_x; # this probably doesn't happen, but just in case
+    (my $table = $h_svc_x->table) =~ s/^h_//;
+    require "FS/$table.pm";
+    my $class = "FS::$table";
+    my $svc_x = $class->new( {
+      'svcpart' => $h_cust_svc->svcpart,
+      '_h_svc_x' => $h_svc_x,
+      map { $_ => $h_svc_x->get($_) } fields($table)
+    } );
+
+    # radius_usergroup
+    if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
+      $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
+    }
+
+    #these are pretty rare, but should handle them
+    # - dsl_device (mac addresses)
+    # - phone_device (mac addresses)
+    # - dsl_note (ikano notes)
+    # - domain_record (i.e. restore DNS information w/domains)
+    # - inventory_item(?) (inventory w/un-cancelling service?)
+    # - nas (svc_broaband nas stuff)
+    #this stuff is unused in the wild afaik
+    # - mailinglistmember
+    # - router.svcnum?
+    # - svc_domain.parent_svcnum?
+    # - acct_snarf (ancient mail fetching config)
+    # - cgp_rule (communigate)
+    # - cust_svc_option (used by our Tron stuff)
+    # - acct_rt_transaction (used by our time worked stuff)
+
+    push @svc_x, $svc_x;
+  }
+  return @svc_x;
+}
+
+=item uncancel_svc_summary
+
+Returns an array of hashrefs, one for each service that could 
+potentially be reprovisioned by L</uncancel>, with the following keys:
+
+svcpart
+
+svc
+
+uncancel_svcnum
+
+label - from history table if not currently calculable, undefined if it can't be loaded
+
+reprovisionable - 1 if test reprovision succeeded, otherwise 0
+
+num_cust_svc - number of svcs for this svcpart, only if summarizing (see below)
+
+Cannot be run from within a transaction.  Performs inserts
+to test the results, and then rolls back the transaction.
+Does not perform exports, so does not catch if export would fail.
+
+Also accepts the following options:
+
+no_test_reprovision - skip the test inserts (reprovisionable field will not exist)
+
+summarize_size - if true, returns a single summary record for svcparts with at
+least this many svcs, will have key num_cust_svc but not uncancel_svcnum, label or reprovisionable
+
+=cut
+
+sub uncancel_svc_summary {
+  my ($self, %opt) = @_;
+
+  die 'uncancel_svc_summary called on a non-cancelled cust_pkg' unless $self->get('cancel');
+  die 'uncancel_svc_summary called from within a transaction' unless $FS::UID::AutoCommit;
+
+  local $FS::svc_Common::noexport_hack = 1; # very important not to run exports!!!
+  local $FS::UID::AutoCommit = 0;
+
+  # sort by svcpart, to check summarize_size
+  my $uncancel_svc_x = {};
+  foreach my $svc_x (sort { $a->{'svcpart'} <=> $b->{'svcpart'} } $self->uncancel_svc_x) {
+    $uncancel_svc_x->{$svc_x->svcpart} = [] unless $uncancel_svc_x->{$svc_x->svcpart};
+    push @{$uncancel_svc_x->{$svc_x->svcpart}}, $svc_x;
+  }
+
+  my @out;
+  foreach my $svcpart (keys %$uncancel_svc_x) {
+    my @svcpart_svc_x = @{$uncancel_svc_x->{$svcpart}};
+    if ($opt{'summarize_size'} && (@svcpart_svc_x >= $opt{'summarize_size'})) {
+      my $svc_x = $svcpart_svc_x[0]; #grab first one for access to $part_svc
+      my $part_svc = $svc_x->part_svc;
+      push @out, {
+        'svcpart'      => $part_svc->svcpart,
+        'svc'          => $part_svc->svc,
+        'num_cust_svc' => scalar(@svcpart_svc_x),
+      };
+    } else {
+      foreach my $svc_x (@svcpart_svc_x) {
+        my $part_svc = $svc_x->part_svc;
+        my $out = {
+          'svcpart' => $part_svc->svcpart,
+          'svc'     => $part_svc->svc,
+          'uncancel_svcnum' => $svc_x->get('_h_svc_x')->svcnum,
+        };
+        $svc_x->pkgnum($self->pkgnum); # provisioning services on a canceled package, will be rolled back
+        my $insert_error;
+        unless ($opt{'no_test_reprovision'}) {
+          # avoid possibly fatal errors from missing linked records
+          eval { $insert_error = $svc_x->insert };
+          $insert_error ||= $@;
+        }
+        if ($opt{'no_test_reprovision'} or $insert_error) {
+          # avoid possibly fatal errors from missing linked records
+          eval { $out->{'label'} = $svc_x->label };
+          eval { $out->{'label'} = $svc_x->get('_h_svc_x')->label } unless defined($out->{'label'});
+          $out->{'reprovisionable'} = 0 unless $opt{'no_test_reprovision'};
+        } else {
+          $out->{'label'} = $svc_x->label;
+          $out->{'reprovisionable'} = 1;
+        }
+        push @out, $out;
+      }
+    }
+  }
+
+  dbh->rollback;
+  return @out;
+}
+
 =item uncancel
 
 "Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
@@ -1141,6 +1301,8 @@ svc_fatal: service provisioning errors are fatal
 
 svc_errors: pass an array reference, will be filled in with any provisioning errors
 
+only_svcnum: arrayref, only attempt to re-provision these cancelled services
+
 main_pkgnum: link the package as a supplemental package of this one.  For 
 internal use only.
 
@@ -1197,32 +1359,12 @@ sub uncancel {
   # insert services
   ##
 
-  #find historical services within this timeframe before the package cancel
-  # (incompatible with "time" option to cust_pkg->cancel?)
-  my $fuzz = 2 * 60; #2 minutes?  too much?   (might catch separate unprovision)
-                     #            too little? (unprovisioing export delay?)
-  my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
-  my @h_cust_svc = $self->h_cust_svc( $end, $start );
-
   my @svc_errors;
-  foreach my $h_cust_svc (@h_cust_svc) {
-    my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
-    #next unless $h_svc_x; #should this happen?
-    (my $table = $h_svc_x->table) =~ s/^h_//;
-    require "FS/$table.pm";
-    my $class = "FS::$table";
-    my $svc_x = $class->new( {
-      'pkgnum'  => $cust_pkg->pkgnum,
-      'svcpart' => $h_cust_svc->svcpart,
-      map { $_ => $h_svc_x->get($_) } fields($table)
-    } );
-
-    # radius_usergroup
-    if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
-      $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
-    }
+  foreach my $svc_x ($self->uncancel_svc_x('only_svcnum' => $options{'only_svcnum'})) {
 
+    $svc_x->pkgnum($cust_pkg->pkgnum);
     my $svc_error = $svc_x->insert;
+
     if ( $svc_error ) {
       if ( $options{svc_fatal} ) {
         $dbh->rollback if $oldAutoCommit;
@@ -1246,23 +1388,7 @@ sub uncancel {
         }
       } # svc_fatal
     } # svc_error
-  } #foreach $h_cust_svc
-
-  #these are pretty rare, but should handle them
-  # - dsl_device (mac addresses)
-  # - phone_device (mac addresses)
-  # - dsl_note (ikano notes)
-  # - domain_record (i.e. restore DNS information w/domains)
-  # - inventory_item(?) (inventory w/un-cancelling service?)
-  # - nas (svc_broaband nas stuff)
-  #this stuff is unused in the wild afaik
-  # - mailinglistmember
-  # - router.svcnum?
-  # - svc_domain.parent_svcnum?
-  # - acct_snarf (ancient mail fetching config)
-  # - cgp_rule (communigate)
-  # - cust_svc_option (used by our Tron stuff)
-  # - acct_rt_transaction (used by our time worked stuff)
+  } #foreach uncancel_svc_x
 
   ##
   # also move over any services that didn't unprovision at cancellation
@@ -1305,14 +1431,15 @@ sub uncancel {
 
 =item unexpire
 
-Cancels any pending expiration (sets the expire field to null).
+Cancels any pending expiration (sets the expire field to null)
+for this package and any supplemental packages.
 
 If there is an error, returns the error, otherwise returns false.
 
 =cut
 
 sub unexpire {
-  my( $self, %options ) = @_;
+  my( $self ) = @_;
   my $error;
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
@@ -1342,6 +1469,14 @@ sub unexpire {
     return $error;
   }
 
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    $error = $supp_pkg->unexpire;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "unexpiring supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -1949,14 +2084,15 @@ sub unsuspend {
 
 =item unadjourn
 
-Cancels any pending suspension (sets the adjourn field to null).
+Cancels any pending suspension (sets the adjourn field to null)
+for this package and any supplemental packages.
 
 If there is an error, returns the error, otherwise returns false.
 
 =cut
 
 sub unadjourn {
-  my( $self, %options ) = @_;
+  my( $self ) = @_;
   my $error;
 
   my $oldAutoCommit = $FS::UID::AutoCommit;
@@ -1993,6 +2129,14 @@ sub unadjourn {
     return $error;
   }
 
+  foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+    $error = $supp_pkg->unadjourn;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "unadjourning supplemental pkg#".$supp_pkg->pkgnum.": $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   ''; #no errors
@@ -2385,6 +2529,21 @@ sub change {
       return "transferring package notes: $error";
     }
   }
+
+  # transfer scheduled expire/adjourn reasons
+  foreach my $action ('expire', 'adjourn') {
+    if ( $cust_pkg->get($action) ) {
+      my $reason = $self->last_cust_pkg_reason($action);
+      if ( $reason ) {
+        $reason->set('pkgnum', $cust_pkg->pkgnum);
+        $error = $reason->replace;
+        if ( $error ) {
+          $dbh->rollback if $oldAutoCommit;
+          return "transferring $action reason: $error";
+        }
+      }
+    }
+  }
   
   my @new_supp_pkgs;
 
@@ -2537,6 +2696,16 @@ sub change_later {
     return "start_date $date is in the past";
   }
 
+  # If the user entered a new location, set it up now.
+  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 ( $self->change_to_pkgnum ) {
     my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
     my $new_pkgpart = $opt->{'pkgpart'}
@@ -3799,23 +3968,27 @@ sub labels {
   map { [ $_->label ] } $self->cust_svc;
 }
 
-=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
+=item h_labels END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ]
 
 Like the labels method, but returns historical information on services that
 were active as of END_TIMESTAMP and (optionally) not cancelled before
 START_TIMESTAMP.  If MODE is 'I' (for 'invoice'), services with the 
 I<pkg_svc.hidden> flag will be omitted.
 
-Returns a list of lists, calling the label method for all (historical) services
-(see L<FS::h_cust_svc>) of this billing item.
+If LOCALE is passed, service definition names will be localized.
+
+Returns a list of lists, calling the label method for all (historical)
+services (see L<FS::h_cust_svc>) of this billing item.
 
 =cut
 
 sub h_labels {
   my $self = shift;
-  warn "$me _h_labels called on $self\n"
+  my ($end, $start, $mode, $locale) = @_;
+  warn "$me h_labels\n"
     if $DEBUG;
-  map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
+  map { [ $_->label($end, $start, $locale) ] }
+        $self->h_cust_svc($end, $start, $mode);
 }
 
 =item labels_short
@@ -3828,15 +4001,15 @@ individual services rather than individual items.
 =cut
 
 sub labels_short {
-  shift->_labels_short( 'labels', @_ );
+  shift->_labels_short( 'labels' ); # 'labels' takes no further arguments
 }
 
-=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
+=item h_labels_short END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ]
 
 Like h_labels, except returns a simple flat list, and shortens long
-(currently >5 or the cust_bill-max_same_services configuration value) lists of
-identical services to one line that lists the service label and the number of
-individual services rather than individual items.
+(currently >5 or the cust_bill-max_same_services configuration value) lists
+of identical services to one line that lists the service label and the
+number of individual services rather than individual items.
 
 =cut
 
@@ -3844,6 +4017,9 @@ sub h_labels_short {
   shift->_labels_short( 'h_labels', @_ );
 }
 
+# takes a method name ('labels' or 'h_labels') and all its arguments;
+# maybe should be "shorten($self->h_labels( ... ) )"
+
 sub _labels_short {
   my( $self, $method ) = ( shift, shift );