view release on metacpan or  search on metacpan

Bio/DB/WebDBSeqI.pm  view on Meta::CPAN

#
# BioPerl module for Bio::DB::WebDBSeqI
#
# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Jason Stajich <jason@bioperl.org>
#
# Copyright Jason Stajich
#
# You may distribute this module under the same terms as perl itself
#
# POD documentation - main docs before the code
#

=head1 NAME

Bio::DB::WebDBSeqI - Object Interface to generalize Web Databases
for retrieving sequences

=head1 SYNOPSIS

   # get a WebDBSeqI object somehow
   # assuming it is a nucleotide db
   my $seq = $db->get_Seq_by_id('ROA1_HUMAN')

=head1 DESCRIPTION

Provides core set of functionality for connecting to a web based
database for retrieving sequences.

Users wishing to add another Web Based Sequence Dabatase will need to
extend this class (see L<Bio::DB::SwissProt> or L<Bio::DB::NCBIHelper> for
examples) and implement the get_request method which returns a
HTTP::Request for the specified uids (accessions, ids, etc depending
on what query types the database accepts).

=head1 FEEDBACK

=head2 Mailing Lists

User feedback is an integral part of the
evolution of this and other Bioperl modules. Send
your comments and suggestions preferably to one
of the Bioperl mailing lists. Your participation
is much appreciated.

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

=head2 Support

Please direct usage questions or support issues to the mailing list:

I<bioperl-l@bioperl.org>

rather than to the module maintainer directly. Many experienced and
reponsive experts will be able look at the problem and quickly
address it. Please include a thorough description of the problem
with code and data examples if at all possible.

=head2 Reporting Bugs

Report bugs to the Bioperl bug tracking system to
help us keep track the bugs and their resolution.
Bug reports can be submitted via the web.

  https://github.com/bioperl/bioperl-live/issues

=head1 AUTHOR - Jason Stajich

Email E<lt> jason@bioperl.org E<gt>

=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::DB::WebDBSeqI;
use strict;
use vars qw($MODVERSION %RETRIEVAL_TYPES $DEFAULT_RETRIEVAL_TYPE
	    $DEFAULTFORMAT $LAST_INVOCATION_TIME @ATTRIBUTES);

use Bio::SeqIO;
use Bio::Root::IO;
use LWP::UserAgent;
use POSIX 'setsid';
use HTTP::Request::Common;
use HTTP::Response;
use File::Spec;
use IO::Pipe;
use IO::String;
use Bio::Root::Root;

use base qw(Bio::DB::RandomAccessI);

BEGIN {
	$MODVERSION = '0.8';
	%RETRIEVAL_TYPES = ('io_string' => 1,
			    'tempfile'  => 1,
			    'pipeline'  => 1,
			  );
	$DEFAULT_RETRIEVAL_TYPE = 'pipeline';
	$DEFAULTFORMAT = 'fasta';
	$LAST_INVOCATION_TIME = 0;
}

sub new {
    my ($class, @args) = @_;
    my $self = $class->SUPER::new(@args);
    my ($baseaddress, $params, $ret_type, $format,$delay,$db) =
	 $self->_rearrange([qw(BASEADDRESS PARAMS RETRIEVALTYPE FORMAT DELAY DB)],
							 @args);

    $ret_type = $DEFAULT_RETRIEVAL_TYPE unless ( $ret_type);
    $baseaddress   && $self->url_base_address($baseaddress);
    $params        && $self->url_params($params);
    $db            && $self->db($db);
    $ret_type      && $self->retrieval_type($ret_type);
    $delay          = $self->delay_policy unless defined $delay;
    $self->delay($delay);


    # insure we always have a default format set for retrieval
    # even though this will be immedietly overwritten by most sub classes
    $format = $self->default_format unless ( defined $format &&
					     $format ne '' );

    $self->request_format($format);
    my $ua = LWP::UserAgent->new(env_proxy => 1);
    $ua->agent(ref($self) ."/$MODVERSION");
    $self->ua($ua);
    $self->{'_authentication'} = [];
    return $self;
}

# from Bio::DB::RandomAccessI

=head2 get_Seq_by_id

 Title   : get_Seq_by_id
 Usage   : $seq = $db->get_Seq_by_id('ROA1_HUMAN')
 Function: Gets a Bio::Seq object by its name
 Returns : a Bio::Seq object
 Args    : the id (as a string) of a sequence
 Throws  : "id does not exist" exception

Bio/DB/WebDBSeqI.pm  view on Meta::CPAN

=head2 get_Seq_by_gi

 Title   : get_Seq_by_gi
 Usage   : $seq = $db->get_Seq_by_gi('405830');
 Function: Gets a Bio::Seq object by gi number
 Returns : A Bio::Seq object
 Args    : gi number (as a string)
 Throws  : "gi does not exist" exception

=cut

sub get_Seq_by_gi {
   my ($self,$seqid) = @_;
    $self->_sleep;
   my $seqio = $self->get_Stream_by_gi($seqid);
   $self->throw("gi does not exist") if( !defined $seqio );
    if ($self->can('complexity') &&  defined $self->complexity && $self->complexity==0) {
        $self->warn("When complexity is set to 0, use get_Stream_by_gi\n".
                    "Returning Bio::SeqIO object");
        return $seqio;
    }
   my @seqs;
   while( my $seq = $seqio->next_seq() ) { push @seqs, $seq; }
   $self->throw("gi does not exist") unless @seqs;
   if( wantarray ) { return @seqs } else { return shift @seqs }
}

=head2 get_Seq_by_version

 Title   : get_Seq_by_version
 Usage   : $seq = $db->get_Seq_by_version('X77802.1');
 Function: Gets a Bio::Seq object by sequence version
 Returns : A Bio::Seq object
 Args    : accession.version (as a string)
 Throws  : "acc.version does not exist" exception

=cut

sub get_Seq_by_version {
   my ($self,$seqid) = @_;
    $self->_sleep;
   my $seqio = $self->get_Stream_by_version($seqid);
   $self->throw("accession.version does not exist") if( !defined $seqio );
    if ($self->can('complexity') &&  defined $self->complexity && $self->complexity==0) {
        $self->warn("When complexity is set to 0, use get_Stream_by_version\n".
                    "Returning Bio::SeqIO object");
        return $seqio;
    }
    my @seqs;
   while( my $seq = $seqio->next_seq() ) { push @seqs, $seq; }
   $self->throw("accession.version does not exist") unless @seqs;
   if( wantarray ) { return @seqs } else { return shift @seqs }
}

# implementing class must define these

=head2 get_request

 Title   : get_request
 Usage   : my $url = $self->get_request
 Function: returns a HTTP::Request object
 Returns :
 Args    : %qualifiers = a hash of qualifiers (ids, format, etc)

=cut

sub get_request {
    my ($self) = @_;
    my $msg = "Implementing class must define method get_request in class WebDBSeqI";
    $self->throw($msg);
}

# class methods

=head2 get_Stream_by_id

  Title   : get_Stream_by_id
  Usage   : $stream = $db->get_Stream_by_id( [$uid1, $uid2] );
  Function: Gets a series of Seq objects by unique identifiers
  Returns : a Bio::SeqIO stream object
  Args    : $ref : a reference to an array of unique identifiers for
                   the desired sequence entries


=cut

sub get_Stream_by_id {
    my ($self, $ids) = @_;
    my ($webfmt,$localfmt) = $self->request_format;
    return $self->get_seq_stream('-uids' => $ids, '-mode' => 'single',
				 '-format' => $webfmt);
}

*get_Stream_by_batch = sub {
  my $self = shift;
  $self->deprecated('get_Stream_by_batch() is deprecated; use get_Stream_by_id() instead');
  $self->get_Stream_by_id(@_)
};


=head2 get_Stream_by_acc

  Title   : get_Stream_by_acc
  Usage   : $seq = $db->get_Stream_by_acc([$acc1, $acc2]);
  Function: Gets a series of Seq objects by accession numbers
  Returns : a Bio::SeqIO stream object
  Args    : $ref : a reference to an array of accession numbers for
                   the desired sequence entries
  Note    : For GenBank, this just calls the same code for get_Stream_by_id()

=cut

sub get_Stream_by_acc {
    my ($self, $ids ) = @_;
    return $self->get_seq_stream('-uids' => $ids, '-mode' => 'single');
}


=head2 get_Stream_by_gi

  Title   : get_Stream_by_gi