Commit 4d6a67b7 authored by Andreas Kusalananda Kähäri's avatar Andreas Kusalananda Kähäri
Browse files

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)
parent 42177453
......@@ -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;
......
......@@ -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
......
......@@ -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
......
......@@ -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();
......
......@@ -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);
......
......@@ -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
......
......@@ -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);
......
......@@ -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;
......@@ -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