[ENSCORESW-563]. Adding array and hash based content detection methods for regulation.

Nathan requested methods which can perform this kind of task (assert the contents
of a data structure). We support 1 level of arrays and hashes. All test cases
pass at time of writing. Methods for capturing method returns were
not implemented. They do not fit into the Utils way of doing (no method
actually performs a task on an object they just report what it is).

modules/Bio/EnsEMBL/Utils/Scalar.pm

@@ -36,10 +36,16 @@ Bio::EnsEMBL::Utils::Scalar
 	check_ref({}, 'ARRAY'); # Will return false
 	check_ref($dba, 'Bio::EnsEMBL::DBSQL::DBAdaptor'); #Returns true if $dba is a DBAdaptor
 
+  # Returns true if all array contents are of the given type
+  check_array_contents([$dba], 'Bio::EnsEMBL::DBSQL::DBAdaptor'); 
+
 	assert_ref([], 'ARRAY'); #Returns true
 	assert_ref({}, 'ARRAY'); #throws an exception
 	assert_ref($dba, 'Bio::EnsEMBL::Gene'); #throws an exception if $dba is not a Gene
 
+  # Throws an exception if all array contents are not of the given type
+  assert_array_contents([$dba], 'Bio::EnsEMBL::Gene'); #throws an exception if $dba is not a Gene
+
 	wrap_array([]); #Returns the same reference
 	wrap_array($a); #Returns [$a] if $a was not an array
 	wrap_array(undef); #Returns [] since incoming was undefined
@@ -102,15 +108,15 @@ our %EXPORT_TAGS;
 our @EXPORT_OK;
 
 @EXPORT_OK = qw(
-  check_ref check_ref_can
-  assert_ref assert_ref_can assert_numeric assert_integer assert_boolean assert_strand assert_file_handle
+  check_ref check_ref_can check_array_contents check_hash_contents
+  assert_ref assert_ref_can assert_numeric assert_integer assert_boolean assert_strand assert_file_handle assert_array_contents assert_hash_contents
   wrap_array
   scope_guard
   split_array
 );
 %EXPORT_TAGS = (
-  assert  => [qw(assert_ref assert_ref_can assert_integer assert_numeric assert_boolean assert_strand assert_file_handle)],
-  check   => [qw(check_ref check_ref_can)],
+  assert  => [qw(assert_ref assert_ref_can assert_integer assert_numeric assert_boolean assert_strand assert_file_handle assert_array_contents assert_hash_contents)],
+  check   => [qw(check_ref check_ref_can check_array_contents check_hash_contents)],
   array   => [qw/wrap_array split_array/],
   all     => [@EXPORT_OK]
 );
@@ -195,6 +201,189 @@ sub assert_ref {
   return 1;
 }
 
+=head2 assert_array_contents
+
+ Arg [1]     : ArrayRef references to check
+ Arg [2]     : The type we expect
+ Arg [3]     : The attribute name you are asserting; not required but allows
+               for more useful error messages to be generated. Defaults to
+               C<-Unknown->.
+ Description : A subroutine which checks to see if the given objects/refs are
+               what you expect. This behaves in an identical manner as
+               C<assert_ref> does works on an array ref of references
+
+               You can turn assertions off by using the global variable
+               $Bio::EnsEMBL::Utils::Scalar::ASSERTIONS = 0
+ Returntype  : Boolean; true if we managed to get to the return
+ Example     : assert_array_contents([[],[],[]], 'ARRAY');
+ Exceptions  : Throws is references argument is not an ArrayRef, also
+               if the expected type was not set and if the given reference
+               was not assignable to the expected value.
+ Status      : Stable
+
+=cut
+
+sub assert_array_contents {
+  my ($array, $expected, $attribute_name) = @_;
+  return 1 unless $ASSERTIONS;
+  throw('No expected type given') if ! defined $expected;
+  $attribute_name ||= '-Unknown-';
+  assert_ref($array, 'ARRAY', $attribute_name);
+  my $count = scalar(@{$array});
+  for(my $i = 0; $i<$count; $i++) {
+    my $ref = $array->[$i];
+    my $class = ref($ref);
+    throw("The given reference for attribute $attribute_name was undef (at position ${i})") unless defined $ref;
+    throw("Asking for the type of the attribute $attribute_name produced no type; check it is a reference (at position ${i})") unless $class;
+    if(blessed($ref)) {
+      throw("${attribute_name}'s type '${class}' is not an ISA of '${expected}' (at position ${i})") if ! $ref->isa($expected);
+    }
+    else {
+      throw("$attribute_name was expected to be '${expected}' but was '${class}' (at position ${i})") if $expected ne $class;
+    }
+  }
+  return 1;
+}
+
+=head2 check_array_contents
+
+ Arg [1]     : ArrayRef references to check
+ Arg [2]     : The type we expect
+ Arg [3]     : The attribute name you are asserting; not required but allows
+               for more useful error messages to be generated. Defaults to
+               C<-Unknown->.
+ Description : A subroutine which checks to see if the given objects/refs are
+               what you expect. 
+ Returntype  : Boolean; true if all contents were as expected
+ Example     : check_array_contents([[],[],[]], 'ARRAY');
+ Exceptions  : Thrown if no type was given
+ Status      : Stable
+
+=cut
+
+sub check_array_contents {
+  my ($array, $expected, $attribute_name) = @_;
+  return 0 if ! check_ref($array, 'ARRAY');
+  throw('No expected type given') if ! defined $expected;
+  my $contents_ok = 1;
+  my $count = scalar(@{$array});
+  for(my $i = 0; $i<$count; $i++) {
+    my $ref = $array->[$i];
+    if(!$ref) {
+      $contents_ok = 0;
+      last;
+    }
+    my $class = ref($ref);
+    if(!$class) {
+      $contents_ok = 0;
+      last;
+    }
+    if(blessed($ref)) {
+      if(! $ref->isa($expected)) {
+        $contents_ok = 0;
+        last;
+      }
+    }
+    elsif($expected ne $class) {
+      $contents_ok = 0;
+      last;
+    }
+  }
+  return $contents_ok;
+}
+
+=head2 assert_hash_contents
+
+ Arg [1]     : HashRef references to check
+ Arg [2]     : The type we expect
+ Arg [3]     : The attribute name you are asserting; not required but allows
+               for more useful error messages to be generated. Defaults to
+               C<-Unknown->.
+ Description : A subroutine which checks to see if the given objects/refs are
+               what you expect. This behaves in an identical manner as
+               C<assert_ref> does works on a HashRef of references. Hash keys 
+               are always Strings so do not need asserting.
+
+               You can turn assertions off by using the global variable
+               $Bio::EnsEMBL::Utils::Scalar::ASSERTIONS = 0
+ Returntype  : Boolean; true if we managed to get to the return
+ Example     : assert_hash_contents({a => [], b => []}, 'ARRAY');
+ Exceptions  : Throws is references argument is not an ArrayRef, also
+               if the expected type was not set and if the given reference
+               was not assignable to the expected value.
+ Status      : Stable
+
+=cut
+
+sub assert_hash_contents {
+  my ($hash, $expected, $attribute_name) = @_;
+  return 1 unless $ASSERTIONS;
+  throw('No expected type given') if ! defined $expected;
+  $attribute_name ||= '-Unknown-';
+  assert_ref($hash, 'HASH', $attribute_name);
+  my @keys = keys %{$hash};
+  while(my $key = shift @keys) {
+    my $ref = $hash->{$key};
+    my $class = ref($ref);
+    throw("The given reference for attribute $attribute_name was undef (with key ${key})") unless defined $ref;
+    throw("Asking for the type of the attribute $attribute_name produced no type; check it is a reference (with key ${key})") unless $class;
+    if(blessed($ref)) {
+      throw("${attribute_name}'s type '${class}' is not an ISA of '${expected}' (with key ${key})") if ! $ref->isa($expected);
+    }
+    else {
+      throw("$attribute_name was expected to be '${expected}' but was '${class}' (with key ${key})") if $expected ne $class;
+    }
+  }
+  return 1;
+}
+
+=head2 check_hash_contents
+
+ Arg [1]     : HashRef references to check
+ Arg [2]     : The type we expect
+ Arg [3]     : The attribute name you are asserting; not required but allows
+               for more useful error messages to be generated. Defaults to
+               C<-Unknown->.
+ Description : A subroutine which checks to see if the given objects/refs are
+               what you expect. 
+ Returntype  : Boolean; true if all contents were as expected
+ Example     : check_hash_contents({a => [], b => []}, 'ARRAY');
+ Exceptions  : Thrown if no type was given
+ Status      : Stable
+
+=cut
+
+sub check_hash_contents {
+  my ($hash, $expected, $attribute_name) = @_;
+  throw('No expected type given') if ! defined $expected;
+  return 0 if ! check_ref($hash, 'HASH');
+  my $contents_ok = 1;
+  my @keys = keys %{$hash};
+  while(my $key = shift @keys) {
+    my $ref = $hash->{$key};
+    if(!$ref) {
+      $contents_ok = 0;
+      last;
+    }
+    my $class = ref($ref);
+    if(!$class) {
+      $contents_ok = 0;
+      last;
+    }
+    if(blessed($ref)) {
+      if(! $ref->isa($expected)) {
+        $contents_ok = 0;
+        last;
+      }
+    }
+    elsif($expected ne $class) {
+      $contents_ok = 0;
+      last;
+    }
+  }
+  return $contents_ok;
+}
+
 =head2 wrap_array()
 
   Arg         : The reference we want to wrap in an array
@@ -453,7 +642,7 @@ sub assert_file_handle {
   Arg [2]     : ArrayRef The array to split
   Description : Takes an array of values and splits the array into multiple 
                 arrays where the maximum size of each array is as specified
-  Example     : 
+  Example     : my $split_arrays = split_array($large_array, 10);
   Returntype  : ArrayRef of ArrayRefs where each element is a split list
 =cut
 

modules/t/utilsScalar.t

@@ -10,6 +10,8 @@ use IO::Handle;
 
 my $gene = Bio::EnsEMBL::IdMapping::TinyGene->new_fast([]);
 
+# Assert ref check
+
 dies_ok { assert_ref(undef, 'ARRAY') } 'Undef value results in death';
 dies_ok { assert_ref([], undef) } 'Undef assertion results in death';
 throws_ok { assert_ref('string', 'ARRAY') } qr/produced no type/, 'Passing in a Scalar means death';
@@ -41,6 +43,71 @@ ok ( check_ref({}, 'HASH'), 'Ref of a hash should be a HASH');
 ok ( check_ref($gene, 'Bio::EnsEMBL::IdMapping::TinyFeature'), 'Ref of a gene should be a TinyFeature');
 ok ( check_ref($gene, 'Bio::EnsEMBL::IdMapping::TinyGene'), 'Ref of a gene should be a TinyGene');
 
+# Array assertions
+dies_ok { assert_array_contents([undef], 'ARRAY') } 'ARRAY: Undef value results in death';
+dies_ok { assert_array_contents([], undef) } 'ARRAY: Undef assertion results in death';
+throws_ok { assert_array_contents(['string'], 'ARRAY') } qr/produced no type/, 'ARRAY: Passing in a Scalar means death';
+dies_ok { assert_array_contents([\''], 'ARRAY') } 'ARRAY: Ref of a Scalar is not an ARRAY so death';
+dies_ok { assert_array_contents([$gene], 'CODE') } 'ARRAY: TinyGene object is not a CODE so death';
+dies_ok { assert_array_contents([$gene], 'Bio::EnsEMBL::Feature') } 'ARRAY: TinyGene object is not a Bio::EnsEMBL::Feature so death';
+dies_ok { assert_array_contents([$gene], 'HASH') }  'ARRAY: TinyGene is blessed so we expect false even though it is a HASH';
+
+lives_ok { assert_array_contents([\''], 'SCALAR') } 'ARRAY: Ref of a Scalar should be a SCALAR';
+lives_ok { assert_array_contents([[]], 'ARRAY') } 'ARRAY: Ref of an array should be a ARRAY';
+lives_ok { assert_array_contents([{}], 'HASH') } 'ARRAY: Ref of a hash should be a HASH';
+lives_ok { assert_array_contents([$gene], 'Bio::EnsEMBL::IdMapping::TinyFeature') } 'ARRAY: Ref of a gene should be a TinyFeature';
+lives_ok { assert_array_contents([$gene], 'Bio::EnsEMBL::IdMapping::TinyGene') } 'ARRAY: Ref of a gene should be a TinyGene';
+lives_ok { assert_array_contents([], 'Bio::EnsEMBL::IdMapping::TinyGene') } 'ARRAY: Empty array means no death';
+
+# Array checks
+dies_ok { check_array_contents([], undef) } 'ARRAY: Undef for assertion in check_array_contents results in death';
+
+ok(! check_array_contents([undef], 'ARRAY'), 'ARRAY: Undef value returns false');
+ok(! check_array_contents(['string'], 'ARRAY'), 'ARRAY: Passing in a Scalar means returns false');
+ok(! check_array_contents([\''], 'ARRAY'),  'ARRAY: Ref of a Scalar is not an ARRAY so returns false');
+ok(! check_array_contents([$gene], 'CODE'),  'ARRAY: TinyGene object is not a CODE so returns false');
+ok(! check_array_contents([$gene], 'Bio::EnsEMBL::Feature'),  'ARRAY: TinyGene object is not a Bio::EnsEMBL::Feature so returns false');
+ok(! check_array_contents([$gene], 'HASH'),  'ARRAY: TinyGene is blessed so we expect false even though it is a HASH');
+
+ok ( check_array_contents([\''], 'SCALAR'), 'ARRAY: Ref of a Scalar should be a SCALAR');
+ok ( check_array_contents([[]], 'ARRAY'), 'ARRAY: Ref of an array should be a ARRAY');
+ok ( check_array_contents([{}], 'HASH'), 'ARRAY: Ref of a hash should be a HASH');
+ok ( check_array_contents([$gene], 'Bio::EnsEMBL::IdMapping::TinyFeature'), 'ARRAY: Ref of a gene should be a TinyFeature');
+ok ( check_array_contents([$gene], 'Bio::EnsEMBL::IdMapping::TinyGene'), 'ARRAY: Ref of a gene should be a TinyGene');
+
+# Hash assertions
+dies_ok { assert_hash_contents({a => undef}, 'ARRAY') } 'HASH: Undef value results in death';
+dies_ok { assert_hash_contents({}, undef) } 'HASH: Undef assertion results in death';
+throws_ok { assert_hash_contents({ a => 'string'}, 'ARRAY') } qr/produced no type/, 'HASH: Passing in a Scalar means death';
+dies_ok { assert_hash_contents({a => \''}, 'ARRAY') } 'HASH: Ref of a Scalar is not an ARRAY so death';
+dies_ok { assert_hash_contents({a => $gene}, 'CODE') } 'HASH: TinyGene object is not a CODE so death';
+dies_ok { assert_hash_contents({a => $gene}, 'Bio::EnsEMBL::Feature') } 'HASH: TinyGene object is not a Bio::EnsEMBL::Feature so death';
+dies_ok { assert_hash_contents({a => $gene}, 'HASH') }  'HASH: TinyGene is blessed so we expect false even though it is a HASH';
+
+lives_ok { assert_hash_contents({a => \'' }, 'SCALAR') } 'HASH: Ref of a Scalar should be a SCALAR';
+lives_ok { assert_hash_contents({a => []}, 'ARRAY') } 'HASH: Ref of an array should be a ARRAY';
+lives_ok { assert_hash_contents({a => {}}, 'HASH') } 'HASH: Ref of a hash should be a HASH';
+lives_ok { assert_hash_contents({a => $gene}, 'Bio::EnsEMBL::IdMapping::TinyFeature') } 'HASH: Ref of a gene should be a TinyFeature';
+lives_ok { assert_hash_contents({a => $gene}, 'Bio::EnsEMBL::IdMapping::TinyGene') } 'HASH: Ref of a gene should be a TinyGene';
+lives_ok { assert_hash_contents({}, 'Bio::EnsEMBL::IdMapping::TinyGene') } 'HASH: Empty array means no death';
+
+# Hash checks
+dies_ok { check_hash_contents({}, undef) } 'HASH: Undef for assertion in check_hash_contents results in death';
+
+ok(! check_hash_contents({a => undef}, 'ARRAY'), 'HASH: Undef value returns false');
+ok(! check_hash_contents({a => 'string'}, 'ARRAY'), 'HASH: Passing in a Scalar means returns false');
+ok(! check_hash_contents({a => \''}, 'ARRAY'),  'HASH: Ref of a Scalar is not an ARRAY so returns false');
+ok(! check_hash_contents({a => $gene}, 'CODE'),  'HASH: TinyGene object is not a CODE so returns false');
+ok(! check_hash_contents({a => $gene}, 'Bio::EnsEMBL::Feature'),  'HASH: TinyGene object is not a Bio::EnsEMBL::Feature so returns false');
+ok(! check_hash_contents({a => $gene}, 'HASH'),  'HASH: TinyGene is blessed so we expect false even though it is a HASH');
+
+ok ( check_hash_contents({a => \''}, 'SCALAR'), 'HASH: Ref of a Scalar should be a SCALAR');
+ok ( check_hash_contents({a => []}, 'ARRAY'), 'HASH: Ref of an array should be a ARRAY');
+ok ( check_hash_contents({a => {}}, 'HASH'), 'HASH: Ref of a hash should be a HASH');
+ok ( check_hash_contents({a => $gene}, 'Bio::EnsEMBL::IdMapping::TinyFeature'), 'HASH: Ref of a gene should be a TinyFeature');
+ok ( check_hash_contents({a => $gene}, 'Bio::EnsEMBL::IdMapping::TinyGene'), 'HASH: Ref of a gene should be a TinyGene');
+
+
 #Array Wrapping
 
 my $undef_ref = undef;
@@ -85,7 +152,10 @@ throws_ok { assert_integer(undef) } qr/undefined/, 'Passing in undefined scalar
 dies_ok { assert_integer(bless(1, 'Brian'), 'met')} 'Passing in a blessed scalar means death';
 dies_ok { assert_integer('hello')} 'Passing in a String scalar means death';
 dies_ok { assert_integer({})} 'Passing in a HashRef means death';
-dies_ok { assert_integer(1E-10) } 'Passing in scientific notation numeric means death';
+dies_ok { assert_integer(1E-10) } 'Passing in negative scientific notation numeric means death';
+lives_ok { assert_integer(1E10) } 'Passing in positive scientific notation numeric means lives';
+lives_ok { assert_integer(1_000) } 'Separators means lives';
+lives_ok { assert_integer('2') } 'A string numeric is ok';
 dies_ok { assert_integer(1.2) } 'Passing in floating point means death';
 lives_ok { assert_integer(1) } 'Passing in integer means lives';
 
@@ -179,6 +249,8 @@ close($_) for ($scalar_fh, $other_scalar_fh);
   lives_ok {assert_integer([])          } 'Assertions off; [] returns true for assert_integer()';
   lives_ok {assert_numeric([])          } 'Assertions off; [] returns true for assert_numeric()';
   lives_ok {assert_ref_can([], 'wibble')} 'Assertions off; [] returns true for assert_ref_can()';
+  lives_ok {assert_array_contents([{}], 'wibble')} 'Assertions off; [{}] returns true for assert_array_contents() when asserting type "wibble"';
+  lives_ok {assert_hash_contents({a => {}}, 'wibble')} 'Assertions off; {a => {}} returns true for assert_hash_contents() when asserting type "wibble"';
 }
 dies_ok { assert_ref([], 'HASH') } 'Assertions back on; [] is not a HASH';