diff --git a/.travis.yml b/.travis.yml index 1e17c453..8052af2d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,7 +12,7 @@ env: - PGVERSION="9.3" - JANSSON_VERSION="2.7" - DNAP_UTILITIES_VERSION="0.4.2" - - BATON_VERSION="0.14.0" + - BATON_VERSION="0.15.0" - CK_DEFAULT_TIMEOUT=10 - IRODS_VAULT=/usr/local/var/lib/irods/Vault diff --git a/lib/WTSI/NPG/iRODS.pm b/lib/WTSI/NPG/iRODS.pm index 3e6b119a..38c23217 100644 --- a/lib/WTSI/NPG/iRODS.pm +++ b/lib/WTSI/NPG/iRODS.pm @@ -23,7 +23,7 @@ with 'WTSI::DNAP::Utilities::Loggable', 'WTSI::NPG::Annotation'; our $VERSION = ''; -our $REQUIRED_BATON_VERSION = '0.14.0'; +our $REQUIRED_BATON_VERSION = '0.15.0'; our $IADMIN = 'iadmin'; our $ICHKSUM = 'ichksum'; @@ -79,7 +79,7 @@ has 'lister' => my ($self) = @_; return WTSI::NPG::iRODS::Lister->new - (arguments => ['--unbuffered', '--acl', '--contents'], + (arguments => ['--unbuffered', '--acl', '--contents', '--checksum'], environment => $self->environment, logger => $self->logger)->start; }); @@ -721,6 +721,16 @@ sub remove_collection { return $collection; } +=head2 get_collection_permissions + + Arg [1] : iRODS collection path. + + Example : $irods->get_collection_permissions($path) + Description: Return a list of ACLs defined for a collection. + Returntype : Array + +=cut + sub get_collection_permissions { my ($self, $collection) = @_; @@ -1320,7 +1330,6 @@ sub slurp_object { return $self->read_object($target); } - =head2 get_object_permissions Arg [1] : iRODS data object path. @@ -1618,6 +1627,32 @@ sub find_objects_by_meta { return grep { /^$root/msx } @sorted; } +=head2 checksum + + Arg [1] : iRODS data object path. + + Example : $cs = $irods->checksum('/my/path/lorem.txt') + Description: Return the MD5 checksum of an iRODS data object. The checksum + returned is the iRODS cached value, which may be empty if + the calculation has not yet been done. + Returntype : Str + +=cut + +sub checksum { + my ($self, $object) = @_; + + 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_absolute_path($object); + + return $self->lister->list_object_checksum($object); +} + =head2 calculate_checksum Arg [1] : iRODS data object path. @@ -1702,8 +1737,8 @@ sub validate_checksum_metadata { Arg [1] : String path to a file. - Example : my $md5 = md5sum($filename) - Description: Calculate the MD5 checksum of a file. + Example : my $md5 = $irods->md5sum($filename) + Description: Calculate the MD5 checksum of a local file. Returntype : Str =cut diff --git a/lib/WTSI/NPG/iRODS/Collection.pm b/lib/WTSI/NPG/iRODS/Collection.pm index aaf7f06f..958fc356 100644 --- a/lib/WTSI/NPG/iRODS/Collection.pm +++ b/lib/WTSI/NPG/iRODS/Collection.pm @@ -153,10 +153,13 @@ sub make_avu_history { Arg [1] : - Example : my ($objs, $cols) = $irods->get_contents($coll) + Example : my ($objs, $cols) = $coll->get_contents Description: Return the contents of the collection as two arrayrefs, the first listing data objects, the second listing nested - collections. + collections. This method is preferred if the checksums of + a large number of data objects are to be tested because it + populates the data object checksum attribute as it reads the + collection. Returntype : Array =cut @@ -166,13 +169,23 @@ sub get_contents { my $irods = $self->irods; my $path = $self->str; - my ($objs, $colls) = $self->irods->list_collection($path, $recurse); + my ($objs, $colls, $checksums) = + $self->irods->list_collection($path, $recurse); my @objects; my @collections; foreach my $obj (@$objs) { - push @objects, WTSI::NPG::iRODS::DataObject->new($irods, $obj); + my $object = WTSI::NPG::iRODS::DataObject->new($irods, $obj); + if (exists $checksums->{$obj}) { + $object->checksum($checksums->{$obj}); + } + else { + $self->logwarn("Failed to find a checksum for '$obj' when getting ", + "the contents of '", $self->str, q{'}); + } + + push @objects, $object; } foreach my $coll (@$colls) { push @collections, WTSI::NPG::iRODS::Collection->new($irods, $coll); @@ -181,6 +194,16 @@ sub get_contents { return (\@objects, \@collections); } +=head2 get_permissions + + Arg [1] : None + + Example : $coll->get_permissions + Description: Return a list of ACLs defined for the collection. + Returntype : Array + +=cut + sub get_permissions { my ($self) = @_; @@ -213,6 +236,19 @@ sub set_permissions { return $self; } +=head2 get_groups + + Arg [1] : Permission Str, one of 'null', 'read', 'write' or 'own', + optional. + + Example : $coll->get_groups('read') + Description: Return a list of the data access groups in the collection's ACL. + If a permission leve argument is supplied, only groups with + that level of access will be returned. + Returntype : Array + +=cut + sub get_groups { my ($self, $level) = @_; diff --git a/lib/WTSI/NPG/iRODS/Communicator.pm b/lib/WTSI/NPG/iRODS/Communicator.pm index 9eda80b3..06191e5b 100644 --- a/lib/WTSI/NPG/iRODS/Communicator.pm +++ b/lib/WTSI/NPG/iRODS/Communicator.pm @@ -79,6 +79,21 @@ sub path_spec_str { return $path; } +sub path_spec_checksum { + my ($self, $path_spec) = @_; + + defined $path_spec or + $self->logconfess('A defined path_spec argument is required'); + + ref $path_spec eq 'HASH' or + $self->logconfess('A HashRef path_spec argument is required'); + + exists $path_spec->{checksum} or + $self->logconfess('The path_spec argument did not have a "checksum" key'); + + return $path_spec->{checksum}; +} + __PACKAGE__->meta->make_immutable; no Moose; @@ -101,7 +116,7 @@ Keith James =head1 COPYRIGHT AND DISCLAIMER -Copyright (C) 2014 Genome Research Limited. All Rights Reserved. +Copyright (C) 2014, 2015 Genome Research Limited. All Rights Reserved. This program is free software: you can redistribute it and/or modify it under the terms of the Perl Artistic License or the GNU General diff --git a/lib/WTSI/NPG/iRODS/DataObject.pm b/lib/WTSI/NPG/iRODS/DataObject.pm index b44f2acc..56b6f6e8 100644 --- a/lib/WTSI/NPG/iRODS/DataObject.pm +++ b/lib/WTSI/NPG/iRODS/DataObject.pm @@ -21,6 +21,11 @@ has 'data_object' => default => q{.}, predicate => 'has_data_object'); +has 'checksum' => (is => 'rw', + isa => 'Str', + predicate => 'has_checksum', + clearer => 'clear_checksum'); + # TODO: Add a check so that a DataObject cannot be built from a path # that is in fact a collection. around BUILDARGS => sub { @@ -52,6 +57,18 @@ around 'metadata' => sub { return $self->$orig; }; +# Lazily load checksum from iRODS +around 'checksum' => sub { + my ($orig, $self) = @_; + + unless ($self->has_checksum) { + my $checksum = $self->irods->checksum($self->str); + $self->$orig($checksum); + } + + return $self->$orig; +}; + =head2 is_present Arg [1] : None @@ -102,7 +119,7 @@ sub absolute { Arg [1] : None - Example : $path->calculate_checksum + Example : $obj->calculate_checksum Description: Return the MD5 checksum of the data object. Returntype : WTSI::NPG::iRODS::DataObject @@ -111,6 +128,7 @@ sub absolute { sub calculate_checksum { my ($self) = @_; + $self->clear_checksum; return $self->irods->calculate_checksum($self->str); } @@ -212,6 +230,16 @@ sub make_avu_history { ($self->str, $attribute, $timestamp); } +=head2 get_permissions + + Arg [1] : None + + Example : $obj->get_permissions + Description: Return a list of ACLs defined for the object. + Returntype : Array + +=cut + sub get_permissions { my ($self) = @_; @@ -244,6 +272,19 @@ sub set_permissions { return $self; } +=head2 get_groups + + Arg [1] permission Str, one of 'null', 'read', 'write' or 'own', + optional. + + Example : $obj->get_object_groups('read') + Description: Return a list of the data access groups in the object's ACL. + If a permission leve argument is supplied, only groups with + that level of access will be returned. + Returntype : Array + +=cut + sub get_groups { my ($self, $level) = @_; diff --git a/lib/WTSI/NPG/iRODS/Lister.pm b/lib/WTSI/NPG/iRODS/Lister.pm index 288e7e0d..667b2817 100644 --- a/lib/WTSI/NPG/iRODS/Lister.pm +++ b/lib/WTSI/NPG/iRODS/Lister.pm @@ -59,16 +59,38 @@ sub list_object { return $path; } +sub list_object_checksum { + my ($self, $object) = @_; + + my $response = $self->_list_object($object); + my $checksum; + + if (exists $response->{error}) { + if ($response->{error}->{code} == $ITEM_DOES_NOT_EXIST) { + # Continue to return undef + } + else { + $self->report_error($response); + } + } + else { + $checksum = $response->{checksum}; + } + + return $checksum; +} + =head2 list_collection Arg [1] : iRODS collection path. Arg [2] : Recursive list flag (optional). Example : my $path = $irods->list_object('/path/to/object') - Description: Return an array of two values; the first being an ArrayRef - of contained collections, the second being an ArrayRef of - contained data objects. - Returntype : Array[Arrayref[Str], ArrayRef[Str]] + Description: Return an array of three values; the first being an + ArrayRef of contained data objects, the second being + an ArrayRef of contained collections, the third a HashRef + mapping of the contained data object paths to their checksums. + Returntype : ArrayRef[Str], ArrayRef[Str], HashRef[Str] =cut @@ -89,7 +111,9 @@ sub list_collection { if ($obj_specs and $coll_specs) { my @data_objects = map { $self->path_spec_str($_) } @$obj_specs; my @collections = map { $self->path_spec_str($_) } @$coll_specs; - @paths = (\@data_objects, \@collections); + my %checksums = map { $self->path_spec_str($_) => + $self->path_spec_checksum($_) } @$obj_specs; + @paths = (\@data_objects, \@collections, \%checksums); } return @paths; diff --git a/t/lib/WTSI/NPG/iRODS/CollectionTest.pm b/t/lib/WTSI/NPG/iRODS/CollectionTest.pm index 94c8314a..3457f7be 100644 --- a/t/lib/WTSI/NPG/iRODS/CollectionTest.pm +++ b/t/lib/WTSI/NPG/iRODS/CollectionTest.pm @@ -17,6 +17,7 @@ BEGIN { use_ok('WTSI::NPG::iRODS::Collection'); } use WTSI::NPG::iRODS::Collection; +my $fixture_counter = 0; my $data_path = './t/irods_path_test'; my $irods_tmp_coll; @@ -24,10 +25,15 @@ my $pid = $$; my @groups_added; +my $have_admin_rights = + system(qq{$WTSI::NPG::iRODS::IADMIN lu 2>&1 /dev/null}) == 0; + sub make_fixture : Test(setup) { my $irods = WTSI::NPG::iRODS->new(strict_baton_version => 0); - $irods_tmp_coll = $irods->add_collection("CollectionTest.$pid"); + $irods_tmp_coll = + $irods->add_collection("CollectionTest.$pid.$fixture_counter"); + $fixture_counter++; $irods->put_collection($data_path, $irods_tmp_coll); my $i = 0; @@ -40,9 +46,11 @@ sub make_fixture : Test(setup) { } } - foreach my $group (qw(ss_0 ss_10)) { - unless ($irods->group_exists($group)) { - push @groups_added, $irods->add_group($group); + if ($have_admin_rights) { + foreach my $group (qw(ss_0 ss_10)) { + unless ($irods->group_exists($group)) { + push @groups_added, $irods->add_group($group); + } } } } @@ -52,9 +60,11 @@ sub teardown : Test(teardown) { $irods->remove_collection($irods_tmp_coll); - foreach my $group (@groups_added) { - if ($irods->group_exists($group)) { - $irods->remove_group($group); + if ($have_admin_rights) { + foreach my $group (@groups_added) { + if ($irods->group_exists($group)) { + $irods->remove_group($group); + } } } } @@ -310,20 +320,25 @@ sub get_groups : Test(6) { my $coll_path = "$irods_tmp_coll/irods_path_test/test_dir"; my $coll = WTSI::NPG::iRODS::Collection->new($irods, $coll_path); + SKIP: { + if (not $irods->group_exists('ss_0')) { + skip "Skipping test requiring the test group ss_0", 5; + } - ok($irods->set_collection_permissions('read', 'public', $coll_path)); - ok($irods->set_collection_permissions('read', 'ss_0', $coll_path)); - ok($irods->set_collection_permissions('read', 'ss_10', $coll_path)); + ok($irods->set_collection_permissions('read', 'public', $coll_path)); + ok($irods->set_collection_permissions('read', 'ss_0', $coll_path)); + ok($irods->set_collection_permissions('read', 'ss_10', $coll_path)); - my $expected_all = ['ss_0', 'ss_10']; - my @found_all = $coll->get_groups; - is_deeply(\@found_all, $expected_all, 'Expected all groups') - or diag explain \@found_all; + my $expected_all = ['ss_0', 'ss_10']; + my @found_all = $coll->get_groups; + is_deeply(\@found_all, $expected_all, 'Expected all groups') + or diag explain \@found_all; - my $expected_read = ['ss_0', 'ss_10']; - my @found_read = $coll->get_groups('read'); - is_deeply(\@found_read, $expected_read, 'Expected read groups') - or diag explain \@found_read; + my $expected_read = ['ss_0', 'ss_10']; + my @found_read = $coll->get_groups('read'); + is_deeply(\@found_read, $expected_read, 'Expected read groups') + or diag explain \@found_read; + } my $expected_own = []; my @found_own = $coll->get_groups('own'); diff --git a/t/lib/WTSI/NPG/iRODS/DataObjectTest.pm b/t/lib/WTSI/NPG/iRODS/DataObjectTest.pm index be905a6c..1ca0ee68 100644 --- a/t/lib/WTSI/NPG/iRODS/DataObjectTest.pm +++ b/t/lib/WTSI/NPG/iRODS/DataObjectTest.pm @@ -8,7 +8,7 @@ use List::AllUtils qw(all any none); use Log::Log4perl; use base qw(Test::Class); -use Test::More tests => 76; +use Test::More tests => 77; use Test::Exception; Log::Log4perl::init('./etc/log4perl_tests.conf'); @@ -17,6 +17,7 @@ BEGIN { use_ok('WTSI::NPG::iRODS::DataObject'); } use WTSI::NPG::iRODS::DataObject; +my $fixture_counter = 0; my $data_path = './t/irods_path_test'; my $irods_tmp_coll; @@ -24,10 +25,15 @@ my $pid = $$; my @groups_added; +my $have_admin_rights = + system(qq{$WTSI::NPG::iRODS::IADMIN lu 2>&1 /dev/null}) == 0; + sub make_fixture : Test(setup) { my $irods = WTSI::NPG::iRODS->new(strict_baton_version => 0); - $irods_tmp_coll = $irods->add_collection("DataObjectTest.$pid"); + $irods_tmp_coll = + $irods->add_collection("DataObjectTest.$pid.$fixture_counter"); + $fixture_counter++; $irods->put_collection($data_path, $irods_tmp_coll); my $i = 0; @@ -41,9 +47,11 @@ sub make_fixture : Test(setup) { } } - foreach my $group (qw(ss_0 ss_10)) { - unless ($irods->group_exists($group)) { - push @groups_added, $irods->add_group($group); + if ($have_admin_rights) { + foreach my $group (qw(ss_0 ss_10)) { + unless ($irods->group_exists($group)) { + push @groups_added, $irods->add_group($group); + } } } } @@ -53,9 +61,11 @@ sub teardown : Test(teardown) { $irods->remove_collection($irods_tmp_coll); - foreach my $group (@groups_added) { - if ($irods->group_exists($group)) { - $irods->remove_group($group); + if ($have_admin_rights) { + foreach my $group (@groups_added) { + if ($irods->group_exists($group)) { + $irods->remove_group($group); + } } } } @@ -416,6 +426,15 @@ sub str : Test(1) { is($obj->str, $obj_path, 'DataObject string'); } +sub checksum : Test(1) { + my $irods = WTSI::NPG::iRODS->new(strict_baton_version => 0); + my $obj_path = "$irods_tmp_coll/irods_path_test/test_dir/test_file.txt"; + + my $obj = WTSI::NPG::iRODS::DataObject->new($irods, $obj_path); + is($obj->checksum, "d41d8cd98f00b204e9800998ecf8427e", + 'Has correct checksum'); +} + sub get_permissions : Test(1) { my $irods = WTSI::NPG::iRODS->new(strict_baton_version => 0); my $obj_path = "$irods_tmp_coll/irods_path_test/test_dir/test_file.txt"; @@ -466,19 +485,25 @@ sub get_groups : Test(6) { my $obj_path = "$irods_tmp_coll/irods_path_test/test_dir/test_file.txt"; my $obj = WTSI::NPG::iRODS::DataObject->new($irods, $obj_path); - ok($irods->set_object_permissions('read', 'public', $obj_path)); - ok($irods->set_object_permissions('read', 'ss_0', $obj_path)); - ok($irods->set_object_permissions('read', 'ss_10', $obj_path)); + SKIP: { + if (not $irods->group_exists('ss_0')) { + skip "Skipping test requiring the test group ss_0", 5; + } - my $expected_all = ['ss_0', 'ss_10']; - my @found_all = $obj->get_groups; - is_deeply(\@found_all, $expected_all, 'Expected all groups') - or diag explain \@found_all; + ok($irods->set_object_permissions('read', 'public', $obj_path)); + ok($irods->set_object_permissions('read', 'ss_0', $obj_path)); + ok($irods->set_object_permissions('read', 'ss_10', $obj_path)); - my $expected_read = ['ss_0', 'ss_10']; - my @found_read = $obj->get_groups('read'); - is_deeply(\@found_read, $expected_read, 'Expected read groups') - or diag explain \@found_read; + my $expected_all = ['ss_0', 'ss_10']; + my @found_all = $obj->get_groups; + is_deeply(\@found_all, $expected_all, 'Expected all groups') + or diag explain \@found_all; + + my $expected_read = ['ss_0', 'ss_10']; + my @found_read = $obj->get_groups('read'); + is_deeply(\@found_read, $expected_read, 'Expected read groups') + or diag explain \@found_read; + } my $expected_own = []; my @found_own = $obj->get_groups('own'); diff --git a/t/lib/WTSI/NPG/iRODSTest.pm b/t/lib/WTSI/NPG/iRODSTest.pm index 47a32aef..fac58caf 100644 --- a/t/lib/WTSI/NPG/iRODSTest.pm +++ b/t/lib/WTSI/NPG/iRODSTest.pm @@ -10,10 +10,11 @@ use File::Spec; use File::Temp qw(tempdir); use List::AllUtils qw(all any none); use Log::Log4perl; +use Try::Tiny; use Unicode::Collate; use base qw(Test::Class); -use Test::More tests => 197; +use Test::More tests => 200; use Test::Exception; Log::Log4perl::init('./etc/log4perl_tests.conf'); @@ -25,15 +26,20 @@ use WTSI::NPG::iRODS; my $pid = $PID; my $cwc = WTSI::NPG::iRODS->new(strict_baton_version => 0)->working_collection; +my $fixture_counter = 0; my $data_path = './t/irods'; my $irods_tmp_coll; my @groups_added; +my $have_admin_rights = + system(qq{$WTSI::NPG::iRODS::IADMIN lu 2>&1 /dev/null}) == 0; + sub make_fixture : Test(setup) { my $irods = WTSI::NPG::iRODS->new(strict_baton_version => 0); - $irods_tmp_coll = $irods->add_collection("iRODSTest.$pid"); + $irods_tmp_coll = $irods->add_collection("iRODSTest.$pid.$fixture_counter"); + $fixture_counter++; $irods->put_collection($data_path, $irods_tmp_coll); my $i = 0; @@ -48,9 +54,11 @@ sub make_fixture : Test(setup) { } } - foreach my $group (qw(ss_0 ss_10)) { - unless ($irods->group_exists($group)) { - push @groups_added, $irods->add_group($group); + if ($have_admin_rights) { + foreach my $group (qw(ss_0 ss_10)) { + if (not $irods->group_exists($group)) { + push @groups_added, $irods->add_group($group); + } } } } @@ -61,9 +69,11 @@ sub teardown : Test(teardown) { $irods->working_collection($cwc); $irods->remove_collection($irods_tmp_coll); - foreach my $group (@groups_added) { - if ($irods->group_exists($group)) { - $irods->remove_group($group); + if ($have_admin_rights) { + foreach my $group (@groups_added) { + if ($irods->group_exists($group)) { + $irods->remove_group($group); + } } } } @@ -161,7 +171,9 @@ sub set_group_access : Test(7) { $lorem_object) } 'Expected to fail setting access for non-existent group'; + my $zone = $irods->find_zone_name($irods_tmp_coll); my $r0 = none { exists $_->{owner} && $_->{owner} eq 'public' && + exists $_->{zone} && $_->{zone} eq $zone && exists $_->{level} && $_->{level} eq 'read' } $irods->get_object_permissions($lorem_object); ok($r0, 'No public read access'); @@ -169,6 +181,7 @@ sub set_group_access : Test(7) { ok($irods->set_group_access('read', 'public', $lorem_object)); my $r1 = any { exists $_->{owner} && $_->{owner} eq 'public' && + exists $_->{zone} && $_->{zone} eq $zone && exists $_->{level} && $_->{level} eq 'read' } $irods->get_object_permissions($lorem_object); ok($r1, 'Added public read access'); @@ -176,6 +189,7 @@ sub set_group_access : Test(7) { ok($irods->set_group_access(undef, 'public', $lorem_object)); my $r2 = none { exists $_->{owner} && $_->{owner} eq 'public' && + exists $_->{zone} && $_->{zone} eq $zone && exists $_->{level} && $_->{level} eq 'read' } $irods->get_object_permissions($lorem_object); ok($r2, 'Removed public read access'); @@ -186,6 +200,7 @@ sub get_object_permissions : Test(1) { my $lorem_object = "$irods_tmp_coll/irods/lorem.txt"; my $perms = all { exists $_->{owner} && + exists $_->{zone} && exists $_->{level} } $irods->get_object_permissions($lorem_object); ok($perms, 'Permissions obtained'); @@ -205,7 +220,9 @@ sub set_object_permissions : Test(6) { ok($irods->set_object_permissions('read', 'public', $lorem_object)); + my $zone = $irods->find_zone_name($irods_tmp_coll); my $r1 = any { exists $_->{owner} && $_->{owner} eq 'public' && + exists $_->{zone} && $_->{zone} eq $zone && exists $_->{level} && $_->{level} eq 'read' } $irods->get_object_permissions($lorem_object); ok($r1, 'Added public read access'); @@ -213,6 +230,7 @@ sub set_object_permissions : Test(6) { ok($irods->set_object_permissions(undef, 'public', $lorem_object)); my $r2 = none { exists $_->{owner} && $_->{owner} eq 'public' && + exists $_->{zone} && $_->{zone} eq $zone && exists $_->{level} && $_->{level} eq 'read' } $irods->get_object_permissions($lorem_object); ok($r2, 'Removed public read access'); @@ -222,19 +240,25 @@ sub get_object_groups : Test(6) { my $irods = WTSI::NPG::iRODS->new(strict_baton_version => 0); my $lorem_object = "$irods_tmp_coll/irods/lorem.txt"; - ok($irods->set_object_permissions('read', 'public', $lorem_object)); - ok($irods->set_object_permissions('read', 'ss_0', $lorem_object)); - ok($irods->set_object_permissions('read', 'ss_10', $lorem_object)); + SKIP: { + if (not $irods->group_exists('ss_0')) { + skip "Skipping test requiring the test group ss_0", 5; + } + + ok($irods->set_object_permissions('read', 'public', $lorem_object)); + ok($irods->set_object_permissions('read', 'ss_0', $lorem_object)); + ok($irods->set_object_permissions('read', 'ss_10', $lorem_object)); - my $expected_all = ['ss_0', 'ss_10']; - my @found_all = $irods->get_object_groups($lorem_object); - is_deeply(\@found_all, $expected_all, 'Expected all groups') - or diag explain \@found_all; + my $expected_all = ['ss_0', 'ss_10']; + my @found_all = $irods->get_object_groups($lorem_object); + is_deeply(\@found_all, $expected_all, 'Expected all groups') + or diag explain \@found_all; - my $expected_read = ['ss_0', 'ss_10']; - my @found_read = $irods->get_object_groups($lorem_object, 'read'); - is_deeply(\@found_read, $expected_read, 'Expected read groups') - or diag explain \@found_read; + my $expected_read = ['ss_0', 'ss_10']; + my @found_read = $irods->get_object_groups($lorem_object, 'read'); + is_deeply(\@found_read, $expected_read, 'Expected read groups') + or diag explain \@found_read; + } my $expected_own = []; my @found_own = $irods->get_object_groups($lorem_object, 'own'); @@ -247,6 +271,7 @@ sub get_collection_permissions : Test(1) { my $coll = "$irods_tmp_coll/irods"; my $perms = all { exists $_->{owner} && + exists $_->{zone} && exists $_->{level} } $irods->get_collection_permissions($coll); ok($perms, 'Permissions obtained'); @@ -266,7 +291,9 @@ sub set_collection_permissions : Test(6) { ok($irods->set_collection_permissions('read', 'public', $coll)); + my $zone = $irods->find_zone_name($irods_tmp_coll); my $r1 = any { exists $_->{owner} && $_->{owner} eq 'public' && + exists $_->{zone} && $_->{zone} eq $zone && exists $_->{level} && $_->{level} eq 'read' } $irods->get_collection_permissions($coll); ok($r1, 'Added public read access'); @@ -274,6 +301,7 @@ sub set_collection_permissions : Test(6) { ok($irods->set_collection_permissions(undef, 'public', $coll)); my $r2 = none { exists $_->{owner} && $_->{owner} eq 'public' && + exists $_->{zone} && $_->{zone} eq $zone && exists $_->{level} && $_->{level} eq 'read' } $irods->get_collection_permissions($coll); ok($r2, 'Removed public read access'); @@ -283,19 +311,25 @@ sub get_collection_groups : Test(6) { my $irods = WTSI::NPG::iRODS->new(strict_baton_version => 0); my $coll = "$irods_tmp_coll/irods"; - ok($irods->set_collection_permissions('read', 'public', $coll)); - ok($irods->set_collection_permissions('read', 'ss_0', $coll)); - ok($irods->set_collection_permissions('read', 'ss_10', $coll)); + SKIP: { + if (not $irods->group_exists('ss_0')) { + skip "Skipping test requiring the test group ss_0", 5; + } - my $expected_all = ['ss_0', 'ss_10']; - my @found_all = $irods->get_collection_groups($coll); - is_deeply(\@found_all, $expected_all, 'Expected all groups') - or diag explain \@found_all; + ok($irods->set_collection_permissions('read', 'public', $coll)); + ok($irods->set_collection_permissions('read', 'ss_0', $coll)); + ok($irods->set_collection_permissions('read', 'ss_10', $coll)); - my $expected_read = ['ss_0', 'ss_10']; - my @found_read = $irods->get_collection_groups($coll, 'read'); - is_deeply(\@found_read, $expected_read, 'Expected read groups') - or diag explain \@found_read; + my $expected_all = ['ss_0', 'ss_10']; + my @found_all = $irods->get_collection_groups($coll); + is_deeply(\@found_all, $expected_all, 'Expected all groups') + or diag explain \@found_all; + + my $expected_read = ['ss_0', 'ss_10']; + my @found_read = $irods->get_collection_groups($coll, 'read'); + is_deeply(\@found_read, $expected_read, 'Expected read groups') + or diag explain \@found_read; + } my $expected_own = []; my @found_own = $irods->get_collection_groups($coll, 'own'); @@ -303,9 +337,10 @@ sub get_collection_groups : Test(6) { or diag explain \@found_own; } -sub list_collection : Test(5) { +sub list_collection : Test(7) { my $irods = WTSI::NPG::iRODS->new(strict_baton_version => 0); - my ($objs, $colls) = $irods->list_collection("$irods_tmp_coll/irods"); + my ($objs, $colls, $checksums) = + $irods->list_collection("$irods_tmp_coll/irods"); is_deeply($objs, ["$irods_tmp_coll/irods/lorem.txt", "$irods_tmp_coll/irods/test.txt", @@ -316,10 +351,19 @@ sub list_collection : Test(5) { "$irods_tmp_coll/irods/md5sum", "$irods_tmp_coll/irods/test"]) or diag explain $colls; + is_deeply($checksums, + {"$irods_tmp_coll/irods/lorem.txt" => + "39a4aa291ca849d601e4e5b8ed627a04", + "$irods_tmp_coll/irods/test.txt" => + "2205e48de5f93c784733ffcca841d2b5", + "$irods_tmp_coll/irods/utf-8.txt" => + "500cec3fbb274064e2a25fa17a69638a" + }) or diag explain $checksums; + ok(!$irods->list_collection('no_collection_exists'), 'Failed to list a non-existent collection'); - my ($objs_deep, $colls_deep) = + my ($objs_deep, $colls_deep, $checksums_deep) = $irods->list_collection("$irods_tmp_coll/irods", 'RECURSE'); is_deeply($objs_deep, ["$irods_tmp_coll/irods/lorem.txt", @@ -351,6 +395,38 @@ sub list_collection : Test(5) { "$irods_tmp_coll/irods/test/dir1", "$irods_tmp_coll/irods/test/dir2"]) or diag explain $colls_deep; + + is_deeply($checksums_deep, + {"$irods_tmp_coll/irods/lorem.txt" => + "39a4aa291ca849d601e4e5b8ed627a04", + "$irods_tmp_coll/irods/test.txt" => + "2205e48de5f93c784733ffcca841d2b5", + "$irods_tmp_coll/irods/utf-8.txt" => + "500cec3fbb274064e2a25fa17a69638a", + "$irods_tmp_coll/irods/collect_files/a/10.txt" => + "d41d8cd98f00b204e9800998ecf8427e", + "$irods_tmp_coll/irods/collect_files/a/x/1.txt" => + "d41d8cd98f00b204e9800998ecf8427e", + "$irods_tmp_coll/irods/collect_files/b/20.txt" => + "d41d8cd98f00b204e9800998ecf8427e", + "$irods_tmp_coll/irods/collect_files/b/y/2.txt" => + "d41d8cd98f00b204e9800998ecf8427e", + "$irods_tmp_coll/irods/collect_files/c/30.txt" => + "d41d8cd98f00b204e9800998ecf8427e", + "$irods_tmp_coll/irods/collect_files/c/z/3.txt" => + "d41d8cd98f00b204e9800998ecf8427e", + "$irods_tmp_coll/irods/md5sum/lorem.txt" => + "39a4aa291ca849d601e4e5b8ed627a04", + "$irods_tmp_coll/irods/test/file1.txt" => + "d41d8cd98f00b204e9800998ecf8427e", + "$irods_tmp_coll/irods/test/file2.txt" => + "d41d8cd98f00b204e9800998ecf8427e", + "$irods_tmp_coll/irods/test/dir1/file3.txt" => + "d41d8cd98f00b204e9800998ecf8427e", + "$irods_tmp_coll/irods/test/dir2/file4.txt" => + "d41d8cd98f00b204e9800998ecf8427e" + }) + or diag explain $checksums_deep; } sub add_collection : Test(2) { @@ -377,9 +453,15 @@ sub put_collection : Test(2) { is_deeply(\@contents, [["$irods_tmp_coll/put_collection/test/file1.txt", "$irods_tmp_coll/put_collection/test/file2.txt"], + ["$irods_tmp_coll/put_collection/test", "$irods_tmp_coll/put_collection/test/dir1", - "$irods_tmp_coll/put_collection/test/dir2"]]) + "$irods_tmp_coll/put_collection/test/dir2"], + + {"$irods_tmp_coll/put_collection/test/file1.txt" => + "d41d8cd98f00b204e9800998ecf8427e", + "$irods_tmp_coll/put_collection/test/file2.txt" => + "d41d8cd98f00b204e9800998ecf8427e"}]) or diag explain \@contents; } @@ -851,6 +933,16 @@ sub find_objects_by_meta : Test(6) { 'Expected to fail using an invalid query operator'; } +sub checksum : Test(1) { + my $irods = WTSI::NPG::iRODS->new(strict_baton_version => 0); + + my $lorem_object = "$irods_tmp_coll/irods/lorem.txt"; + my $expected_checksum = '39a4aa291ca849d601e4e5b8ed627a04'; + + is($irods->checksum($lorem_object), $expected_checksum, + 'Checksum matched'); +} + sub calculate_checksum : Test(1) { my $irods = WTSI::NPG::iRODS->new(strict_baton_version => 0);