Commit 306c44b3 authored by Graham McVicker's avatar Graham McVicker
Browse files

Removed unused AceDB modules,

Removed deprecated Repeat, RepeatI modules
Added a few more PODs
parent c8f64db2
#
# BioPerl module for DB::Clone
#
# Cared for by Ewan Birney <birney@sanger.ac.uk>
#
# Copyright Ewan Birney
#
# You may distribute this module under the same terms as perl itself
# POD documentation - main docs before the code
=head1 NAME
Bio::EnsEMBL::AceDB::Clone - Object representing one clone
=head1 SYNOPSIS
# $db is Bio::EnsEMBL::AceDB::Obj
$clone = $db->get_Clone();
@contig = $clone->get_Contigs();
@genes = $clone->get_all_Genes();
=head1 DESCRIPTION
Represents information on one Clone
=head1 CONTACT
Describe contact details here
=head1 APPENDIX
The rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _
=cut
# Let the code begin...
package Bio::EnsEMBL::AceDB::Clone;
use vars qw(@ISA);
use strict;
use Bio::EnsEMBL::Root;
@ISA = qw(Bio::EnsEMBL::Root);
# new() is inherited from Bio::Root::Object
# _initialize is where the heavy stuff will happen when new is called
sub new {
my($pkg,@args) = @_;
my $self = bless {}, $pkg;
# set stuff in self from @args
my ($dbobj,$id) = $self->_rearrange([qw(DBOBJ
ID
)],@args);
$id || $self->throw("Cannot make contig db object without id");
$dbobj || $self->throw("Cannot make contig db object without db object");
$dbobj->isa('Bio::EnsEMBL::AceDB::Obj') ||
$self->throw("Cannot make contig db object with a $dbobj object");
$self->id($id);
$self->_dbobj($dbobj);
return $self; # success - we hope!
}
=head2 seq
Title : seq
Usage :
Function:
Example :
Returns :
Args :
=cut
sub seq {
my ($self) = @_;
my ($contig) = $self->get_Contig($self->id());
return $contig->seq();
}
=head2 embl_version
Title : embl_version
Usage :
Function:
Example :
Returns :
Args :
=cut
sub embl_version {
my ($self) = @_;
my ($contig) = $self->get_Contig($self->id());
if (my $version = $contig->ace_seq->at('DB_info.Sequence_version[1]')) {
return $version->name;
}
return;
}
=head2 embl_id
Title : embl_id
Usage :
Function:
Example :
Returns :
Args :
=cut
sub embl_id {
my ($self) = @_;
my ($contig) = $self->get_Contig($self->id());
if (my $database = $contig->ace_seq->at('DB_info.Database[1]')) {
if ($database eq "EMBL") {
if (my $embl_id = $contig->ace_seq->at('DB_info.Database[2]')) {
return $embl_id->name;
}
}
}
return $self->id;
}
=head2 htg_phase
Title : htg_phase
Usage : $obj->id($newval)
Function:
Example :
Returns : value of id
Args : newvalue (optional)
=cut
sub htg_phase {
my ($obj) = @_;
return 3;
}
=head2 id
Title : id
Usage : $obj->id($newval)
Function:
Example :
Returns : value of id
Args : newvalue (optional)
=cut
sub id {
my ($obj,$value) = @_;
if( defined $value) {
$obj->{'_clone_id'} = $value;
}
return $obj->{'_clone_id'};
}
=head2 created
Title : created
Usage :
Function:
Example :
Returns :
Args :
=cut
sub created {
my ($self) = @_;
return $self->get_Contig->seq_date;
}
=head2 modified
Title : modified
Usage :
Function:
Example :
Returns :
Args :
=cut
sub modified {
my ($self) = @_;
return $self->get_Contig->seq_date;
}
=head2 seq_date
Title : seq_date
Usage :
Function:
Example :
Returns :
Args :
=cut
sub seq_date {
my ($self) = @_;
return $self->get_Contig->seq_date;
}
=head2 sv
Title : sv
Usage :
Function:
Example :
Returns :
Args :
=cut
sub sv {
my ($self) = @_;
return 1;
}
=head2 version
Title : version
Usage :
Function:
Example :
Returns :
Args :
=cut
sub version {
my ($self) = @_;
my ($contig) = $self->get_Contig($self->id());
if (my $version = $contig->ace_seq->at('DB_info.Sequence_version[1]')) {
return $version->name;
}
# If the version isn't defined just return 1.
return 1;
}
=head2 get_all_Contigs
Title : get_Contigs
Usage : foreach $contig ( $clone->get_Contigs )
Function:
Example :
Returns :
Args :
=cut
sub get_all_Contigs {
my ($self) = @_;
return ($self->get_Contig($self->id));
}
=head2 get_all_ContigOverlaps
Title : get_all_ContigOverlaps
Usage :
Function:
Example :
Returns :
Args :
=cut
sub get_all_ContigOverlaps {
my ($self) = @_;
return $self->get_Contig->get_all_ContigOverlaps;
}
=head2 get_Contig
Title : get_Contig
Usage :
Function:
Example :
Returns :
Args :
=cut
sub get_Contig {
my ($self,$contigid) = @_;
if( defined($contigid) and $contigid ne $self->id() ) {
$self->throw("In an Acedb database, trying to get a contigid $contigid not on the clone. Indicates an error!");
}
unless ($self->{'_contig_cache'}) {
my $contig = new Bio::EnsEMBL::AceDB::Contig(
'-dbobj' => $self->_dbobj,
'-id' => $self->id,
);
$self->{'_contig_cache'} = $contig;
}
return $self->{'_contig_cache'};
}
=head2 get_all_Genes
Title : get_all_Genes
Usage :
Function:
Example :
Returns :
Args :
=cut
sub get_all_Genes {
my ($self,@args) = @_;
my (@genes);
foreach my $contig ( $self->get_all_Contigs ) {
push(@genes,$contig->get_all_Genes());
}
return @genes;
}
=head2 _dbobj
Title : _dbobj
Usage : $obj->_dbobj($newval)
Function:
Example :
Returns : value of _dbobj
Args : newvalue (optional)
=cut
sub _dbobj {
my ($obj,$value) = @_;
if( defined $value) {
$obj->{'_dbobj'} = $value;
}
return $obj->{'_dbobj'};
}
1;
This diff is collapsed.
#
# BioPerl module for DB::Obj
#
# Cared for by Ewan Birney <birney@sanger.ac.uk>
#
# Copyright Ewan Birney
#
# You may distribute this module under the same terms as perl itself
# POD documentation - main docs before the code
=head1 NAME
Bio::EnsEMBL::AceDB::Obj - Object representing an instance of an EnsEMBL DB
=head1 SYNOPSIS
$db = new Bio::EnsEMBL::AceDB::Obj( -host => 'caldy' , -port => '210000' );
$clone = $db->get_Clone('X45667');
$contig = $db->get_Contig("X23343");
$gene = $db->get_Gene('HG45501');
=head1 DESCRIPTION
This object represents a database that is implemented somehow (you shouldn't
care much as long as you can get the object). From the object you can pull
out other objects by their stable identifier, such as Clone (accession number),
Exons, Genes and Transcripts. The clone gives you a DB::Clone object, from
which you can pull out associated genes and features.
=head1 CONTACT
Describe contact details here
=head1 APPENDIX
The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
=cut
#' Let the code begin...
package Bio::EnsEMBL::AceDB::Obj;
use vars qw(@ISA);
use strict;
# Object preamble - inheriets from Bio::Root::Object
use Bio::Root::Object;
use Bio::EnsEMBL::AceDB::Contig;
use Bio::EnsEMBL::AceDB::Clone;
use Bio::EnsEMBL::AceDB::Update_Obj;
use Time::Local 'timelocal';
use Ace;
@ISA = qw(Bio::EnsEMBL::Root);
sub new {
my($pkg,@args) = @_;
my $self = bless {}, $pkg;
my ($host,$port,$timeout,$debug) = $self->_rearrange(
[qw(HOST PORT TIMEOUT DEBUG)],@args);
$host || $self->throw("Database object must have a host");
if( $debug ) {
$self->_debug($debug);
} else {
$self->_debug(0);
}
$timeout ||= 60;
my $ace = my $db = Ace->connect(-host => $host,
-timeout => $timeout,
-port => $port);
$ace->date_style('ace');
if( !$ace ) {
$self->throw("Could not connect to ace database $host,$port due to " . Ace->error() . " ");
}
if( $self->_debug > 3 ) {
$self->warn("Using connection $ace");
}
$self->_db_handle($ace);
return $self;
}
=head2 dateace
my $time = $obj->dateace('2000-05-24');
Converts a ACeDB format date into a unix time int
using C<Time::Local::timelocal>.
=cut
sub dateace {
my( $self, $acedate ) = @_;
my($year, $mon, $mday) = $acedate =~ /(\d{4})-(\d{2})-(\d{2})/
or die "Invalid ace date '$acedate'";
$year -= 1900;
$mon -= 1;
return timelocal(0,0,0,$mday,$mon,$year);
}
=head2 dna_fetch_method
$obj->dna_fetch_method(\&humace_dna_get);
my $method = $obj->dna_fetch_method;
my $bio_seq = &$method($contig);
Sets or gets a subroutine in the database object
which is used by C<Bio::EnsEMBL::AceDB::Contig>
objects to fetch C<Bio::PrimarySeq> objects from
the database.
=cut
sub dna_fetch_method {
my( $self, $value ) = @_;
if ($value) {
$self->throw("'$value' is not a reference to a subroutine")
unless ref($value) eq 'CODE';
$self->{'_dna_fetch_method'} = $value;
}
return $self->{'_dna_fetch_method'};
}
=head2 get_Gene
Title : get_Gene
Usage :
Function:
Example :
Returns :
Args :
=cut
sub get_Gene{
my ($self,@args) = @_;
$self->throw("Not implemented yet! sorry!");
}
=head2 get_Clone
Title : get_Clone
Usage :
Function:
Example :
Returns :
Args :
=cut
sub get_Clone {
my ($self,$id) = @_;
$self->fetch(Sequence => $id) || $self->throw("$id is not a valid sequence in this database");
my $clone = new Bio::EnsEMBL::AceDB::Clone( -id => $id, -dbobj => $self);
return $clone;
}
=head2 get_all_Clone_id
Title : get_all_Clone_id
Usage :
Function:
Example :
Returns :
Args :
=cut
sub get_all_Clone_id {
my ($self) = @_;
my @clones = map $_->name, $self->fetch(Genome_Sequence => '*');
return @clones;
}
=head2 get_Contig
Title : get_Contig
Usage :
Function:
Example :
Returns :
Args :
=cut
sub get_Contig {
my ($self,$id) = @_;
$self->fetch(Sequence => $id) || $self->throw("$id is not a valid sequence in this database");
my $contig = new Bio::EnsEMBL::AceDB::Contig(
-dbobj => $self,
-id => $id
);
return $contig;
}
=head2 get_Update_Obj
Title : get_Update_Obj
Usage :
Function:
Example :