Raw content of Bio::EnsEMBL::Funcgen::DBSQL::ExperimentAdaptor
<![CDATA[#
# Ensembl module for Bio::EnsEMBL::Funcgen::DBSQL::ExperimentAdaptor
#
# You may distribute this module under the same terms as Perl itself
=head1 NAME
Bio::EnsEMBL::Funcgen::DBSQL::ExperimentAdaptor - A database adaptor for fetching and
storing Funcgen Experiment objects.
=head1 SYNOPSIS
my $exp_a = $db->get_ExperimentAdaptor();
my $exp = $exp_a->fetch_by_name($name);
=head1 DESCRIPTION
The ExperimentAdaptor is a database adaptor for storing and retrieving
Funcgen Experiment objects.
=head1 AUTHOR
This module was created by Nathan Johnson.
This module is part of the Ensembl project: /
=head1 CONTACT
Post comments or questions to the Ensembl development list: ensembl-dev@ebi.ac.uk
=head1 METHODS
=cut
use strict;
use warnings;
package Bio::EnsEMBL::Funcgen::DBSQL::ExperimentAdaptor;
use Bio::EnsEMBL::Utils::Exception qw( throw warning );
use Bio::EnsEMBL::Funcgen::Experiment;
use Bio::EnsEMBL::Funcgen::DBSQL::BaseAdaptor;
use vars qw(@ISA);
#May need to our this?
@ISA = qw(Bio::EnsEMBL::Funcgen::DBSQL::BaseAdaptor);
=head2 fetch_all_by_group
Arg [1] : int - dbID of array_chip
Example : my $array = $oaa->fetch_by_array_chip_dbID($ac_dbid);
Description: Retrieves a named Array object from the database.
Returntype : listref of Bio::EnsEMBL::Funcgen::Experiment objects
Exceptions : None
Caller : General
Status : At risk
=cut
sub fetch_all_by_group {
my $self = shift;
throw("Not yet implemented");
my $ac_dbid = shift;
my $sth = $self->prepare("
SELECT a.array_id
FROM array a, array_chip ac
WHERE a.array_id = ac.array_id
AND ac.array_chip_id = $ac_dbid
");
$sth->execute();
my ($array_id) = $sth->fetchrow();
return $self->fetch_by_dbID($array_id);
}
=head2 fetch_by_name
Arg [1] : string - name of an Experiment
Example : my $exp = $exp_a->fetch_by_name('Exp-1');
Description: Retrieves a named Experiment object from the database.
Returntype : Bio::EnsEMBL::Funcgen::Experiment
Exceptions : Throws if no name defined or if more than one returned
Caller : General
Status : At Risk -replace with fetch_all_by_name and fetch_by_name_group
=cut
sub fetch_by_name {
my $self = shift;
my $name = shift;
throw("Need to specify and experiment name argument") if (! defined $name);
my $result = $self->generic_fetch("e.name = '$name'");
if (scalar @$result > 1) {
throw("Experiment $name is not unique in the database, but only one result has been returned");
#should have unique key of group_id and experiment_name
}
return $result->[0];
}
=head2 get_all_experiment_names
Arg [1] : (optional) boolean - flag to denote whether experiment is flagged for web display
Example : my @names = @{$exp_a->get_all_experiment_names()};
Description: Retrieves names of all experiments.
Returntype : ARRAYREF
Exceptions : none
Caller : General
Status : At Risk -rename fetch?
=cut
sub get_all_experiment_names{
my ($self, $displayable) = @_;
my ($constraint);
my $sql = "SELECT e.name FROM experiment e";
my @names = map $_ = "@$_", @{$self->db->dbc->db_handle->selectall_arrayref($sql)};
$sql .= ", status s WHERE e.experiment_id =\"s.table_id\" AND s.table_name=\"experiment\" AND s.state=\"DISPLAYABLE\"" if($displayable);
#can we do return [map $_ = "@$_", @{$self->db->dbc->db_handle->selectall_arrayref($sql)}];
return \@names;
}
#fetch_by_name_group
#=head2 fetch_all_by_design_type
#
# Arg [1] : List of strings - type(s) (e.g. AFFY or OLIGO)
# Example : my @arrays = @{$oaa->fetch_all_by_type('OLIGO')};
# Description: Fetch all arrays of a particular type.
# Returntype : Listref of Bio::EnsEMBL::Funcgen::Array objects
# Exceptions : Throws if no type is provided
# Caller : General
# Status : Medium Risk
#=cut
#sub fetch_all_by_design_type {
# my ($self, @types) = @_;
# throw('Need type as parameter') if !@types;
# my $constraint;
# if (scalar @types == 1) {
# $constraint = qq( oa.type = '$types[0]' );
# } else {
# $constraint = join q(','), @types;
# $constraint = qq( oa.type IN ('$constraint') );
# }
# return $self->generic_fetch($constraint);
#}
=head2 fetch_attributes
Arg [1] : Bio::EnsEMBL::Funcgen::Experiment - array to fetch attributes for
Example : None
Description: This function is solely intended to lazy load attributes into
empty Experiment objects. You should not need to call this.
Returntype : None
Exceptions : None
Caller : Bio::EnsEMBL::Funcgen::Experiment getters
Status : Medium Risk
=cut
sub fetch_attributes {
my $self = shift;
my $array = shift;
my $tmp_array = $self->fetch_by_dbID( $array->dbID() );
%$array = %$tmp_array;
}
=head2 _tables
Args : None
Example : None
Description: PROTECTED implementation of superclass abstract method.
Returns the names and aliases of the tables to use for queries.
Returntype : List of listrefs of strings
Exceptions : None
Caller : Internal
Status : At risk
=cut
sub _tables {
my $self = shift;
#should we add group, target, design_type, experimental_variable?
return ['experiment', 'e'];
}
=head2 _columns
Args : None
Example : None
Description: PROTECTED implementation of superclass abstract method.
Returns a list of columns to use for queries.
Returntype : List of strings
Exceptions : None
Caller : Internal
Status : At Risk
=cut
sub _columns {
my $self = shift;
return qw( e.experiment_id e.name e.experimental_group_id e.date e.primary_design_type e.description e.mage_xml_id);
}
=head2 _objs_from_sth
Arg [1] : DBI statement handle object
Example : None
Description: PROTECTED implementation of superclass abstract method.
Creates Array objects from an executed DBI statement
handle.
Returntype : Listref of Bio::EnsEMBL::Funcgen::Experiment objects
Exceptions : None
Caller : Internal
Status : At Risk
=cut
sub _objs_from_sth {
my ($self, $sth) = @_;
my (@result, $exp_id, $name, $group_id, $p_design_type, $date, $description, $xml_id);
$sth->bind_columns(\$exp_id, \$name, \$group_id, \$date, \$p_design_type, \$description, \$xml_id);
while ( $sth->fetch() ) {
my $exp = Bio::EnsEMBL::Funcgen::Experiment->new(
-DBID => $exp_id,
-ADAPTOR => $self,
-NAME => $name,
-GROUP_ID => $group_id,
-DATE => $date,
-PRIMARY_DESIGN_TYPE => $p_design_type,
-DESCRIPTION => $description,
-MAGE_XML_ID => $xml_id,
);
push @result, $exp;
}
return \@result;
}
=head2 store
Args : List of Bio::EnsEMBL::Funcgen::Experiment objects
Example : $oaa->store($exp1, $exp2, $exp3);
Description: Stores given Experiment objects in the database.
Returntype : ARRAYREF of Bio::EnsEMBL::Funcgen::Experiment objects
Exceptions : Throws is group not present in DB
Throws if object is not a Bio::EnsEMBL::Funcgen::Experiment
Throws if object is already present in the DB but has no dbID
Caller : General
Status : At Risk
=cut
sub store {
my $self = shift;
my @args = @_;
my ($s_exp);
my $sth = $self->prepare('INSERT INTO experiment
(name, experimental_group_id, date, primary_design_type, description, mage_xml_id)
VALUES (?, ?, ?, ?, ?, ?)');
foreach my $exp (@args) {
throw('Can only store Experiment objects') if ( ! $exp->isa('Bio::EnsEMBL::Funcgen::Experiment'));
if (!( $exp->dbID() && $exp->adaptor() == $self )){
my ($g_dbid) = $self->db->fetch_group_details($exp->group());
throw("Group specified does, not exist. Use Importer(group, location, contact)") if(! $g_dbid);
$s_exp = $self->fetch_by_name($exp->name());#validate on group too!
throw("Experimental already exists in the database with dbID:".$s_exp->dbID().
"\nTo reuse/update this Experimental you must retrieve it using the ExperimentalAdaptor".
"\nMaybe you want to use the -recover option?") if $s_exp;
$exp = $self->update_mage_xml_by_Experiment($exp) if(defined $exp->mage_xml());
$sth->bind_param(1, $exp->name(), SQL_VARCHAR);
$sth->bind_param(2, $g_dbid, SQL_INTEGER);
$sth->bind_param(3, $exp->date(), SQL_VARCHAR);#date?
$sth->bind_param(4, $exp->primary_design_type(), SQL_VARCHAR);
$sth->bind_param(5, $exp->description(), SQL_VARCHAR);
$sth->bind_param(6, $exp->mage_xml_id(), SQL_INTEGER);
$sth->execute();
$exp->dbID($sth->{'mysql_insertid'});
$exp->adaptor($self);
#do we need to set egroup, target, design_type, experimentall_variable here?
#}
#else{
# warn("Experiment already exists in DB, using previously stored Experiment\n");
# $exp = $s_exp;
#}
}else{
#assume we want to update the states
warn('You may want to use $exp->adaptor->store_states($exp)');
$self->store_states($exp);
}
}
return \@args;
}
=head2 fetch_mage_xml_by_Experiment
Args : Bio::EnsEMBL::Funcgen::Experiment
Example : my $xml = $exp_adaptor->fetch_mage_xml_by_Experiment($exp);
Description: Gets the MAGE XML for this experiment
Returntype : string
Exceptions : throws if arg is not a valid stored Experiment
Caller : general
Status : at Risk
=cut
sub fetch_mage_xml_by_Experiment{
my ($self, $exp) = @_;
if(!($exp and $exp->isa('Bio::EnsEMBL::Funcgen::Experiment') && $exp->dbID())){
throw('You must provide a valid stored Bio::EnsEMBL::Funcgen::Experiment');
}
return if ! $exp->mage_xml_id();
my $sql = 'SELECT xml FROM mage_xml WHERE mage_xml_id='.$exp->mage_xml_id;
return $self->db->dbc->db_handle->selectall_arrayref($sql)->[0];
}
=head2 fetch_mage_xml_by_experiment_name
Args :
Example : my $xml = $exp_adaptor->fetch_mage_xml_by_Experiment($exp);
Description: Gets the MAGE XML for this experiment
Returntype : string
Exceptions : throws if no arg passed
Caller : general
Status : at Risk
=cut
sub fetch_mage_xml_by_experiment_name{
my ($self, $exp_name) = @_;
if(! defined $exp_name){
throw('You must provide an Experiment name argument');
}
my $sql = 'SELECT mx.xml FROM mage_xml mx, experiment e WHERE e.name="'.$exp_name.'" and e.mage_xml_id=mx.mage_xml_id';
return $self->db->dbc->db_handle->selectall_arrayref($sql)->[0];
}
=head2 update_mage_xml_by_Experiment
Args : Bio::EnsEMBL::Funcgen::Experiment
Example : my $xml = $exp_adaptor->fetch_mage_xml_by_Experiment($exp);
Description: Gets the MAGE XML for this experiment
Returntype : string
Exceptions : throws if arg is not a valid stored Experiment
Caller : general
Status : at Risk
=cut
sub update_mage_xml_by_Experiment{
my ($self, $exp) = @_;
if(!($exp and $exp->isa('Bio::EnsEMBL::Funcgen::Experiment'))){
throw('You must provide a valid Bio::EnsEMBL::Funcgen::Experiment');
}
if($exp->mage_xml_id()){
#potentially calling dbID on a un-stored obj, implicit that it
warn('Overwriting mage_xml entry for Experiment: '.$exp->name);
my $sql = "UPDATE mage_xml set xml='".$exp->mage_xml()."'";
$self->db->dbc->do($sql);
}else{
my $sql = "INSERT INTO mage_xml (xml) VALUES('".$exp->mage_xml()."')";
#need to get a statement handle to retrieve insert id
my $sth = $self->prepare($sql);
$sth->execute();
$exp->mage_xml_id($sth->{'mysql_insertid'});
$sql = "UPDATE experiment set mage_xml_id=".$exp->mage_xml_id()." where experiment_id =".$exp->dbID();
$sth = $self->prepare($sql);
$sth->execute();
}
return $exp;
}
=head2 list_dbIDs
Args : None
Example : my @exp_ids = @{$exp_a->list_dbIDs()};
Description: Gets an array of internal IDs for all Experiment objects in the
current database.
Returntype : List of ints
Exceptions : None
Caller : ?
Status : Medium Risk
=cut
sub list_dbIDs {
my ($self) = @_;
return $self->_list_dbIDs('experiment');
}
#Need to add lazy load methods
#experimental_variables
#group
1;
]]>