un-cancel, RT#17518

8 files changed, 185 insertions, 9 deletions

diff --git a/FS/FS/AccessRight.pm b/FS/FS/AccessRight.pm
index a11ad7f1b..914724cc3 100644
--- a/FS/FS/AccessRight.pm
+++ b/FS/FS/AccessRight.pm
@@ -138,6 +138,7 @@ tie my %rights, 'Tie::IxHash',
     'Unsuspend customer package',
     'Cancel customer package immediately',
     'Cancel customer package later',
+    'Un-cancel customer package',
     'Delay suspension events',
     'Add on-the-fly cancel reason', #NEW
     'Add on-the-fly suspend reason', #NEW
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index fb605ad78..00c519e5b 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -1512,6 +1512,8 @@ sub tables_hashref {
         'adjourn',        @date_type,             '', '', 
         'resume',         @date_type,             '', '', 
         'cancel',         @date_type,             '', '', 
+        'uncancel',       @date_type,             '', '', 
+        'uncancel_pkgnum',     'int', 'NULL', '', '', '',
         'expire',         @date_type,             '', '', 
         'contract_end',   @date_type,             '', '',
         'dundate',        @date_type,             '', '',
diff --git a/FS/FS/access_right.pm b/FS/FS/access_right.pm
index fc0174602..26a480b2f 100644
--- a/FS/FS/access_right.pm
+++ b/FS/FS/access_right.pm
@@ -205,6 +205,7 @@ sub _upgrade_data { # class method
                             'Usage: Call Detail Records (CDRs)',
                             'Usage: Unrateable CDRs',
                           ],
+    'Cancel customer package immediately' => 'Un-cancel customer package',
   );
 
   foreach my $old_acl ( keys %onetime ) {
diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm
index 4359de9a4..5ccdb354c 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -12,7 +12,7 @@ use Time::Local qw( timelocal timelocal_nocheck );
 use MIME::Entity;
 use FS::UID qw( getotaker dbh );
 use FS::Misc qw( send_email );
-use FS::Record qw( qsearch qsearchs );
+use FS::Record qw( qsearch qsearchs fields );
 use FS::CurrentUser;
 use FS::cust_svc;
 use FS::part_pkg;
@@ -879,6 +879,143 @@ sub cancel_if_expired {
   '';
 }
 
+=item uncancel
+
+"Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
+locationnum, (other fields?).  Attempts to re-provision cancelled services
+using history information (errors at this stage are not fatal).
+
+cust_pkg: pass a scalar reference, will be filled in with
+
+svc_errors: pass an array reference, will be filled in with any provisioning errors
+
+=cut
+
+sub uncancel {
+  my( $self, %options ) = @_;
+
+  #in case you try do do $uncancel-date = $cust_pkg->uncacel 
+  return '' unless $self->get('cancel');
+
+  ##
+  # Transaction-alize
+  ##
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE'; 
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE'; 
+  local $SIG{PIPE} = 'IGNORE'; 
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  ##
+  # insert the new package
+  ##
+
+  my $cust_pkg = new FS::cust_pkg {
+    last_bill       => ( $options{'last_bill'} || $self->get('last_bill') ),
+    bill            => ( $options{'bill'}      || $self->get('bill')      ),
+    uncancel        => time,
+    uncancel_pkgnum => $self->pkgnum,
+    map { $_ => $self->get($_) } qw(
+      custnum pkgpart locationnum
+      setup
+      susp adjourn resume expire start_date contract_end dundate
+      change_date change_pkgpart change_locationnum
+      manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero
+    ),
+  };
+
+  my $error = $cust_pkg->insert(
+    'change' => 1, #supresses any referral credit to a referring customer
+  );
+  if ($error) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  ##
+  # 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) ] );
+    }
+
+    my $svc_error = $svc_x->insert;
+    if ( $svc_error ) { #&& $options{svc_fatal} ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+    push @svc_errors, $svc_error if $svc_error;
+  }
+
+  #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)
+
+  ##
+  # also move over any services that didn't unprovision at cancellation
+  ## 
+
+  foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) {
+    $cust_svc->pkgnum( $cust_pkg->pkgnum );
+    my $error = $cust_svc->replace;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  ##
+  # Finish
+  ##
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  ${ $options{cust_pkg} }   = $cust_pkg   if ref($options{cust_pkg});
+  @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors});
+
+  '';
+}
+
 =item unexpire
 
 Cancels any pending expiration (sets the expire field to null).
diff --git a/FS/FS/h_radius_usergroup.pm b/FS/FS/h_radius_usergroup.pm
new file mode 100644
index 000000000..bbccd6bb7
--- /dev/null
+++ b/FS/FS/h_radius_usergroup.pm
@@ -0,0 +1,24 @@
+package FS::h_radius_usergroup;
+
+use strict;
+use base qw( FS::h_Common FS::radius_usergroup );
+
+sub table { 'h_radius_usergroup' };
+
+=head1 NAME
+
+FS::h_radius_usergroup - Historical RADIUS usergroup records.
+
+=head1 DESCRIPTION
+
+An FS::h_radius_usergroup object represents historical changes to an account's
+RADIUS group (L<FS::radius_usergroup>).
+
+=head1 SEE ALSO
+
+L<FS::radius_usergroup>,  L<FS::h_Common>, L<FS::Record>
+
+=cut
+
+1;
+
diff --git a/FS/FS/h_svc_Radius_Mixin.pm b/FS/FS/h_svc_Radius_Mixin.pm
new file mode 100644
index 000000000..af2977085
--- /dev/null
+++ b/FS/FS/h_svc_Radius_Mixin.pm
@@ -0,0 +1,17 @@
+package FS::h_svc_Radius_Mixin;
+
+use strict;
+use FS::Record qw( qsearch );
+use FS::h_radius_usergroup;
+
+sub h_usergroup {
+  my $self = shift;
+  map { $_->groupnum } 
+    qsearch( 'h_radius_usergroup',
+             { svcnum => $self->svcnum },
+             FS::h_radius_usergroup->sql_h_searchs(@_),
+           );
+}
+
+1;
+
diff --git a/FS/FS/h_svc_acct.pm b/FS/FS/h_svc_acct.pm
index 247d20c9a..f525f8206 100644
--- a/FS/FS/h_svc_acct.pm
+++ b/FS/FS/h_svc_acct.pm
@@ -1,16 +1,13 @@
 package FS::h_svc_acct;
+use base qw( FS::h_svc_Radius_Mixin FS::h_Common FS::svc_acct );
 
 use strict;
 use vars qw( @ISA $DEBUG );
 use Carp qw(carp);
 use FS::Record qw(qsearchs);
-use FS::h_Common;
-use FS::svc_acct;
 use FS::svc_domain;
 use FS::h_svc_domain;
 
-@ISA = qw( FS::h_Common FS::svc_acct );
-
 $DEBUG = 0;
 
 sub table { 'h_svc_acct' };
diff --git a/FS/FS/h_svc_broadband.pm b/FS/FS/h_svc_broadband.pm
index d6038fbe8..01477fe1c 100644
--- a/FS/FS/h_svc_broadband.pm
+++ b/FS/FS/h_svc_broadband.pm
@@ -1,11 +1,8 @@
 package FS::h_svc_broadband;
+use base qw( FS::h_svc_Radius_Mixin FS::h_Common FS::svc_broadband );
 
 use strict;
 use vars qw( @ISA );
-use FS::h_Common;
-use FS::svc_broadband;
-
-@ISA = qw( FS::h_Common FS::svc_broadband );
 
 sub table { 'h_svc_broadband' };