From a04fa05cdcdf33c7da80d9bb7cef0e00942240b9 Mon Sep 17 00:00:00 2001 From: Keith James Date: Wed, 4 May 2016 16:03:42 +0100 Subject: [PATCH 1/4] Added methods for listing and removing replicates. --- lib/WTSI/NPG/DriRODS.pm | 1 + lib/WTSI/NPG/iRODS.pm | 113 ++++++++++++++++++++++++++++++- t/lib/WTSI/NPG/iRODSTest.pm | 130 +++++++++++++++++++++++++++++++----- 3 files changed, 226 insertions(+), 18 deletions(-) diff --git a/lib/WTSI/NPG/DriRODS.pm b/lib/WTSI/NPG/DriRODS.pm index 9645d2f5..1406d29b 100644 --- a/lib/WTSI/NPG/DriRODS.pm +++ b/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 diff --git a/lib/WTSI/NPG/iRODS.pm b/lib/WTSI/NPG/iRODS.pm index 3655d0f6..3d425c27 100644 --- a/lib/WTSI/NPG/iRODS.pm +++ b/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 => , @@ -2181,6 +2181,117 @@ 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 => , + location => , + number => , + resource => , + valid => , + } + Returntype : Array[Hashref] + +=cut + +sub prune_replicates { + my ($self, $object) = @_; + + my @invalid_replicates = $self->invalid_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'"); + $self->remove_replicate($object, $rep_num); + } + + return @invalid_replicates; +} + +=head2 remove_replicate + + Arg [1] : iRODS data object path. + + Example : my @pruned = $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. diff --git a/t/lib/WTSI/NPG/iRODSTest.pm b/t/lib/WTSI/NPG/iRODSTest.pm index 0cbf4a01..4f5e7bcb 100644 --- a/t/lib/WTSI/NPG/iRODSTest.pm +++ b/t/lib/WTSI/NPG/iRODSTest.pm @@ -28,6 +28,8 @@ my $fixture_counter = 0; my $data_path = './t/irods'; my $irods_tmp_coll; +my $alt_resource = 'demoResc'; + my $have_admin_rights = system(qq{$WTSI::NPG::iRODS::IADMIN lu >/dev/null 2>&1}) == 0; @@ -1214,27 +1216,121 @@ sub validate_checksum_metadata : Test(8) { "Validation fails with multiple metadata values"; } -sub replicates : Test(6) { - my $irods = WTSI::NPG::iRODS->new(environment => \%ENV, - strict_baton_version => 0); +sub replicates : Test(9) { - my $lorem_object = "$irods_tmp_coll/irods/lorem.txt"; - my $expected_checksum = '39a4aa291ca849d601e4e5b8ed627a04'; + SKIP: { + if (system("ilsresc $alt_resource >/dev/null") != 0) { + skip "iRODS resource $alt_resource is unavilable", 9; + } - my @replicates = $irods->replicates($lorem_object); - cmp_ok(1, '==', scalar @replicates, 'One replicate is present'); + my $irods = WTSI::NPG::iRODS->new(environment => \%ENV, + strict_baton_version => 0); + my $lorem_object = "$irods_tmp_coll/irods/lorem.txt"; + my $expected_checksum = '39a4aa291ca849d601e4e5b8ed627a04'; + + system("irepl $lorem_object -R $alt_resource >/dev/null") == 0 + or die "Failed to replicate $lorem_object to $alt_resource: $ERRNO"; + system("ichksum -a $lorem_object >/dev/null") == 0 + or die "Failed to update checksum on replicates of $lorem_object: $ERRNO"; + + my @replicates = $irods->replicates($lorem_object); + cmp_ok(scalar @replicates, '==', 2, 'Two replicates are present'); + + foreach my $replicate (@replicates) { + my $num = $replicate->{number}; + is($replicate->{checksum}, $expected_checksum, + "Replicate $num checksum is correct"); + cmp_ok(length $replicate->{location}, '>', 0, + "Replicate $num has a location"); + cmp_ok(length $replicate->{resource}, '>', 0, + "Replicate $num has a resource"); + ok($replicate->{valid}, "Replicate $num is valid"); + } + } +} - my $replicate = $replicates[0]; +sub invalid_replicates : Test(3) { - is($replicate->{checksum}, $expected_checksum, - 'Replicate checksum is correct'); - cmp_ok(length $replicate->{location}, '>', 0, - 'Replicate has a location'); - cmp_ok($replicate->{number}, '==', 0, - 'Replicate has correct number'); - cmp_ok(length $replicate->{resource}, '>', 0, - 'Replicate has a resource'); - ok($replicate->{valid}, 'Replicate is valid'); + SKIP: { + if (system("ilsresc $alt_resource >/dev/null") != 0) { + skip "iRODS resource $alt_resource is unavilable", 3; + } + + my $irods = WTSI::NPG::iRODS->new(environment => \%ENV, + strict_baton_version => 0); + + my $lorem_object = "$irods_tmp_coll/irods/lorem.txt"; + my $expected_checksum = '39a4aa291ca849d601e4e5b8ed627a04'; + + system("irepl $lorem_object -R $alt_resource >/dev/null") == 0 + or die "Failed to replicate $lorem_object to $alt_resource: $ERRNO"; + system("ichksum -f -a $lorem_object >/dev/null") == 0 + or die "Failed to update checksum on replicates of $lorem_object: $ERRNO"; + + # Make the original replicate (0) stale + my $other_object = "$irods_tmp_coll/irods/test.txt"; + system("icp -f -R $alt_resource ". + "$other_object $lorem_object >/dev/null") == 0 or + die "Failed to make an invalid replicate: $ERRNO"; + + my @invalid_replicates = $irods->invalid_replicates($lorem_object); + cmp_ok(scalar @invalid_replicates, '==', 1, + 'One invalid replicate is present'); + + my $replicate = $invalid_replicates[0]; + is($replicate->{checksum}, $expected_checksum, + "Invalid replicate checksum is correct") or + diag explain $replicate; + ok(!$replicate->{valid}, "Invalid replicate is not valid") or + diag explain $replicate; + } +} + +sub prune_replicates : Test(6) { + + SKIP: { + if (system("ilsresc $alt_resource >/dev/null") != 0) { + skip "iRODS resource $alt_resource is unavilable", 6; + } + + my $irods = WTSI::NPG::iRODS->new(environment => \%ENV, + strict_baton_version => 0); + + my $lorem_object = "$irods_tmp_coll/irods/lorem.txt"; + my $expected_checksum = '39a4aa291ca849d601e4e5b8ed627a04'; + + system("irepl $lorem_object -R $alt_resource >/dev/null") == 0 + or die "Failed to replicate $lorem_object to $alt_resource: $ERRNO"; + system("ichksum -f -a $lorem_object >/dev/null") == 0 + or die "Failed to update checksum on replicates of $lorem_object: $ERRNO"; + + # Make the original replicate (0) stale + my $other_object = "$irods_tmp_coll/irods/test.txt"; + system("icp -f -R $alt_resource " . + "$other_object $lorem_object >/dev/null") == 0 or + die "Failed to make a stale replicate: $ERRNO"; + system("ichksum -f -a $lorem_object >/dev/null") == 0 + or die "Failed to update checksum on replicates of $lorem_object: $ERRNO"; + + my @pruned_replicates = $irods->prune_replicates($lorem_object); + cmp_ok(scalar @pruned_replicates, '==', 1, + 'One pruned replicate is present'); + + my $pruned_replicate = $pruned_replicates[0]; + is($pruned_replicate->{checksum}, $expected_checksum, + "Pruned replicate checksum is correct"); + ok(!$pruned_replicate->{valid}, "Pruned replicate is not valid") or + diag explain $pruned_replicate; + + my @replicates = $irods->valid_replicates($lorem_object); + cmp_ok(scalar @replicates, '==', 1, 'One valid replicate remains'); + my $replicate = $replicates[0]; + isnt($replicate->{checksum}, $expected_checksum, + "Remaining valid replicate checksum has changed") or + diag explain $replicate; + ok($replicate->{valid}, "Remaining valid replicate is valid") or + diag explain $replicate; + } } sub md5sum : Test(1) { From 0018c0fe3a97c831a9d1a7f4cf7c857cb8af76b1 Mon Sep 17 00:00:00 2001 From: Keith James Date: Fri, 6 May 2016 15:35:46 +0100 Subject: [PATCH 2/4] Added replicate API to DataObject. Removed the replicates attribute and replaced it with a method returning an array. --- lib/WTSI/NPG/iRODS.pm | 6 +- lib/WTSI/NPG/iRODS/DataObject.pm | 138 ++++++++++++++++++++++--- t/lib/WTSI/NPG/iRODS/DataObjectTest.pm | 130 +++++++++++++++++++---- t/lib/WTSI/NPG/iRODSTest.pm | 12 +-- 4 files changed, 243 insertions(+), 43 deletions(-) diff --git a/lib/WTSI/NPG/iRODS.pm b/lib/WTSI/NPG/iRODS.pm index 3d425c27..bc5cf295 100644 --- a/lib/WTSI/NPG/iRODS.pm +++ b/lib/WTSI/NPG/iRODS.pm @@ -2251,7 +2251,8 @@ sub prune_replicates { my $checksum = $rep->{checksum}; my $rep_num = $rep->{number}; $self->debug("Pruning invalid replicate $rep_num with checksum ", - "'$checksum' from resource '$resource'"); + "'$checksum' from resource '$resource' for ", + "data object '$object'"); $self->remove_replicate($object, $rep_num); } @@ -2261,8 +2262,9 @@ sub prune_replicates { =head2 remove_replicate Arg [1] : iRODS data object path. + Arg [2] : replicate number - Example : my @pruned = $irods->remove_replicate('/my/path/lorem.txt') + Example : $irods->remove_replicate('/my/path/lorem.txt') Description: Remove a replicate of a data object. Return the object path. Returntype : Str diff --git a/lib/WTSI/NPG/iRODS/DataObject.pm b/lib/WTSI/NPG/iRODS/DataObject.pm index 418f374c..498b08b7 100644 --- a/lib/WTSI/NPG/iRODS/DataObject.pm +++ b/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,132 @@ 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 = map { WTSI::NPG::iRODS::Replicate->new($_) } - $self->irods->replicates($self->str); - return \@replicates; + 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 @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 + + $self->debug($self->str, " now has ", scalar $self->replicates, + " replicates"); + + return $self; } sub get_metadata { diff --git a/t/lib/WTSI/NPG/iRODS/DataObjectTest.pm b/t/lib/WTSI/NPG/iRODS/DataObjectTest.pm index 27963fe9..c79335ad 100644 --- a/t/lib/WTSI/NPG/iRODS/DataObjectTest.pm +++ b/t/lib/WTSI/NPG/iRODS/DataObjectTest.pm @@ -19,6 +19,7 @@ use WTSI::NPG::iRODS::Metadata qw($STUDY_ID); my $fixture_counter = 0; my $data_path = './t/irods_path_test'; my $irods_tmp_coll; +my $alt_resource = 'demoResc'; my $pid = $PID; @@ -461,29 +462,116 @@ sub checksum : Test(1) { 'Has correct checksum'); } -sub replicates : Test(7) { - my $irods = WTSI::NPG::iRODS->new(environment => \%ENV, - strict_baton_version => 0); - my $obj_path = "$irods_tmp_coll/irods_path_test/test_dir/test_file.txt"; +sub replicates : Test(11) { - my $obj = WTSI::NPG::iRODS::DataObject->new($irods, $obj_path); + SKIP: { + if (system("ilsresc $alt_resource >/dev/null") != 0) { + skip "iRODS resource $alt_resource is unavilable", 11; + } + + my $irods = WTSI::NPG::iRODS->new(environment => \%ENV, + strict_baton_version => 0); + my $obj_path = "$irods_tmp_coll/irods_path_test/test_dir/test_file.txt"; + + system("irepl $obj_path -R $alt_resource >/dev/null") == 0 + or die "Failed to replicate $obj_path to $alt_resource: $ERRNO"; + system("ichksum -a $obj_path >/dev/null") == 0 + or die "Failed to update checksum on replicates of $obj_path: $ERRNO"; + + my $obj = WTSI::NPG::iRODS::DataObject->new($irods, $obj_path); + + my @replicates = $obj->replicates; + cmp_ok(scalar @replicates, '==', 2, 'Two replicates are present'); + + foreach my $replicate (@replicates) { + my $num = $replicate->number; + ok($replicate->isa('WTSI::NPG::iRODS::Replicate'), + "Replicate $num isa correct") or diag explain $replicate; + + is($replicate->checksum, "d41d8cd98f00b204e9800998ecf8427e", + "Replicate $num has correct checksum"); + cmp_ok(length $replicate->location, '>', 0, + "Replicate $num has a location"); + cmp_ok(length $replicate->resource, '>', 0, + "Replicate $num has a resource"); + ok($replicate->is_valid, "Replicate $num is valid"); + } + } +} + +sub invalid_replicates : Test(3) { + + SKIP: { + if (system("ilsresc $alt_resource >/dev/null") != 0) { + skip "iRODS resource $alt_resource is unavilable", 3; + } + + my $irods = WTSI::NPG::iRODS->new(environment => \%ENV, + strict_baton_version => 0); - my @replicates = @{$obj->replicates}; - cmp_ok(1, '==', scalar @replicates, 'One replicate is present'); - - my $replicate = $replicates[0]; - ok($replicate->isa('WTSI::NPG::iRODS::Replicate'), 'Replicate isa correct') - or diag explain $replicate; - - is($replicate->checksum, "d41d8cd98f00b204e9800998ecf8427e", - 'Replicate has correct checksum'); - cmp_ok(length $replicate->location, '>', 0, - 'Replicate has a location'); - cmp_ok($replicate->number, '==', 0, - 'Replicate has correct number'); - cmp_ok(length $replicate->resource, '>', 0, - 'Replicate has a resource'); - ok($replicate->is_valid, 'Replicate is valid'); + my $obj_path = "$irods_tmp_coll/irods_path_test/test_dir/test_file.txt"; + + system("irepl $obj_path -R $alt_resource >/dev/null") == 0 + or die "Failed to replicate $obj_path to $alt_resource: $ERRNO"; + system("ichksum -a $obj_path >/dev/null") == 0 + or die "Failed to update checksum on replicates of $obj_path: $ERRNO"; + + # Make the original replicate (0) stale + my $other_path = "./t/irods/test.txt"; + system("iput -f -R $alt_resource $other_path $obj_path >/dev/null") == 0 + or die "Failed to make an invalid replicate: $ERRNO"; + + my $obj = WTSI::NPG::iRODS::DataObject->new($irods, $obj_path); + + my @invalid_replicates = $obj->invalid_replicates; + cmp_ok(scalar @invalid_replicates, '==', 1, + 'One invalid replicate is present'); + + my $replicate = $invalid_replicates[0]; + is($replicate->checksum, "d41d8cd98f00b204e9800998ecf8427e", + "Invalid replicate has correct checksum"); + ok(!$replicate->is_valid, "Invalid replicate is not valid"); + } +} + +sub prune_replicates : Test(5) { + + SKIP: { + if (system("ilsresc $alt_resource >/dev/null") != 0) { + skip "iRODS resource $alt_resource is unavilable", 5; + } + + my $irods = WTSI::NPG::iRODS->new(environment => \%ENV, + strict_baton_version => 0); + + my $obj_path = "$irods_tmp_coll/irods_path_test/test_dir/test_file.txt"; + + system("irepl $obj_path -R $alt_resource >/dev/null") == 0 + or die "Failed to replicate $obj_path to $alt_resource: $ERRNO"; + system("ichksum -a $obj_path >/dev/null") == 0 + or die "Failed to update checksum on replicates of $obj_path: $ERRNO"; + + # Make the original replicate (0) stale + my $other_path = "./t/irods/test.txt"; + system("iput -f -R $alt_resource $other_path $obj_path >/dev/null") == 0 + or die "Failed to make an invalid replicate: $ERRNO"; + + my $obj = WTSI::NPG::iRODS::DataObject->new($irods, $obj_path); + + my @pruned_replicates = $obj->prune_replicates; + my $pruned_replicate = $pruned_replicates[0]; + is($pruned_replicate->checksum, 'd41d8cd98f00b204e9800998ecf8427e', + 'Pruned replicate checksum is correct'); + ok(!$pruned_replicate->is_valid, 'Pruned replicate is not valid'); + + my @replicates = $obj->replicates; + cmp_ok(scalar @replicates, '==', 1, 'One valid replicate remains'); + + my $replicate = $replicates[0]; + isnt($replicate->checksum, 'd41d8cd98f00b204e9800998ecf8427e', + 'Remaining valid replicate checksum has changed'); + ok($replicate->is_valid, 'Remaining valid replicate is valid'); + } } sub get_permissions : Test(1) { diff --git a/t/lib/WTSI/NPG/iRODSTest.pm b/t/lib/WTSI/NPG/iRODSTest.pm index 4f5e7bcb..995be7d3 100644 --- a/t/lib/WTSI/NPG/iRODSTest.pm +++ b/t/lib/WTSI/NPG/iRODSTest.pm @@ -1279,9 +1279,9 @@ sub invalid_replicates : Test(3) { my $replicate = $invalid_replicates[0]; is($replicate->{checksum}, $expected_checksum, - "Invalid replicate checksum is correct") or + 'Invalid replicate checksum is correct') or diag explain $replicate; - ok(!$replicate->{valid}, "Invalid replicate is not valid") or + ok(!$replicate->{valid}, 'Invalid replicate is not valid') or diag explain $replicate; } } @@ -1319,17 +1319,17 @@ sub prune_replicates : Test(6) { my $pruned_replicate = $pruned_replicates[0]; is($pruned_replicate->{checksum}, $expected_checksum, "Pruned replicate checksum is correct"); - ok(!$pruned_replicate->{valid}, "Pruned replicate is not valid") or + ok(!$pruned_replicate->{valid}, 'Pruned replicate is not valid') or diag explain $pruned_replicate; my @replicates = $irods->valid_replicates($lorem_object); cmp_ok(scalar @replicates, '==', 1, 'One valid replicate remains'); my $replicate = $replicates[0]; isnt($replicate->{checksum}, $expected_checksum, - "Remaining valid replicate checksum has changed") or + 'Remaining valid replicate checksum has changed') or diag explain $replicate; - ok($replicate->{valid}, "Remaining valid replicate is valid") or - diag explain $replicate; + ok($replicate->{valid}, 'Remaining valid replicate is valid') or + diag explain $replicate; } } From 3ecee17724f799e34bf0ef6cf252c3e5f883652b Mon Sep 17 00:00:00 2001 From: Keith James Date: Fri, 6 May 2016 16:09:33 +0100 Subject: [PATCH 3/4] Add safety check to iRODS::prune_replicates. Removed a debug call from DataObject that would trigger a round trip to iRODS. --- lib/WTSI/NPG/iRODS.pm | 31 ++++++++++++++++++++++--------- lib/WTSI/NPG/iRODS/DataObject.pm | 4 ---- 2 files changed, 22 insertions(+), 13 deletions(-) diff --git a/lib/WTSI/NPG/iRODS.pm b/lib/WTSI/NPG/iRODS.pm index bc5cf295..a0e6bb0a 100644 --- a/lib/WTSI/NPG/iRODS.pm +++ b/lib/WTSI/NPG/iRODS.pm @@ -2237,6 +2237,10 @@ sub invalid_replicates { resource => , valid => , } + + 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 @@ -2246,17 +2250,26 @@ sub prune_replicates { my @invalid_replicates = $self->invalid_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); + 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 @invalid_replicates; + return @pruned; } =head2 remove_replicate diff --git a/lib/WTSI/NPG/iRODS/DataObject.pm b/lib/WTSI/NPG/iRODS/DataObject.pm index 498b08b7..85676ee5 100644 --- a/lib/WTSI/NPG/iRODS/DataObject.pm +++ b/lib/WTSI/NPG/iRODS/DataObject.pm @@ -185,10 +185,6 @@ sub remove_replicate { $self->irods->remove_replicate($self->str, $replicate_num); $self->clear_checksum; # Clear the checksum in case it belonged to # the removed replicate - - $self->debug($self->str, " now has ", scalar $self->replicates, - " replicates"); - return $self; } From 66982cfa78ea339ec8bfc5aefa84f661c257ecbb Mon Sep 17 00:00:00 2001 From: Keith James Date: Fri, 6 May 2016 16:26:00 +0100 Subject: [PATCH 4/4] Use baton 0.16.3 --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index cded5b0f..2a47a49e 100644 --- a/.travis.yml +++ b/.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