Addition of utility classes for use in the Ensembl API. The first are...

Addition of utility classes for use in the Ensembl API. The first are shortcuts for asserting object/ref types and the second is a class which removes boilerplate from working with databases.

modules/Bio/EnsEMBL/Utils/Scalar.pm

+package Bio::EnsEMBL::Utils::Scalar;
+
+=pod
+
+=head1 LICENSE
+
+  Copyright (c) 1999-2010 The European Bioinformatics Institute and
+  Genome Research Limited.  All rights reserved.
+
+  This software is distributed under a modified Apache license.
+  For license details, please see
+
+    http://www.ensembl.org/info/about/code_licence.html
+
+=head1 CONTACT
+
+  Please email comments or questions to the public Ensembl
+  developers list at <ensembl-dev@ebi.ac.uk>.
+
+  Questions may also be sent to the Ensembl help desk at
+  <helpdesk@ensembl.org>.
+
+=cut
+
+=pod
+
+=head1 NAME
+
+Bio::EnsEMBL::Utils::Scalar
+
+=head1 SYNOPSIS
+
+	use Bio::EnsEMBL::Utils::Scalar qw(check_ref assert_ref);
+	
+	check_ref([], 'ARRAY'); # Will return true
+	check_ref({}, 'ARRAY'); # Will return false
+	check_ref($dba, 'Bio::EnsEMBL::DBSQL::DBAdaptor'); #Returns true if $dba is a 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  
+	
+=head1 DESCRIPTION
+
+A collection of subroutines aimed to helping Scalar based operations
+
+=head1 METHODS
+
+See subroutines.
+
+=head1 MAINTAINER
+
+$Author$
+
+=head1 VERSION
+
+$Revision$
+
+=cut
+
+use strict;
+use warnings;
+
+use base qw(Exporter);
+our @EXPORT_OK = qw(check_ref assert_ref);
+
+use Bio::EnsEMBL::Utils::Exception qw(throw);
+use Scalar::Util qw(blessed);
+
+=head2 check_ref()
+
+  Arg [1]     : The reference to check
+  Arg [2]     : The type we expect
+  Description : A subroutine which checks to see if the given object/ref is 
+                what you expect. If you give it a blessed reference then it 
+                will perform an isa() call on the object after the defined 
+                tests. If it is a plain reference then it will use ref().
+                
+                An undefined value will return a false.
+  Returntype  : Boolean indicating if the reference was the type we 
+                expect
+  Example     : my $ok = check_ref([], 'ARRAY');
+  Exceptions  : If the expected type was not set
+  Status      : Stable
+
+=cut
+
+sub check_ref {
+	my ($ref, $expected) = @_;
+	throw('No expected type given') if ! defined $expected;
+	if(defined $ref) {
+		if(blessed($ref)) {
+			return 1 if $ref->isa($expected);
+		}
+		else {
+			my $ref_ref_type = ref($ref);
+			return 1 if defined $ref_ref_type && $ref_ref_type eq $expected; 
+		}
+	}
+	return 0;
+}
+
+=head2 assert_ref()
+
+  Arg [1]     : The reference to check
+  Arg [2]     : The type we expect
+  Description : A subroutine which checks to see if the given object/ref is 
+                what you expect. This behaves in an identical manner as
+                C<check_ref()> does except this will raise exceptions when
+                the values do not match rather than returning a boolean
+                indicating the situation.
+                
+                Undefs cause exception circumstances.
+  Returntype  : None
+  Example     : assert_ref([], 'ARRAY');
+  Exceptions  : If the expected type was not set and if the given reference
+                was not assignable to the expected value
+  Status      : Stable
+
+=cut
+
+sub assert_ref {
+  my ($ref, $expected) = @_;
+  throw('No expected type given') if ! defined $expected;
+  my $class = ref($ref);
+  throw('Given reference was undef') unless defined $ref;
+  throw('Asking for the type of the reference produced no type; check your input is a reference') unless $class;
+  if(blessed($ref)) {
+    throw("Reference '${class}' is not an ISA of '${expected}'") if ! $ref->isa($expected);
+  }
+  else {    
+    throw("'${expected}' expected class was not equal to actual class '${class}'") if $expected ne $class;
+  }
+  return 1;
+}
+
+1;

modules/t/sqlHelper.t

+#A set tests used to prod the SqlHelper class
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use Scalar::Util qw(isweak);
+
+use Bio::EnsEMBL::Test::MultiTestDB;
+use Bio::EnsEMBL::Test::TestUtils;
+use Bio::EnsEMBL::Utils::SqlHelper;
+
+my $multi = Bio::EnsEMBL::Test::MultiTestDB->new();
+my $dba = $multi->get_DBAdaptor( 'core' );
+ok( $dba, 'Test database instatiated' );
+
+#Now start testing the Helper
+dies_ok { Bio::EnsEMBL::DBSQL::SqlHelper->new(-DB_CONNECTION => $dba) } 
+  'Expect to die when we do not give SqlHelper a DBConncetion'; #was given a DBAdaptor
+ok ( 
+  isweak(Bio::EnsEMBL::DBSQL::SqlHelper->new(-DB_CONNECTION => $dba->dbc())->{db_connection}),
+  'Checking DBConnection reference is weak when we ask for it' 
+);
+
+my $helper = Bio::EnsEMBL::DBSQL::SqlHelper->new(-DB_CONNECTION => $dba->dbc());
+ok ( $helper, 'SqlHelper instance was created' );
+
+
+my $meta_key = 'species.common_name';
+diag("Meta key queries working with ${meta_key}. If the tests fail then check for it in the DB dumps");
+
+is( 
+  $helper->execute_single_result(-SQL => qq{select count(*) from meta where meta_key = '$meta_key'}),
+  1,
+  'Checking count of meta key is right with no params'
+);
+
+is( 
+  $helper->execute_single_result(-SQL => 'select count(*) from meta where meta_key =?', -PARAMS => [$meta_key]),
+  1,
+  'Checking count of meta key is right with params'
+);
+
+is_deeply( 
+  $helper->execute(-SQL => 'select count(*), 3 from meta where meta_key =?', -PARAMS => [$meta_key])->[0],
+  [1,3],
+  'Checking 2D mapping of meta key count works'
+);
+
+my $meta_count_hash = $helper->execute_into_hash(
+  -SQL => 'select meta_key, count(*) from meta group by meta_key'
+);
+
+is($meta_count_hash->{$meta_key}, 1, 'Checking hash comes back correctly');
+
+my $meta_table_count = $helper->execute_single_result(-SQL => 'select count(*) from meta');
+my $meta_memoize = $helper->execute(-SQL => 'select * from meta');
+
+is(scalar(@{$meta_memoize}), $meta_table_count, 'All meta items are returned');
+
+$dba->dbc()->do('alter table meta engine=InnoDB');
+
+ok($helper->_perform_transaction_code(), 'This level should do all transaction work');
+
+my $get_value = sub {
+  return $helper->execute_single_result(-SQL => 'select meta_value from meta where meta_key =?', -PARAMS => [$meta_key]);
+};
+
+{
+  #transaction isolation checks
+  throws_ok {
+    $helper->transaction(-CALLBACK => sub {
+      my $sql = 'insert into meta (species_id, meta_key, meta_value) values (?,?,?)';
+      $helper->execute_update(
+        -SQL => $sql,
+        -PARAMS => [2, 'm', '1']
+      );
+      $helper->execute_update(
+        -SQL => $sql,
+        -PARAMS => [2, 'm', '2']
+      );
+      
+      my $count = $helper->execute_single_result(-SQL => 'select count(*) from meta where species_id =?', -PARAMS => [2]);
+      is($count, 2, 'Count should be 2');
+      die 'Dead now';
+    });
+  }qr/Dead now/, 'Died as expected';
+  my $count = $helper->execute_single_result(-SQL => 'select count(*) from meta where species_id =?', -PARAMS => [2]);
+  is($count, 0, 'Count should be 0 as we reset the transaction');
+}
+
+#Testing multiple level isolation (or more that the framework ignores them)
+{
+  my $new_meta_value = 'test';
+  throws_ok {
+  $helper->transaction( -CALLBACK => sub {
+    $helper->execute_update(-SQL => 'update meta set meta_value =? where meta_key =?', -PARAMS => [$new_meta_value, $meta_key]);
+    eval {
+      $helper->transaction(-CALLBACK => sub {
+        ok(!$helper->_perform_transaction_code(), 'This level should not be doing any transaction work');
+        die 'This will not cause the transaction to be aborted';
+      });
+    };
+    is($get_value->(), $new_meta_value, 'The die from the prior transaction should not have triggered a rollback');
+    die('Dead now');
+  });
+  } qr/Dead now/, 'Expected die found';
+  
+  isnt($get_value->(), $new_meta_value, 'Meta value is reset as transaction was aborted');
+  
+  $helper->transaction( -CALLBACK => sub {
+    $helper->execute_update(-SQL => 'delete from meta');
+  });
+  
+  $helper->transaction( -CALLBACK => sub {
+    $helper->batch(-SQL => 'insert into meta values (?,?,?,?)', -DATA => $meta_memoize);
+  });
+  
+  my $new_count_hash = $helper->execute_into_hash(
+    -SQL => 'select meta_key, count(*) from meta group by meta_key'
+  );
+  is_deeply($new_count_hash, $meta_count_hash, 'Counts of meta keys should be the same');
+}
+
+#Doing hashref checks
+{
+  my $sql = 'select meta_key, meta_value from meta where meta_key =?';
+  my $callback = sub {
+    my ($row) = @_;
+    return { name => $row->{meta_value} };
+  };
+  my $array_of_hashes = $helper->execute(
+    -SQL => $sql,
+    -CALLBACK => $callback,
+    -USE_HASHREFS => 1,
+    -PARAMS => ['species.common_name']
+  );
+  is_deeply($array_of_hashes, [ { name => 'Human' } ], 'HashRefs in a callback works');
+}
+
+$dba->dbc()->do('alter table meta engine=MyISAM');
+done_testing();

modules/t/utilsScalar.t

+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use Bio::EnsEMBL::Utils::Scalar qw(check_ref assert_ref);
+use Bio::EnsEMBL::IdMapping::TinyGene;
+
+my $gene = Bio::EnsEMBL::IdMapping::TinyGene->new_fast([]);
+
+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';
+dies_ok { assert_ref(\'', 'ARRAY') } 'Ref of a Scalar is not an ARRAY so death';
+dies_ok { assert_ref($gene, 'CODE') } 'TinyGene object is not a CODE so death';
+dies_ok { assert_ref($gene, 'Bio::EnsEMBL::Feature') } 'TinyGene object is not a Bio::EnsEMBL::Feature so death';
+dies_ok { assert_ref($gene, 'HASH') }  'TinyGene is blessed so we expect false even though it is a HASH';
+
+lives_ok { assert_ref(\'', 'SCALAR') } 'Ref of a Scalar should be a SCALAR';
+lives_ok { assert_ref([], 'ARRAY') } 'Ref of an array should be a ARRAY';
+lives_ok { assert_ref({}, 'HASH') } 'Ref of a hash should be a HASH';
+lives_ok { assert_ref($gene, 'Bio::EnsEMBL::IdMapping::TinyFeature') } 'Ref of a gene should be a TinyFeature';
+lives_ok { assert_ref($gene, 'Bio::EnsEMBL::IdMapping::TinyGene') } 'Ref of a gene should be a TinyGene';
+
+#Now for check_ref
+
+dies_ok { check_ref([], undef) } 'Undef for assertion in check_ref results in death';
+
+ok(! check_ref(undef, 'ARRAY'), 'Undef value returns false');
+ok(! check_ref('string', 'ARRAY'), 'Passing in a Scalar means returns false');
+ok(! check_ref(\'', 'ARRAY'),  'Ref of a Scalar is not an ARRAY so returns false');
+ok(! check_ref($gene, 'CODE'),  'TinyGene object is not a CODE so returns false');
+ok(! check_ref($gene, 'Bio::EnsEMBL::Feature'),  'TinyGene object is not a Bio::EnsEMBL::Feature so returns false');
+ok(! check_ref($gene, 'HASH'),  'TinyGene is blessed so we expect false even though it is a HASH');
+
+ok ( check_ref(\'', 'SCALAR'), 'Ref of a Scalar should be a SCALAR');
+ok ( check_ref([], 'ARRAY'), 'Ref of an array should be a ARRAY');
+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');
+
+done_testing();