Merge pull request #75 from keithj/replicate-management

Added methods for listing and removing replicates.

.travis.yml

@@ -12,7 +12,7 @@ env:
     - PGVERSION="9.3"
     - JANSSON_VERSION="2.7"
     - DNAP_UTILITIES_VERSION="0.5.1"
-    - BATON_VERSION="0.16.2"
+    - BATON_VERSION="0.16.3"
     - CK_DEFAULT_TIMEOUT=10
     - IRODS_VAULT=/usr/local/var/lib/irods/Vault
 

lib/WTSI/NPG/DriRODS.pm

@@ -27,6 +27,7 @@ my @dry_run_methods = qw(
                           remove_group
                           remove_object
                           remove_object_avu
+                          remove_replicate
                           replace_object
                           set_collection_permissions
                           set_object_permissions

lib/WTSI/NPG/iRODS.pm

@@ -2151,7 +2151,7 @@ sub validate_checksum_metadata {
   Arg [1]    : iRODS data object path.
 
   Example    : my @replicates = $irods->replicates('/my/path/lorem.txt')
-  Description: Return an array of replicate descriptors for a data object.
+  Description: Return an array of all replicate descriptors for a data object.
                Each replicate is represented as a HashRef of the form:
                    {
                      checksum => <checksum Str>,
@@ -2181,6 +2181,132 @@ sub replicates {
   return $self->detailed_lister->list_object_replicates($object);
 }
 
+=head2 valid_replicates
+
+  Arg [1]    : iRODS data object path.
+
+  Example    : my @replicates = $irods->valid_replicates('/my/path/lorem.txt')
+  Description: Return an array of all valid replicate descriptors for a data
+               object, sorted by ascending replicate number.
+  Returntype : Array[Hashref]
+
+=cut
+
+sub valid_replicates {
+  my ($self, $object) = @_;
+
+  my @valid_replicates = sort { $a->{number} cmp $b->{number} }
+    grep { $_->{valid} } $self->replicates($object);
+
+  return @valid_replicates;
+}
+
+=head2 invalid_replicates
+
+  Arg [1]    : iRODS data object path.
+
+  Example    : my @replicates = $irods->invalid_replicates('/my/path/lorem.txt')
+  Description: Return an array of all invalid replicate descriptors for a data
+               object, sorted by ascending replicate number.
+  Returntype : Array[Hashref]
+
+=cut
+
+sub invalid_replicates {
+  my ($self, $object) = @_;
+
+  my @invalid_replicates = sort { $a->{number} cmp $b->{number} }
+    grep { not $_->{valid} } $self->replicates($object);
+
+  return @invalid_replicates;
+}
+
+=head2 prune_replicates
+
+  Arg [1]    : iRODS data object path.
+
+  Example    : my @pruned = $irods->prune_replicates('/my/path/lorem.txt')
+  Description: Remove any replicates of a data object that are marked as
+               stale in the ICAT.  Return an array of descriptors of the
+               pruned replicates, sorted by ascending replicate number.
+               Each replicate is represented as a HashRef of the form:
+                   {
+                     checksum => <checksum Str>,
+                     location => <location Str>,
+                     number   => <replicate number Int>,
+                     resource => <resource name Str>,
+                     valid    => <is valid Int>,
+                   }
+
+               Raise anm error if there are only invalid replicates; there
+               should always be a valid replicate and pruning in this case
+               would be equivalent to deletion.
+  Returntype : Array[Hashref]
+
+=cut
+
+sub prune_replicates {
+  my ($self, $object) = @_;
+
+  my @invalid_replicates = $self->invalid_replicates($object);
+
+  my @pruned;
+  if ($self->valid_replicates($object)) {
+    foreach my $rep (@invalid_replicates) {
+      my $resource = $rep->{resource};
+      my $checksum = $rep->{checksum};
+      my $rep_num  = $rep->{number};
+      $self->debug("Pruning invalid replicate $rep_num with checksum ",
+                   "'$checksum' from resource '$resource' for ",
+                   "data object '$object'");
+      $self->remove_replicate($object, $rep_num);
+      push @pruned, $rep;
+    }
+  }
+  else {
+    $self->logconfess("Failed to prune invalid replicates from '$object': ",
+                      "there and no valid replicates of this data object; ",
+                      "pruning would be equivalent to deletion");
+  }
+
+  return @pruned;
+}
+
+=head2 remove_replicate
+
+  Arg [1]    : iRODS data object path.
+  Arg [2]    : replicate number
+
+  Example    : $irods->remove_replicate('/my/path/lorem.txt')
+  Description: Remove a replicate of a data object.  Return the object path.
+  Returntype : Str
+
+=cut
+
+sub remove_replicate {
+  my ($self, $object, $replicate_num) = @_;
+
+  defined $object or
+    $self->logconfess('A defined object argument is required');
+
+  $object eq q{} and
+    $self->logconfess('A non-empty object argument is required');
+
+  $object = $self->_ensure_object_path($object);
+
+  $replicate_num =~ m{^\d+$}msx or
+    $self->logconfess('A non-negative integer replicate_num argument ',
+                      'is required');
+
+  $self->debug("Removing replicate '$replicate_num' of '$object'");
+  WTSI::DNAP::Utilities::Runnable->new(executable  => $IRM,
+                                       arguments   => ['-n', $replicate_num,
+                                                       $object],
+                                       environment => $self->environment,
+                                       logger      => $self->logger)->run;
+  return $object;
+}
+
 =head2 avu_history_attr
 
   Arg [1]    : iRODS data object path.

lib/WTSI/NPG/iRODS/DataObject.pm

@@ -36,15 +36,6 @@ has 'checksum' =>
    clearer       => 'clear_checksum',
    documentation => 'The checksum of the data object.');
 
-has 'replicates' =>
-  (is            => 'ro',
-   isa           => ArrayRefOfReplicate,
-   lazy          => 1,
-   builder       => '_build_replicates',
-   predicate     => 'has_replicates',
-   clearer       => 'clear_replicates',
-   documentation => 'The replicate information about this data object.');
-
 # TODO: Add a check so that a DataObject cannot be built from a path
 # that is in fact a collection.
 around BUILDARGS => sub {
@@ -73,13 +64,128 @@ sub _build_checksum {
   return $self->irods->checksum($self->str);
 }
 
-# Lazily load replicates from iRODS
-sub _build_replicates {
+=head2 replicates
+
+  Arg [1]    : None.
+
+  Example    : my @replicates = $obj->replicates
+  Description: Return an array of all replicates for a data
+               object, sorted by ascending replicate number.
+  Returntype : Array[WTSI::NPG::iRODS::Replicate]
+
+=cut
+
+sub replicates {
+  my ($self) = @_;
+
+  my @replicates = sort { $a->number cmp $b->number }
+                    map { WTSI::NPG::iRODS::Replicate->new($_) }
+                    $self->irods->replicates($self->str);
+  return @replicates;
+}
+
+=head2 valid_replicates
+
+  Arg [1]    : None.
+
+  Example    : my @replicates = $obj->valid_replicates
+  Description: Return an array of all valid replicates for a data
+               object, sorted by ascending replicate number.
+  Returntype : Array[WTSI::NPG::iRODS::Replicate]
+
+=cut
+
+sub valid_replicates {
+  my ($self) = @_;
+
+  my @valid_replicates = sort { $a->number cmp $b->number }
+    grep { $_->is_valid } $self->replicates;
+
+  return @valid_replicates;
+}
+
+=head2 invalid_replicates
+
+  Arg [1]    : None.
+
+  Example    : my @replicates = $obj->invalid_replicates
+  Description: Return an array of all invalid replicates for a data
+               object, sorted by ascending replicate number.
+  Returntype : Array[WTSI::NPG::iRODS::Replicate]
+
+=cut
+
+sub invalid_replicates {
   my ($self) = @_;
 
-  my @replicates = map { WTSI::NPG::iRODS::Replicate->new($_) }
-    $self->irods->replicates($self->str);
-  return \@replicates;
+  my @invalid_replicates = sort { $a->number cmp $b->number }
+    grep { not $_->is_valid } $self->replicates;
+
+  return @invalid_replicates;
+}
+
+=head2 prune_replicates
+
+  Arg [1]    : None.
+
+  Example    : my @pruned = $obj->prune_replicates
+  Description: Remove any replicates of a data object that are marked as
+               stale in the ICAT.  Return an array of descriptors of the
+               pruned replicates.  Raise anm error if there are only
+               invalid replicates; there should always be a valid replicate
+               and pruning in this case would be equivalent to deletion.
+  Returntype : Array[WTSI::NPG::iRODS::Replicate]
+
+=cut
+
+sub prune_replicates {
+  my ($self) = @_;
+
+  my @invalid_replicates = $self->invalid_replicates;
+  my $path = $self->str;
+
+  my @pruned;
+  if ($self->valid_replicates) {
+
+    foreach my $rep (@invalid_replicates) {
+      my $resource = $rep->resource;
+      my $checksum = $rep->checksum;
+      my $number   = $rep->number;
+      $self->debug("Pruning invalid replicate $number with checksum ",
+                   "'$checksum' from resource '$resource' for ",
+                   "data object '$path'");
+      $self->irods->remove_replicate($path, $number);
+      push @pruned, $rep;
+    }
+
+    $self->clear_checksum;
+  }
+  else {
+    $self->logconfess("Failed to prune invalid replicates from '$path': ",
+                      "there and no valid replicates of this data object; ",
+                      "pruning would be equivalent to deletion");
+  }
+
+  return @pruned;
+}
+
+=head2 remove_replicate
+
+  Arg [1]    : Replicate number, Int.
+
+  Example    : $obj->remove_replicate($replicate_num)
+  Description: Remove a replicate of a data object.  Return $self.
+  Returntype : WTSI::NPG::iRODS::DataObject
+
+=cut
+
+sub remove_replicate {
+  my ($self, $replicate_num) = @_;
+
+  $self->irods->remove_replicate($self->str, $replicate_num);
+  $self->clear_checksum; # Clear the checksum in case it belonged to
+                         # the removed replicate
+  return $self;
 }
 
 sub get_metadata {