Commit a2802e5f authored by Arek Icrapzych's avatar Arek Icrapzych
Browse files

DBSQL::Clone.pm split into DBSQL::CloneAdaptor and EnsEMBL::Clone

parent 6e8ce77f
......@@ -2,9 +2,9 @@
#
# BioPerl module for DB::Clone
#
# Cared for by Ewan Birney <birney@sanger.ac.uk>
# Cared for by EnsEMBL (www.ensembl.org)
#
# Copyright Ewan Birney
# Copyright GRL and EBI
#
# You may distribute this module under the same terms as perl itself
......@@ -12,7 +12,7 @@
=head1 NAME
Bio::EnsEMBL::DB::Clone - Object representing one clone
Bio::EnsEMBL::Clone - Object representing one clone
=head1 SYNOPSIS
......@@ -42,129 +42,57 @@ The rest of the documentation details each of the object methods. Internal metho
# Let the code begin...
package Bio::EnsEMBL::DBSQL::Clone;
package Bio::EnsEMBL::Clone;
use vars qw(@ISA);
use strict;
# Object preamble - inheriets from Bio::Root::Object
# Object preamble - inheriets from Bio::Root::RootI
use Bio::Root::Object;
use Bio::Root::RootI;
use Bio::EnsEMBL::DBSQL::RawContig;
use Bio::EnsEMBL::DBSQL::Feature_Obj;
use Bio::EnsEMBL::DBSQL::Gene_Obj;
use Bio::EnsEMBL::DB::CloneI;
@ISA = qw(Bio::Root::Object Bio::EnsEMBL::DB::CloneI);
@ISA = qw(Bio::Root::RootI Bio::EnsEMBL::DB::CloneI);
# new() is inherited from Bio::Root::Object
sub new {
my ($class,$adaptor,@args) = @_;
# _initialize is where the heavy stuff will happen when new is called
my $self = {};
bless $self,$class;
sub _initialize {
my($self,@args) = @_;
my $make = $self->SUPER::_initialize;
my ($internal_id,$id,$embl_id,$version,$embl_version,$htg_phase,$created,$modified, $stored)=@args;
my ($dbobj,$id) = $self->_rearrange([qw(DBOBJ
ID
)],@args);
$self->throw("Don't have a adaptor [$adaptor] for new clone") unless $adaptor;
$self->throw("Don't have a internal id [$internal_id] for new clone") unless $internal_id;
$self->throw("Don't have a id [$id] for new clone") unless $id;
$self->throw("Don't have a embl id [$embl_id] for new clone") unless $embl_id;
#$self->throw("Don't have a version [$version] for new clone") unless $version;
$self->throw("Don't have a embl verson [$embl_version] for new clone") unless $embl_version;
$self->throw("Don't have a htg phase [$htg_phase] for new clone") unless $htg_phase;
#$self->throw("Don't have a created [$created] for new clone") unless $created;
#$self->throw("Don't have a modified [$modified] for new clone") unless $modified;
#$self->throw("Don't have a stored [$stored] for new clone") unless $stored;
$id || $self->throw("Cannot make clone db object without id");
$dbobj || $self->throw("Cannot make clone db object without db object");
$dbobj->isa('Bio::EnsEMBL::DBSQL::Obj') || $self->throw("Cannot make clone db object with a $dbobj object");
$self->id($id);
$self->_db_obj($dbobj);
$self->fetch();
$self->adaptor($adaptor);
$self->dbID($internal_id);
$self->id($id);
$self->embl_id($embl_id);
$self->version($version);
$self->embl_version($embl_version);
$self->htg_phase($htg_phase);
$self->created($created);
$self->modified($modified);
$self->_stored($stored);
# set stuff in self from @args
return $make; # success - we hope!
}
=head2 fetch
Title : fetch
Usage :
Function:
Example :
Returns : nothing
Args :
=cut
sub fetch {
my ($self) = @_;
my $id=$self->id();
my $sth = $self->_db_obj->prepare("select internal_id,id from clone where id = \"$id\";");
my $res = $sth ->execute();
my $rowhash = $sth->fetchrow_hashref;
if( ! $rowhash ) {
# make sure we deallocate sth - keeps DBI happy!
$sth = 0;
$self->throw("Clone $id does not seem to occur in the database!");
}
$self->_internal_id($rowhash->{'internal_id'});
return $self;
}
=head2 delete
Title : delete
Usage : $clone->delete()
Function: Deletes clone (itself), including contigs and features, but not its genes
Example :
Returns : nothing
Args : none
=cut
sub delete {
my ($self) = @_;
#(ref($clone_id)) && $self->throw ("Passing an object reference instead of a variable\n");
my $internal_id = $self->_internal_id;
my @contigs;
my @dnas;
# get a list of contigs to zap
my $sth = $self->_db_obj->prepare("select internal_id,dna from contig where clone = $internal_id");
my $res = $sth->execute;
while( my $rowhash = $sth->fetchrow_hashref) {
push(@contigs,$rowhash->{'internal_id'});
push(@dnas,$rowhash->{'dna'});
}
# Delete from DNA table, Contig table, Clone table
foreach my $contig ( @contigs ) {
my $sth = $self->_db_obj->prepare("delete from contig where internal_id = $contig");
my $res = $sth->execute;
}
foreach my $dna (@dnas) {
$sth = $self->_db_obj->prepare("delete from dna where id = $dna");
$res = $sth->execute;
# Mysql does not optimise or statements in where clauses
$sth = $self->_db_obj->prepare("delete from contigoverlap where dna_a_id = $dna;");
$res = $sth ->execute;
$sth = $self->_db_obj->prepare("delete from contigoverlap where dna_b_id = $dna;");
$res = $sth ->execute;
}
$sth = $self->_db_obj->prepare("delete from clone where internal_id = $internal_id");
$res = $sth->execute;
}
=head2 get_all_Genes
......@@ -179,46 +107,18 @@ sub delete {
=cut
sub get_all_Genes {
my ($self, $supporting) = @_;
my @out;
my $clone_id = $self->_internal_id();
my %got;
# prepare the SQL statement
my $sth = $self->_db_obj->prepare("
SELECT t.gene
FROM transcript t,
exon_transcript et,
exon e,
contig c
WHERE e.contig = c.internal_id
AND et.exon = e.id
AND t.id = et.transcript
AND c.clone = $clone_id
");
my $res = $sth->execute();
while (my $rowhash = $sth->fetchrow_hashref) {
if( ! exists $got{$rowhash->{'gene'}}) {
my $gene_obj = Bio::EnsEMBL::DBSQL::Gene_Obj->new($self->_db_obj);
my $gene = $gene_obj->get($rowhash->{'gene'}, $supporting);
if ($gene) {
push(@out, $gene);
}
$got{$rowhash->{'gene'}} = 1;
}
}
if (@out) {
return @out;
}
return;
sub get_all_Genes
{
my ($self,$supporting)=@_;
return $self->adaptor->get_all_Genes($self->dbID,$supporting);
}
=head2 get_Contig
Title : get_Contig
......@@ -234,8 +134,7 @@ sub get_all_Genes {
sub get_Contig {
my ($self,$contigid) = @_;
# should check this contig is in this clone?
my $contig = $self->_db_obj->get_Contig($contigid);
my $contig = $self->adaptor->get_Contig($contigid);
return $contig->fetch();
}
......@@ -252,31 +151,20 @@ sub get_Contig {
=cut
sub get_all_my_geneid {
my ($self) = @_;
my $cloneid = $self->_internal_id;
my $sth = $self->_db_obj->prepare("select count(*),cont.clone ,ex.contig,tran.gene " .
"from contig as cont, ".
" transcript as tran, " .
" exon_transcript as et, " .
" exon as ex " .
"where ex.id = et.exon " .
"and tran.id = et.transcript " .
"and cont.clone = $cloneid " .
"and cont.internal_id = ex.contig " .
"group by tran.gene");
my @out;
sub get_all_my_geneid
{
my ($self)=shift;
$sth->execute;
while( my $rowhash = $sth->fetchrow_hashref) {
push(@out,$rowhash->{'gene'});
}
return @out;
return $self->adaptor->get_all_my_geneid($self->dbID);
}
=head2 get_all_Contigs
Title : get_Contigs
......@@ -289,39 +177,53 @@ sub get_all_my_geneid {
=cut
sub get_all_Contigs {
my ($self) = @_;
my $sth;
my @res;
my $internal_id = $self->_internal_id();
my $sql = "select id,internal_id from contig where clone = $internal_id";
$sth= $self->_db_obj->prepare($sql);
my $res = $sth->execute();
my $seen = 0;
my $count = 0;
my $total = 0;
my $version = $self->embl_version();
sub get_all_Contigs
{
my ($self)=shift;
return $self->adaptor->get_all_Contigs($self->dbID,$self->version);
}
sub delete
{
my ($self)=shift;
$self->warn->("delete is now deprecated, use delete_by_dbID instead");
$self->delete_by_dbID;
}
while( my $rowhash = $sth->fetchrow_hashref) {
my $contig = $self->_db_obj->get_Contig( $rowhash->{'id'});
$contig->internal_id($rowhash->{internal_id});
$contig->seq_version($version);
push(@res,$contig);
$seen = 1;
}
if( $seen == 0 ) {
$self->throw("Clone [$internal_id] has no contigs in the database. Should be impossible, but clearly isn't...");
}
return @res;
=head2 delete_by_dbID
Title : delete_by_dbID
Usage : $clone->delete_by_dbID()
Function: Deletes clone (itself), including contigs and features, but not its genes
Example :
Returns : nothing
Args : none
=cut
sub delete_by_dbID {
my ($self)=shift;
return $self->adaptor->delete_by_dbID($self->dbID);
}
=head2 get_all_RawContigs
=head2 get_all_rawcontigs_by_position
Title : get_rawcontig_by_position
Usage : $obj->get_rawcontig_by_position($position)
......@@ -411,6 +313,45 @@ sub is_golden{
}
=head2 seq_date
Title : seq_date
Usage : $clone->seq_date()
Function: loops over all $contig->seq_date, throws a warning if they are different and
returns the first unix time value of the dna created datetime field, which indicates
the original time of the dna sequence data
Example : $clone->seq_date()
Returns : unix time
Args : none
=cut
sub seq_date {
my ($self) = @_;
my $id = $self->id();
my ($seq_date,$old_seq_date);
foreach my $contig ($self->get_all_Contigs) {
$seq_date = $contig->seq_date;
if ($old_seq_date) {
if ($seq_date != $old_seq_date) {
$self->warn ("The created date of the DNA sequence from contig
$contig is different from that of the sequence
from other contigs on the same clone!");
}
}
$old_seq_date = $seq_date;
}
return $seq_date;
}
=head2 htg_phase
Title : htg_phase
......@@ -424,18 +365,12 @@ sub is_golden{
=cut
sub htg_phase {
my $self = shift;
if( defined $self->{'_htg_phase'} ) {
return $self->{'_htg_phase'};
}
my $internal_id = $self->_internal_id();
my $sth = $self->_db_obj->prepare("select htg_phase from clone where internal_id = $internal_id");
$sth->execute();
my $rowhash = $sth->fetchrow_hashref();
$self->{'_htg_phase'} = $rowhash->{'htg_phase'};
return $self->{'_htg_phase'};
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'htg_phase'} = $value;
}
return $obj->{'htg_phase'};
}
=head2 created
......@@ -452,14 +387,12 @@ sub htg_phase {
=cut
sub created {
my ($self) = @_;
my $internal_id = $self->_internal_id();
my $sth = $self->_db_obj->prepare("select UNIX_TIMESTAMP(created) from clone where internal_id = $internal_id");
$sth->execute();
my $rowhash = $sth->fetchrow_hashref();
return $rowhash->{'UNIX_TIMESTAMP(created)'};
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'created'} = $value;
}
return $obj->{'created'};
}
=head2 modified
......@@ -475,18 +408,16 @@ sub created {
=cut
sub modified {
my ($self) = @_;
my $internal_id = $self->_internal_id();
my $sth = $self->_db_obj->prepare("select UNIX_TIMESTAMP(modified) from clone where internal_id = $internal_id");
$sth->execute();
my $rowhash = $sth->fetchrow_hashref();
return $rowhash->{'UNIX_TIMESTAMP(modified)'};
sub modified {
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'modified'} = $value;
}
return $obj->{'modified'};
}
=head2 version
Title : version
......@@ -500,17 +431,20 @@ sub modified {
=cut
sub version {
my $self = shift;
my $internal_id = $self->_internal_id();
my $sth = $self->_db_obj->prepare("select version from clone where internal_id = $internal_id");
$sth->execute();
my $rowhash = $sth->fetchrow_hashref();
return $rowhash->{'version'};
sub version{
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'version'} = $value;
}
return $obj->{'version'};
}
=head2 _stored
Title : _stored
......@@ -545,68 +479,16 @@ sub _stored {
=cut
sub embl_version {
my $self = shift;
my $internal_id = $self->_internal_id();
my $sth = $self->_db_obj->prepare("select embl_version from clone where internal_id = $internal_id");
$sth->execute();
my $rowhash = $sth->fetchrow_hashref();
return $rowhash->{'embl_version'};
}
=head2 seq_date
Title : seq_date
Usage : $clone->seq_date()
Function: loops over all $contig->seq_date, throws a warning if they are different and
returns the first unix time value of the dna created datetime field, which indicates
the original time of the dna sequence data
Example : $clone->seq_date()
Returns : unix time
Args : none
=cut
sub seq_date {
my ($self) = @_;
my $id = $self->id();
my ($seq_date,$old_seq_date);
foreach my $contig ($self->get_all_Contigs) {
$seq_date = $contig->seq_date;
if ($old_seq_date) {
if ($seq_date != $old_seq_date) {
$self->warn ("The created date of the DNA sequence from contig $contig is different from that of the sequence from other contigs on the same clone!");
}
}
$old_seq_date = $seq_date;
}
return $seq_date;
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'embl_version'} = $value;
}
return $obj->{'embl_version'};
}
=head2 sv
Title : sv
Usage : $clone->sv
Function: old version method
Example : $clone->sv
Returns : version number
Args : none
=cut
sub sv{
my ($self) = @_;
$self->warn("Clone::sv - deprecated method. From now on you should use the Clone::version method, which is consistent with our nomenclature");
return $self->embl_version();
}
=head2 embl_id
Title : embl_id
......@@ -619,17 +501,20 @@ sub sv{
=cut
sub embl_id {
my ($self) = @_;
my $internal_id = $self->_internal_id();
my $sth = $self->_db_obj->prepare("select embl_id from clone where internal_id = $internal_id");
$sth->execute();
my $rowhash = $sth->fetchrow_hashref();
return $rowhash->{'embl_id'};
sub embl_id {
my ($obj,$value) = @_;
if( defined $value) {
$obj->{'embl_id'} = $value;
}
return $obj->{'embl_id'};
}
=head2 id
Title : id
......@@ -651,47 +536,54 @@ sub id {
}
=head2 _internal_id
=head2 dbID
Title : _internal_id
Usage : $obj->_internal_id($newval)
Title : dbID
Usage : $obj->dbID($newval)
Function:
Returns : value of _internal_id
Returns : value of dbID
Args : newvalue (optional)
=cut
sub _internal_id{
sub dbID{