Merge pull request #19 from keithj/checksum-reports

Added checksum reporting.

.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
 

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

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) = @_;
 

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 <[email protected]>
 
 =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

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) = @_;
 

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;