Merge pull request #186 from wtsi-npg/devel

prep for release 3.5.1

Changes

@@ -1,3 +1,6 @@
+Release 3.5.1
+ - Fixed null dereference in Collection::collection_checksums
+
 Release 3.5.0
  - Added a new metadata attribute - id_product - to capture the digest
    of composition JSON

lib/WTSI/NPG/iRODS.pm

@@ -2146,6 +2146,19 @@ sub checksum {
   return $self->baton_client->list_object_checksum($object);
 }
 
+=head2 collection_checksums
+
+  Arg [1]    : iRODS collection path.
+  Arg [2]    : Recurse, Bool. Optional, defaults to false.
+
+  Example    : $cs = $irods->collection_checksums('/my/path/')
+  Description: Return the MD5 checksum of the iRODS data objects in a
+               collection as a mapping of data object path to corresponding
+               checksum.
+  Returntype : HashRef
+
+=cut
+
 sub collection_checksums {
   my ($self, $collection, $recurse) = @_;
 

lib/WTSI/NPG/iRODS/BatonClient.pm

@@ -211,6 +211,20 @@ sub list_object {
   return $path;
 }
 
+=head2 list_collection_checksums
+
+  Arg [1]    : iRODS collection path.
+  Arg [2]    : Recurse, Bool. Optional, defaults to false.
+
+  Example    : my $checksums =
+                 $irods->list_collection_checksums('/path/to/collection')
+  Description: Return the checksums of the data objects in a collection
+               as a mapping of data object path to corresponding checksum.
+               This method is present for speed.
+  Returntype : HashRef
+
+=cut
+
 sub list_collection_checksums {
   my ($self, $collection, $recur) = @_;
 

lib/WTSI/NPG/iRODS/Collection.pm

@@ -1,6 +1,7 @@
 package WTSI::NPG::iRODS::Collection;
 
 use namespace::autoclean;
+use File::Basename qw(fileparse);
 use File::Spec;
 use Moose;
 use MooseX::StrictConstructor;
@@ -114,7 +115,7 @@ sub add_avu {
 
   Arg [1]    : attribute
   Arg [2]    : value
-  Arg [2]    : units (optional)
+  Arg [3]    : units (optional)
 
   Example    : $path->remove_avu('foo', 'bar')
   Description: Remove an AVU from an iRODS path (data object or collection)
@@ -162,9 +163,10 @@ sub make_avu_history {
 
 =head2 get_contents
 
-  Arg [1]    :
+  Arg [1]    : Recurse, Bool. Optional, defaults to false.
+  Arg [2]    : Fetch checksums, Bool. Optional, defaults to false.
 
-  Example    : my ($objs, $cols) = $coll->get_contents
+  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.
@@ -188,19 +190,22 @@ sub get_contents {
    my @collections;
 
    foreach my $obj (@$objs) {
-     my $object = WTSI::NPG::iRODS::DataObject->new($irods, $obj);
+     my ($dobj, $coll) = fileparse($obj);
+     my @init_args = (irods       => $irods,
+                      collection  => $coll,
+                      data_object => $dobj);
 
      if ($checksums) {
        if (exists $object_checksums->{$obj}) {
-         $object->checksum($checksums->{$obj});
+         push @init_args, checksum => $object_checksums->{$obj};
        }
        else {
          $self->logwarn("Failed to find a checksum for '$obj' when getting ",
                         "the contents of '$path'");
        }
      }
 
-     push @objects, $object;
+     push @objects, WTSI::NPG::iRODS::DataObject->new(@init_args);
    }
    foreach my $coll (@$colls) {
      push @collections, WTSI::NPG::iRODS::Collection->new($irods, $coll);
@@ -380,8 +385,8 @@ Keith James <kdj@sanger.ac.uk>
 
 =head1 COPYRIGHT AND DISCLAIMER
 
-Copyright (C) 2013, 2014, 2015, 2016 Genome Research Limited. All
-Rights Reserved.
+Copyright (C) 2013, 2014, 2015, 2016, 2019 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

t/lib/WTSI/NPG/iRODS/CollectionTest.pm

@@ -235,7 +235,7 @@ sub str : Test(1) {
   is($coll->str, $coll_path, 'Collection string');
 }
 
-sub get_contents : Test(4) {
+sub get_contents : Test(8) {
   my $irods = WTSI::NPG::iRODS->new(environment          => \%ENV,
                                     strict_baton_version => 0);
   my $coll_path = "$irods_tmp_coll/path/test_dir/contents";
@@ -282,6 +282,26 @@ sub get_contents : Test(4) {
 
   is_deeply(\@coll_paths_r, $expected_colls_r, 'Collection recursive contents')
     or diag explain \@coll_paths_r;
+
+  # Checksums read individually, on demand
+  my @checksums_r = map { $_->checksum } @$objs_r;
+  is_deeply(\@checksums_r, [('d41d8cd98f00b204e9800998ecf8427e') x 6 ],
+            'Object checksums') or diag explain \@checksums_r;
+
+  my ($objs_rc, $colls_rc) = $coll->get_contents('RECURSE', 'CHECKSUM');
+  my @obj_paths_rc  = map { $_->str } @$objs_r;
+  my @coll_paths_rc = map { $_->str } @$colls_r;
+
+  is_deeply(\@obj_paths_rc, $expected_objs_r, 'Object recursive contents')
+    or diag explain \@obj_paths_rc;
+
+  is_deeply(\@coll_paths_rc, $expected_colls_r, 'Collection recursive contents')
+    or diag explain \@coll_paths_rc;
+
+  # Checksums fetched as a batch
+  my @checksums_rc = map { $_->checksum } @$objs_rc;
+  is_deeply(\@checksums_r, [('d41d8cd98f00b204e9800998ecf8427e') x 6 ],
+            'Object checksums') or diag explain \@checksums_rc;
 }
 
 sub get_permissions : Test(1) {