Merge multispecies-core-dev development branch into HEAD.

Using this code on databases not patched up to the v51 schema will fail.

A pre-merge tag was put in place just before this merge:

  pre-multispecies-merge (in ensembl/modules/Bio/EnsEMBL)

modules/Bio/EnsEMBL/DBSQL/AffyArrayAdaptor.pm

@@ -110,8 +110,11 @@ sub _objs_from_sth {
 
   Args       : None
   Example    : my @array_ids = @{$aaa->list_dbIDs()};
-  Description: Gets an array of internal IDs for all AffyArray objects in the
-               current database.
+  Description: Gets an array of internal IDs for all AffyArray objects
+               in the current database.  NOTE: In a multi-species
+               database, this method will return the dbIDs of all
+               AffyArray objects, not just the ones associated with the
+               current species.
   Returntype : List of ints
   Exceptions : None
   Caller     : ?
@@ -126,7 +129,12 @@ sub list_dbIDs {
 	# Can't use _list_dbIDs because only want OligoArray objects of type AFFY
 	
 	my @out;
+
+        # FIXME: This SQL will not work as expected on multi-species
+        # databases.  It needs to be anchored in a coord_system entry
+        # coord_system.species_id = $self->species_id(). /ak4@2008-07-15
 	my $sql = "SELECT oligo_array_id  FROM oligo_array WHERE type='AFFY'";
+
 	my $sth = $self->prepare($sql);
 	$sth->execute;
 	

modules/Bio/EnsEMBL/DBSQL/AffyFeatureAdaptor.pm

@@ -112,8 +112,11 @@ sub _new_fast {
 
   Args       : None
   Example    : my @feature_ids = @{$afa->list_dbIDs()};
-  Description: Gets an array of internal IDs for all AffyFeature objects in
-               the current database.
+  Description: Gets an array of internal IDs for all AffyFeature objects
+               in the current database.  NOTE: In a multi-species
+               database, this method will return the dbIDs of all
+               AffyFeature objects, not just the ones associated with
+               the current species.
   Returntype : List of ints
   Exceptions : None
   Caller     : ?
@@ -128,6 +131,10 @@ sub list_dbIDs {
 	# Can't use _list_dbIDs because only want OligoProbe objects on arrays of type AFFY
 	
 	my @out;
+
+        # FIXME: This SQL will not work as expected on multi-species
+        # databases.  It needs to be anchored in a coord_system entry
+        # coord_system.species_id = $self->species_id(). /ak4@2008-07-15
 	my $sql = "
 		SELECT DISTINCT of.oligo_feature_id
 		FROM   oligo_feature of, oligo_probe op, oligo_array oa

modules/Bio/EnsEMBL/DBSQL/AffyProbeAdaptor.pm

@@ -158,8 +158,11 @@ sub _objs_from_sth {
 
   Arg [1]    : none
   Example    : my @probe_ids = @{$apa->list_dbIDs()};
-  Description: Gets an array of internal IDs for all AffyProbe objects in the
-               current database.
+  Description: Gets an array of internal IDs for all AffyProbe objects
+               in the current database.  NOTE: In a multi-species
+               database, this method will return the dbIDs of all
+               AffyProbe objects, not just the ones associated with
+               the current species.
   Returntype : List of ints
   Exceptions : None
   Caller     : ?
@@ -174,6 +177,10 @@ sub list_dbIDs {
 	# Can't use _list_dbIDs because only want OligoProbe objects on arrays of type AFFY
 	
 	my @out;
+
+        # FIXME: This SQL will not work as expected on multi-species
+        # databases.  It needs to be anchored in a coord_system entry
+        # coord_system.species_id = $self->species_id(). /ak4@2008-07-15
 	my $sql = "
 		SELECT DISTINCT op.oligo_probe_id
 		FROM   oligo_probe op, oligo_array oa

modules/Bio/EnsEMBL/DBSQL/AssemblyExceptionFeatureAdaptor.pm

@@ -97,11 +97,26 @@ sub fetch_all {
     return $self->{'_aexc_cache'};
   }
 
-  my $sth = $self->prepare
-    ("SELECT assembly_exception_id, seq_region_id, seq_region_start,
-             seq_region_end, exc_type, exc_seq_region_id, exc_seq_region_start,
-             exc_seq_region_end, ori
-      FROM assembly_exception");
+  my $statement = qq(
+  SELECT    ae.assembly_exception_id,
+            ae.seq_region_id,
+            ae.seq_region_start,
+            ae.seq_region_end,
+            ae.exc_type,
+            ae.exc_seq_region_id,
+            ae.exc_seq_region_start,
+            ae.exc_seq_region_end,
+            ae.ori
+  FROM      assembly_exception ae,
+            coord_system cs,
+            seq_region sr
+  WHERE     cs.species_id = ?
+    AND     sr.coord_system_id = cs.coord_system_id
+    AND     sr.seq_region_id = ae.seq_region_id);
+
+  my $sth = $self->prepare($statement);
+
+  $sth->bind_param( 1, $self->species_id(), SQL_INTEGER );
 
   $sth->execute();
 

modules/Bio/EnsEMBL/DBSQL/AssemblyMapperAdaptor.pm

@@ -134,14 +134,22 @@ sub cache_seq_ids_with_mult_assemblys{
 
   $self->{'multi_seq_ids'} = {};
 
-  my $sql=(<<SQL);  
-    SELECT seq_region_id 
-      FROM seq_region_attrib sra, attrib_type at
-	WHERE sra.attrib_type_id = at.attrib_type_id and code = "MultAssem"
-SQL
+  my $sql = qq(
+  SELECT    sra.seq_region_id
+  FROM      seq_region_attrib sra,
+            attrib_type at,
+            seq_region sr,
+            coord_system cs
+  WHERE     sra.attrib_type_id = at.attrib_type_id
+    AND     code = "MultAssem"
+    AND     sra.seq_region_id = sr.seq_region_id
+    AND     sr.coord_system_id = cs.coord_system_id
+    AND     cs.species_id = ?);
 
   my $sth = $self->prepare($sql);
 
+  $sth->bind_param( 1, $self->species_id(), SQL_INTEGER );
+
   $sth->execute();
 
   my ($seq_region_id);

modules/Bio/EnsEMBL/DBSQL/BaseAdaptor.pm

@@ -114,29 +114,27 @@ use DBI qw(:sql_types);
 =cut
 
 sub new {
-  my ($class,$dbobj) = @_;
-  
-  my $self = {};
-  bless $self,$class;
-  
-  if( !defined $dbobj || !ref $dbobj ) {
+  my ( $class, $dbobj ) = @_;
+
+  my $self = bless {}, $class;
+
+  if ( !defined $dbobj || !ref $dbobj ) {
     throw("Don't have a db [$dbobj] for new adaptor");
   }
-  if($dbobj->isa('Bio::EnsEMBL::DBSQL::DBAdaptor')){
+
+  if ( $dbobj->isa('Bio::EnsEMBL::DBSQL::DBAdaptor') ) {
     $self->db($dbobj);
-    $self->dbc($dbobj->dbc);
-  }
-  elsif( ref($dbobj) =~ /DBAdaptor$/){
+    $self->dbc( $dbobj->dbc );
+    $self->species_id( $dbobj->species_id() );
+  } elsif ( ref($dbobj) =~ /DBAdaptor$/ ) {
     $self->db($dbobj);
-    $self->dbc($dbobj->dbc);
-  }
-  elsif( ref($dbobj) =~ /DBConnection$/){
-    $self->dbc($dbobj);    
-  }
-  else{
+    $self->dbc( $dbobj->dbc );
+  } elsif ( ref($dbobj) =~ /DBConnection$/ ) {
+    $self->dbc($dbobj);
+  } else {
     throw("Don't have a DBAdaptor [$dbobj] for new adaptor");
   }
-  
+
   return $self;
 }
 
@@ -175,17 +173,19 @@ sub prepare{
                using.
   Returntype : Bio::EnsEMBL::DBSQL::DBAdaptor
   Exceptions : none
-  Caller     : Adaptors inherited fro BaseAdaptor
+  Caller     : Adaptors inherited from BaseAdaptor
   Status     : Stable
 
 =cut
 
-sub db{
-  my $self = shift;
-  $self->{'db'} = shift if(@_);
+sub db {
+  my ( $self, $value ) = @_;
 
-  return $self->{'db'};
+  if ( defined($value) ) {
+    $self->{'db'} = $value;
+  }
 
+  return $self->{'db'};
 }
 
 =head2 dbc
@@ -197,18 +197,45 @@ sub db{
                using.
   Returntype : Bio::EnsEMBL::DBSQL::DBConnection
   Exceptions : none
-  Caller     : Adaptors inherited fro BaseAdaptor
+  Caller     : Adaptors inherited from BaseAdaptor
   Status     : Stable
 
 =cut
 
-sub dbc{
-  my $self = shift;
-  $self->{'dbc'} = shift if(@_);
+sub dbc {
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'dbc'} = $value;
+  }
 
   return $self->{'dbc'};
 }
 
+=head2 species_id
+
+  Arg [1]    : (optional) int $species_id
+               The internal ID of the species in a multi-species database.
+  Example    : $db = $adaptor->db();
+  Description: Getter/Setter for the internal ID of the species in a
+               multi-species database.  The default species ID is 1.
+  Returntype : Integer
+  Exceptions : none
+  Caller     : Adaptors inherited from BaseAdaptor
+  Status     : Stable
+
+=cut
+
+sub species_id {
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'species_id'} = $value;
+  }
+
+  return $self->{'species_id'} || 1;
+}
+
 
 # list primary keys for a particular table
 # args are table name and primary key field

modules/Bio/EnsEMBL/DBSQL/BaseFeatureAdaptor.pm

@@ -919,12 +919,20 @@ sub _list_seq_region_ids {
   my @out;
   
   my $sql = qq(
-    SELECT distinct(sr.seq_region_id)
-    FROM seq_region sr, $table a
-    WHERE sr.seq_region_id = a.seq_region_id
-  );
+  SELECT DISTINCT
+            sr.seq_region_id
+  FROM      seq_region sr,
+            $table a,
+            coord_system cs
+  WHERE     sr.seq_region_id = a.seq_region_id
+    AND     sr.coord_system_id = cs.coord_system_id
+    AND     cs.species_id = ?);
+
   my $sth = $self->prepare($sql);
-  $sth->execute;
+
+  $sth->bin_param( 1, $self->species_id(), SQL_INTEGER );
+
+  $sth->execute();
 
   while (my ($id) = $sth->fetchrow) {
     push(@out, $id);

modules/Bio/EnsEMBL/DBSQL/BaseMetaContainer.pm

@@ -88,27 +88,48 @@ sub get_schema_version {
 =cut
 
 sub list_value_by_key {
-  my ($self,$key) = @_;
-  my @result;
+  my ( $self, $key ) = @_;
 
   $self->{'cache'} ||= {};
-  if( exists $self->{'cache'}->{$key} ) {
+
+  if ( exists $self->{'cache'}->{$key} ) {
     return $self->{'cache'}->{$key};
   }
 
-  my $sth = $self->prepare( "SELECT meta_value 
-                             FROM meta 
-                             WHERE meta_key = ? ORDER BY meta_id" );
-  $sth->execute( $key );
-  while( my $arrRef = $sth->fetchrow_arrayref() ) {
+  my $sth;
+  if ( !$self->_species_specific_key($key) ) {
+    $sth =
+      $self->prepare(   "SELECT meta_value "
+                      . "FROM meta "
+                      . "WHERE meta_key = ? "
+                      . "AND species_id IS NULL "
+                      . "ORDER BY meta_id" );
+
+    $sth->bind_param( 1, $key, SQL_VARCHAR );
+    $sth->execute();
+  } else {
+    $sth =
+      $self->prepare(   "SELECT meta_value "
+                      . "FROM meta "
+                      . "WHERE meta_key = ? "
+                      . "AND species_id = ? "
+                      . "ORDER BY meta_id" );
+
+    $sth->bind_param( 1, $key, SQL_VARCHAR );
+    $sth->bind_param( 2, $self->species_id(), SQL_INTEGER );
+    $sth->execute();
+  }
+
+  my @result;
+  while ( my $arrRef = $sth->fetchrow_arrayref() ) {
     push( @result, $arrRef->[0] );
   }
+
   $sth->finish();
   $self->{'cache'}->{$key} = \@result;
 
   return \@result;
-}
-
+} ## end sub list_value_by_key
 
 =head2 store_key_value
 
@@ -128,22 +149,36 @@ sub list_value_by_key {
 sub store_key_value {
   my ( $self, $key, $value ) = @_;
 
-  if ($self->key_value_exists($key, $value)) {
-    warn("Key/value pair $key/$value already exists in the meta table; not storing duplicate");
+  if ( $self->key_value_exists( $key, $value ) ) {
+    warn(   "Key-value pair '$key'-'$value' "
+          . "already exists in the meta table; "
+          . "not storing duplicate" );
     return;
   }
 
-  my $sth = $self->prepare( "INSERT INTO meta( meta_key, meta_value)
-                             VALUES( ?, ? )" );
+  if ( !$self->_species_specific_key($key) ) {
+    my $sth = $self->prepare(
+                  'INSERT INTO meta (species_id, meta_key, meta_value) '
+                    . 'VALUES(\N, ?, ?)' );
 
-  my $res = $sth->execute( $key, $value );
+    $sth->bind_param( 1, $key,   SQL_VARCHAR );
+    $sth->bind_param( 2, $value, SQL_VARCHAR );
+    $sth->execute();
+  } else {
+    my $sth = $self->prepare(
+                  'INSERT INTO meta (species_id, meta_key, meta_value) '
+                    . 'VALUES (?, ?, ?)' );
+
+    $sth->bind_param( 1, $self->species_id(), SQL_INTEGER );
+    $sth->bind_param( 2, $key,                SQL_VARCHAR );
+    $sth->bind_param( 3, $value,              SQL_VARCHAR );
+    $sth->execute();
+  }
 
   $self->{'cache'} ||= {};
 
   delete $self->{'cache'}->{$key};
-
-  return;
-}
+} ## end sub store_key_value
 
 =head2 update_key_value
 
@@ -163,11 +198,28 @@ sub store_key_value {
 sub update_key_value {
   my ( $self, $key, $value ) = @_;
 
-  my $sth = $self->prepare( "UPDATE meta SET meta_value = ? WHERE meta_key = ?" );
+  if ( !$self->_species_specific_key($key) ) {
+    my $sth =
+      $self->prepare(   'UPDATE meta SET meta_value = ? '
+                      . 'WHERE meta_key = ?'
+                      . 'AND species_id IS NULL' );
 
-  my $res = $sth->execute( $value, $key );
-  return;
-}
+    $sth->bind_param( 1, $value, SQL_VARCHAR );
+    $sth->bind_param( 2, $key,   SQL_VARCHAR );
+    $sth->execute();
+  } else {
+    my $sth =
+      $self->prepare(   'UPDATE meta '
+                      . 'SET meta_value = ? '
+                      . 'WHERE meta_key = ? '
+                      . 'AND species_id = ?' );
+
+    $sth->bind_param( 1, $value,              SQL_VARCHAR );
+    $sth->bind_param( 2, $key,                SQL_VARCHAR );
+    $sth->bind_param( 3, $self->species_id(), SQL_INTEGER );
+    $sth->execute();
+  }
+} ## end sub update_key_value
 
 
 =head2 delete_key
@@ -185,15 +237,28 @@ sub update_key_value {
 =cut
 
 sub delete_key {
-  my ($self, $key) = @_;
+  my ( $self, $key ) = @_;
 
-  my $sth = $self->prepare("DELETE FROM meta WHERE meta_key = ?");
-  $sth->execute($key);
-  $sth->finish();
+  if ( !$self->_species_specific_key($key) ) {
+    my $sth =
+      $self->prepare(   'DELETE FROM meta '
+                      . 'WHERE meta_key = ?'
+                      . 'AND species_id IS NULL' );
 
-  delete $self->{'cache'}->{$key};
+    $sth->bin_param( 1, $key, SQL_VARCHAR );
+    $sth->execute();
+  } else {
+    my $sth =
+      $self->prepare(   'DELETE FROM meta '
+                      . 'WHERE meta_key = ? '
+                      . 'AND species_id = ?' );
+
+    $sth->bin_param( 1, $key, SQL_VARCHAR );
+    $sth->bin_param( 2, $self->species_id(), SQL_INTEGER );
+    $sth->execute();
+  }
 
-  return;
+  delete $self->{'cache'}->{$key};
 }
 
 =head2 delete_key_value
@@ -213,16 +278,33 @@ sub delete_key {
 =cut
 
 sub delete_key_value {
-  my ($self, $key, $value) = @_;
+  my ( $self, $key, $value ) = @_;
 
-  my $sth = $self->prepare("DELETE FROM meta WHERE meta_key = ? AND meta_value = ?");
-  $sth->execute($key, $value);
-  $sth->finish();
+  if ( !$self->_species_specific_key($key) ) {
+    my $sth =
+      $self->prepare(   'DELETE FROM meta '
+                      . 'WHERE meta_key = ? '
+                      . 'AND meta_value = ?'
+                      . 'AND species_id IS NULL' );
 
-  delete $self->{'cache'}->{$key};
+    $sth->bin_param( 1, $key,   SQL_VARCHAR );
+    $sth->bin_param( 2, $value, SQL_VARCHAR );
+    $sth->execute();
+  } else {
+    my $sth =
+      $self->prepare(   'DELETE FROM meta '
+                      . 'WHERE meta_key = ? '
+                      . 'AND meta_value = ? '
+                      . 'AND species_id = ?' );
+
+    $sth->bin_param( 1, $key,                SQL_VARCHAR );
+    $sth->bin_param( 2, $value,              SQL_VARCHAR );
+    $sth->bin_param( 3, $self->species_id(), SQL_INTEGER );
+    $sth->execute();
+  }
 
-  return;
-}
+  delete $self->{'cache'}->{$key};
+} ## end sub delete_key_value
 
 =head2 key_value_exists
 
@@ -231,7 +313,8 @@ sub delete_key_value {
   Arg [2]    : string $value
                the value to check
   Example    : if ($meta_container->key_value_exists($key, $value)) ...
-  Description: Return true if a particular key/value pair exists, undef otherwise
+  Description: Return true (1) if a particular key/value pair exists,
+               false (0) otherwise.
   Returntype : boolean
   Exceptions : none
   Caller     : ?
@@ -240,20 +323,51 @@ sub delete_key_value {
 =cut
 
 sub key_value_exists {
+  my ( $self, $key, $value ) = @_;
 
-  my ($self, $key, $value) = @_;
-
-  my $sth = $self->prepare( "SELECT meta_value FROM meta WHERE meta_key = ? AND meta_value = ?" );
-  $sth->execute($key, $value);
+  my $sth;
+  if ( !$self->_species_specific_key($key) ) {
+    $sth =
+      $self->prepare(   'SELECT meta_value '
+                      . 'FROM meta '
+                      . 'WHERE meta_key = ? '
+                      . 'AND meta_value = ?'
+                      . 'AND species_id IS NULL' );
+
+    $sth->bin_param( 1, $key,   SQL_VARCHAR );
+    $sth->bin_param( 2, $value, SQL_VARCHAR );
+    $sth->execute();
+  } else {
+    $sth =
+      $self->prepare(   'SELECT meta_value '
+                      . 'FROM meta '
+                      . 'WHERE meta_key = ? '
+                      . 'AND meta_value = ? '
+                      . 'AND species_id = ?' );
+
+    $sth->bin_param( 1, $key,                SQL_VARCHAR );
+    $sth->bin_param( 2, $value,              SQL_VARCHAR );
+    $sth->bin_param( 3, $self->species_id(), SQL_INTEGER );
+    $sth->execute();
+  }
 
-  while( my $arrRef = $sth->fetchrow_arrayref() ) {
-    if ($arrRef->[0] eq $value) {
+  while ( my $arrRef = $sth->fetchrow_arrayref() ) {
+    if ( $arrRef->[0] eq $value ) {
       $sth->finish();
       return 1;
     }
   }
 
-  return undef;
+  return 0;
+} ## end sub key_value_exists
+
+# This utility method determines whether the key is a species-specific
+# meta key or not.  If the key is either 'patch' or 'schema_version',
+# then it is not species-specific.
+
+sub _species_specific_key {
+  my ( $self, $key ) = @_;
+  return ( $key ne 'patch' && $key ne 'schema_version' );
 }
 
 1;

modules/Bio/EnsEMBL/DBSQL/CoordSystemAdaptor.pm

@@ -126,28 +126,27 @@ use vars qw(@ISA);
 =cut
 
 sub new {
-  my $caller = shift;
+  my ( $proto, @args ) = @_;
 
-  my $class = ref($caller) || $caller;
-
-  my $self = $class->SUPER::new(@_);
+  my $class = ref($proto) || $proto;
+  my $self = $class->SUPER::new(@args);
 
   #
   # Cache the entire contents of the coord_system table cross-referenced
-  # by dbID and name
+  # by dbID and name.
   #
 
-  #keyed on name, list of coord_system value
+  # keyed on name, list of coord_system value
   $self->{'_name_cache'} = {};
 
-  #keyed on id, coord_system value
+  # keyed on id, coord_system value
   $self->{'_dbID_cache'} = {};
 
-  #keyed on rank
+  # keyed on rank
   $self->{'_rank_cache'} = {};
 
-  #keyed on id, 1/undef values