Raw content of Bio::EnsEMBL::DBSQL::BaseAdaptor
<![CDATA[=head1 LICENSE
Copyright (c) 1999-2009 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
/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
=head1 NAME
Bio::EnsEMBL::DBSQL::BaseAdaptor - Base Adaptor for DBSQL adaptors
=head1 SYNOPSIS
# base adaptor provides
# SQL prepare function
$adaptor->prepare("sql statement");
# get of root DBAdaptor object
$adaptor->db();
# constructor, ok for inheritence
$adaptor = Bio::EnsEMBL::DBSQL::SubClassOfBaseAdaptor->new($dbobj)
=head1 DESCRIPTION
This is a true base class for Adaptors in the Ensembl DBSQL
system. Original idea from Arne
Adaptors are expected to have the following functions
$obj = $adaptor->fetch_by_dbID($internal_id);
which builds the object from the primary key of the object. This
function is crucial because it allows adaptors to collaborate relatively
independently of each other - in other words, we can change the schema
under one adaptor without too many knock on changes through the other
adaptors.
Most adaptors will also have
$dbid = $adaptor->store($obj);
which stores the object. Currently the storing of an object also causes
the objects to set
$obj->dbID();
correctly and attach the adaptor.
Other fetch functions go by the convention of
@object_array = @{ $adaptor->fetch_all_by_XXXX($arguments_for_XXXX) };
sometimes it returns an array ref denoted by the 'all' in the name of
the method, sometimes an individual object. For example
$gene = $gene_adaptor->fetch_by_stable_id($stable_id);
or
@fp = @{ $simple_feature_adaptor->fetch_all_by_Slice($slice) };
Occassionally adaptors need to provide access to lists of ids. In this
case the convention is to go list_XXXX, such as
@gene_ids = @{ $gene_adaptor->list_geneIds() };
(note: this method is poorly named)
=head1 METHODS
=cut
package Bio::EnsEMBL::DBSQL::BaseAdaptor;
require Exporter;
use vars qw(@ISA @EXPORT);
use strict;
use Bio::EnsEMBL::Utils::Exception qw(throw);
use DBI qw(:sql_types);
use Data::Dumper;
@ISA = qw(Exporter);
@EXPORT = (@{$DBI::EXPORT_TAGS{'sql_types'}});
=head2 new
Arg [1] : Bio::EnsEMBL::DBSQL::DBConnection $dbobj
Example : $adaptor = new AdaptorInheritedFromBaseAdaptor($dbobj);
Description: Creates a new BaseAdaptor object. The intent is that this
constructor would be called by an inherited superclass either
automatically or through $self->SUPER::new in an overridden
new method.
Returntype : Bio::EnsEMBL::DBSQL::BaseAdaptor
Exceptions : none
Caller : Bio::EnsEMBL::DBSQL::DBConnection
Status : Stable
=cut
sub new {
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') ) {
$self->db($dbobj);
$self->dbc( $dbobj->dbc );
$self->species_id( $dbobj->species_id() );
$self->is_multispecies( $dbobj->is_multispecies() );
} elsif ( ref($dbobj) =~ /DBAdaptor$/ ) {
$self->db($dbobj);
$self->dbc( $dbobj->dbc );
} elsif ( ref($dbobj) =~ /DBConnection$/ ) {
$self->dbc($dbobj);
} else {
throw("Don't have a DBAdaptor [$dbobj] for new adaptor");
}
return $self;
}
=head2 prepare
Arg [1] : string $string
a SQL query to be prepared by this adaptors database
Example : $sth = $adaptor->prepare("select yadda from blabla")
Description: provides a DBI statement handle from the adaptor. A convenience
function so you dont have to write $adaptor->db->prepare all the
time
Returntype : DBI::StatementHandle
Exceptions : none
Caller : Adaptors inherited from BaseAdaptor
Status : Stable
=cut
sub prepare {
my ( $self, $string ) = @_;
# Uncomment next line to cancel caching on the SQL side.
# Needed for timing comparisons etc.
#$string =~ s/SELECT/SELECT SQL_NO_CACHE/i;
return $self->dbc->prepare($string);
}
=head2 db
Arg [1] : (optional) Bio::EnsEMBL::DBSQL::DBAdaptor $obj
the database this adaptor is using.
Example : $db = $adaptor->db();
Description: Getter/Setter for the DatabaseConnection that this adaptor is
using.
Returntype : Bio::EnsEMBL::DBSQL::DBAdaptor
Exceptions : none
Caller : Adaptors inherited from BaseAdaptor
Status : Stable
=cut
sub db {
my ( $self, $value ) = @_;
if ( defined($value) ) {
$self->{'db'} = $value;
}
return $self->{'db'};
}
=head2 dbc
Arg [1] : (optional) Bio::EnsEMBL::DBSQL::DBConnection $obj
the database this adaptor is using.
Example : $db = $adaptor->db();
Description: Getter/Setter for the DatabaseConnection that this adaptor is
using.
Returntype : Bio::EnsEMBL::DBSQL::DBConnection
Exceptions : none
Caller : Adaptors inherited from BaseAdaptor
Status : Stable
=cut
sub dbc {
my ( $self, $value ) = @_;
if ( defined($value) ) {
$self->{'dbc'} = $value;
}
return $self->{'dbc'};
}
=head2 is_multispecies
Arg [1] : (optional) boolean $arg
Example : if ($adaptor->is_multispecies()) { }
Description: Getter/Setter for the is_multispecies boolean of
to use for this adaptor.
Returntype : boolean
Exceptions : none
Caller : general
Status : Stable
=cut
sub is_multispecies {
my ( $self, $arg ) = @_;
if ( defined($arg) ) {
$self->{_is_multispecies} = $arg;
}
return $self->{_is_multispecies};
}
=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
# if primary key field is not supplied, tablename_id is assumed
# returns listref of IDs
sub _list_dbIDs {
my ( $self, $table, $pk, $ordered ) = @_;
if ( !defined($pk) ) { $pk = $table . "_id" }
my $sql = "SELECT " . $pk . " FROM " . $table;
if ( defined($ordered) && $ordered ) {
$sql .= " order by seq_region_id, seq_region_start";
}
my $sth = $self->prepare($sql);
$sth->execute();
my @out;
while ( my ($id) = $sth->fetchrow() ) { push( @out, $id ) }
$sth->finish();
return \@out;
}
# _straight_join
# Arg [1] : (optional) boolean $new_val
# Example : $self->_straight_join(1);
# $self->generic_fetch($constraint);
# $self->_straight_join(0);
# Description: PROTECTED Getter/Setter that turns on/off the use of
# a straight join in queries.
# Returntype : boolean
# Exceptions : none
# Caller : general
sub _straight_join {
my $self = shift;
if(@_) {
$self->{'_straight_join'} = shift;
}
return $self->{'_straight_join'};
}
=head2 bind_param_generic_fetch
Arg [1] : (optional) scalar $param
This is the parameter to bind
Arg [2] : (optional) int $sql_type
Type of the parameter (from DBI (:sql_types))
Example : $adaptor->bind_param_generic_fetch($stable_id,SQL_VARCHAR);
$adaptor->generic_fetch();
Description: When using parameters for the query, will call the bind_param to avoid
some security issues. If there are no arguments, will return the bind_parameters
ReturnType : listref
Exceptions: if called with one argument
=cut
sub bind_param_generic_fetch{
my $self = shift;
my $param = shift;
my $sql_type = shift;
if (defined $param && !defined $sql_type){
throw("Need to specify sql_type for parameter $param\n");
}
elsif (defined $param && defined $sql_type){
#both paramters have been entered, push it to the bind_param array
push @{$self->{'_bind_param_generic_fetch'}},[$param,$sql_type];
}
elsif (!defined $param && !defined $sql_type){
#when there are no arguments, return the array
return $self->{'_bind_param_generic_fetch'};
}
}
=head2 generic_fetch
Arg [1] : (optional) string $constraint
An SQL query constraint (i.e. part of the WHERE clause)
Arg [2] : (optional) Bio::EnsEMBL::AssemblyMapper $mapper
A mapper object used to remap features
as they are retrieved from the database
Arg [3] : (optional) Bio::EnsEMBL::Slice $slice
A slice that features should be remapped to
Example : $fts = $a->generic_fetch('contig_id in (1234, 1235)', 'Swall');
Description: Performs a database fetch and returns feature objects in
contig coordinates.
Returntype : listref of Bio::EnsEMBL::SeqFeature in contig coordinates
Exceptions : none
Caller : BaseFeatureAdaptor, ProxyDnaAlignFeatureAdaptor::generic_fetch
Status : Stable
=cut
sub generic_fetch {
my ($self, $constraint, $mapper, $slice) = @_;
my @tabs = $self->_tables();
my $extra_default_where;
# Hack for feature types that needs to be restricted to species_id (in
# coord_system).
if ( $self->is_multispecies()
&& $self->isa('Bio::EnsEMBL::DBSQL::BaseFeatureAdaptor')
&& !$self->isa('Bio::EnsEMBL::DBSQL::UnmappedObjectAdaptor') )
{
push @tabs, [ 'seq_region', 'sr' ], [ 'coord_system', 'cs' ];
$extra_default_where = sprintf(
'%s.seq_region_id = sr.seq_region_id '
. 'AND sr.coord_system_id = cs.coord_system_id '
. 'AND cs.species_id = ?',
$tabs[0]->[1] );
$self->bind_param_generic_fetch( $self->species_id(), SQL_INTEGER );
}
my $columns = join(', ', $self->_columns());
my $db = $self->db();
#
# Construct a left join statement if one was defined, and remove the
# left-joined table from the table list
#
my @left_join_list = $self->_left_join();
my $left_join_prefix = '';
my $left_join = '';
my @tables;
if(@left_join_list) {
my %left_join_hash = map { $_->[0] => $_->[1] } @left_join_list;
while(my $t = shift @tabs) {
if( exists $left_join_hash{ $t->[0] } ) {
my $condition = $left_join_hash{ $t->[0] };
my $syn = $t->[1];
$left_join .=
"\n LEFT JOIN " . $t->[0] . " $syn ON $condition ) ";
$left_join_prefix .= '(';
} else {
push @tables, $t;
}
}
} else {
@tables = @tabs;
}
my $straight_join = '';
if($self->_straight_join()) {
$straight_join = "STRAIGHT_JOIN";
}
#construct a nice table string like 'table1 t1, table2 t2'
my $tablenames = join(', ', map({ join(' ', @$_) } @tables));
my $sql =
"SELECT $straight_join $columns\n"
. "FROM $left_join_prefix ($tablenames) $left_join";
my $default_where = $self->_default_where_clause();
my $final_clause = $self->_final_clause;
if ($extra_default_where) {
if ($default_where) {
$default_where .= "\n AND $extra_default_where";
} else {
$default_where = $extra_default_where;
}
}
#append a where clause if it was defined
if ($constraint) {
$sql .= "\n WHERE $constraint ";
if ($default_where) {
$sql .= " AND\n $default_where ";
}
} elsif ($default_where) {
$sql .= "\n WHERE $default_where ";
}
#append additional clauses which may have been defined
$sql .= "\n$final_clause";
# FOR DEBUG:
#warn "SQL:\n$sql\n";
# printf(STDERR "SQL:\n%s\n", $sql);
my $sth = $db->dbc->prepare($sql);
my $bind_parameters = $self->bind_param_generic_fetch();
if (defined $bind_parameters){
#if we have bind the parameters, call the DBI to bind them
my $i = 1;
foreach my $param (@{$bind_parameters}){
$sth->bind_param($i,$param->[0],$param->[1]);
$i++;
}
#after binding parameters, undef for future queries
$self->{'_bind_param_generic_fetch'} = ();
}
# print STDERR $sql,"\n";
$sth->execute;
my $res = $self->_objs_from_sth($sth, $mapper, $slice);
$sth->finish();
return $res;
}
=head2 fetch_by_dbID
Arg [1] : int $id
The unique database identifier for the feature to be obtained
Example : $feat = $adaptor->fetch_by_dbID(1234));
$feat = $feat->transform('contig');
Description: Returns the feature created from the database defined by the
the id $id. The feature will be returned in its native
coordinate system. That is, the coordinate system in which it
is stored in the database. In order to convert it to a
particular coordinate system use the transfer() or transform()
method. If the feature is not found in the database then
undef is returned instead
Returntype : Bio::EnsEMBL::Feature or undef
Exceptions : thrown if $id arg is not provided
does not exist
Caller : general
Status : Stable
=cut
sub fetch_by_dbID{
my ($self,$id) = @_;
throw("id argument is required") if(!defined $id);
#construct a constraint like 't1.table1_id = 123'
my @tabs = $self->_tables;
my ($name, $syn) = @{$tabs[0]};
$self->bind_param_generic_fetch($id,SQL_INTEGER);
my $constraint = "${syn}.${name}_id = ?";
#Should only be one
my ($feat) = @{$self->generic_fetch($constraint)};
return undef if(!$feat);
return $feat;
}
=head2 fetch_all_by_dbID_list
Arg [1] : listref of integers $id_list
The unique database identifiers for the features to
be obtained.
Example : @feats = @{$adaptor->fetch_all_by_dbID_list([1234, 2131, 982]))};
Description: Returns the features created from the database
defined by the the IDs in contained in the provided
ID list $id_list. The features will be returned
in their native coordinate system. That is, the
coordinate system in which they are stored in the
database. In order to convert the features to a
particular coordinate system use the transfer() or
transform() method. If none of the features are
found in the database a reference to an empty list is
returned.
Returntype : listref of Bio::EnsEMBL::Features
Exceptions : thrown if $id arg is not provided
does not exist
Caller : general
Status : Stable
=cut
sub fetch_all_by_dbID_list {
my ( $self, $id_list_ref ) = @_;
if ( !defined($id_list_ref) || ref($id_list_ref) ne 'ARRAY' ) {
throw("id_list list reference argument is required");
}
if ( !@{$id_list_ref} ) { return [] }
# Construct a constraint like 't1.table1_id = 123'
my @tabs = $self->_tables();
my ( $name, $syn ) = @{ $tabs[0] };
# Ensure that we do not exceed MySQL's max_allowed_packet (defaults to
# 1 MB) splitting large queries into smaller queries of at most 256 KB
# (32768 8-bit characters). Assuming a (generous) average dbID string
# length of 16, this means 2048 dbIDs in each query.
my $max_size = 2048;
my @id_list = @{$id_list_ref};
my @out;
while (@id_list) {
my @ids;
my $id_str;
if ( scalar(@id_list) > $max_size ) {
@ids = splice( @id_list, 0, $max_size );
} else {
@ids = @id_list;
@id_list = ();
}
if ( scalar(@ids) > 1 ) {
$id_str = " IN (" . join( ',', @ids ) . ")";
} else {
$id_str = " = " . $ids[0];
}
my $constraint = "${syn}.${name}_id $id_str";
push @out, @{ $self->generic_fetch($constraint) };
}
return \@out;
} ## end sub fetch_all_by_dbID_list
# might not be a good idea, but for convenience
# shouldnt be called on the BIG tables though
sub fetch_all {
my $self = shift;
return $self->generic_fetch();
}
#_tables
#
# Args : none
# Example : $tablename = $self->_table_name()
# Description: ABSTRACT PROTECTED
# Subclasses are responsible for implementing this
# method. It should list of [tablename, alias] pairs.
# Additionally the primary table (with the dbID,
# analysis_id, and score) should be the first table in
# the list. e.g:
# ( ['repeat_feature', 'rf'],
# ['repeat_consensus', 'rc']);
# used to obtain features.
# Returntype : list of [tablename, alias] pairs
# Exceptions : thrown if not implemented by subclass
# Caller : BaseFeatureAdaptor::generic_fetch
#
sub _tables {
throw( "abstract method _tables not defined "
. "by implementing subclass of BaseAdaptor" );
}
#_columns
#
# Args : none
# Example : $tablename = $self->_columns()
# Description: ABSTRACT PROTECTED
# Subclasses are responsible for implementing this
# method. It should return a list of columns to be
# used for feature creation.
# Returntype : list of strings
# Exceptions : thrown if not implemented by subclass
# Caller : BaseFeatureAdaptor::generic_fetch
#
sub _columns {
throw( "abstract method _columns not defined "
. "by implementing subclass of BaseAdaptor" );
}
# _default_where_clause
#
# Arg [1] : none
# Example : none
# Description: May be overridden to provide an additional where
# constraint to the SQL query which is generated to
# fetch feature records. This constraint is always
# appended to the end of the generated where clause
# Returntype : string
# Exceptions : none
# Caller : generic_fetch
#
sub _default_where_clause { return '' }
# _left_join
# Arg [1] : none
# Example : none
# Description: Can be overridden by a subclass to specify any left
# joins which should occur. The table name specigfied
# in the join must still be present in the return
# values of.
# Returntype : a {'tablename' => 'join condition'} pair
# Exceptions : none
# Caller : general
#
sub _left_join { return () }
#_final_clause
# Arg [1] : none
# Example : none
# Description: May be overriden to provide an additional clause
# to the end of the SQL query used to fetch feature
# records. This is useful to add a required ORDER BY
# clause to the query for example.
# Returntype : string
# Exceptions : none
# Caller : generic_fetch
sub _final_clause { return '' }
#_objs_from_sth
# Arg [1] : DBI::row_hashref $hashref containing key-value pairs
# for each of the columns specified by the _columns method
# Example : my @feats = $self->_obj_from_hashref
# Description: ABSTRACT PROTECTED
# The subclass is responsible for implementing this
# method. It should take in a DBI row hash reference
# and return a list of created features in contig
# coordinates.
# Returntype : list of Bio::EnsEMBL::*Features in contig coordinates
# Exceptions : thrown if not implemented by subclass
# Caller : BaseFeatureAdaptor::generic_fetch
sub _objs_from_sth {
throw( "abstract method _objs_from_sth not defined "
. "by implementing subclass of BaseAdaptor" );
}
sub dump_data {
my $self = shift;
my $data = shift;
my $dumper = Data::Dumper->new([$data]);
$dumper->Indent(0);
$dumper->Terse(1);
my $dump = $dumper->Dump();
# $dump =~ s/'/\\'/g;
# $dump =~ s/^\$VAR1 = //;
return $dump;
}
sub get_dumped_data {
my $self = shift;
my $data = shift;
$data =~ s/\n|\r|\f|\\//g;
return eval ($data);
}
1;
]]>