annotate variant_effect_predictor/Bio/DB/WebDBSeqI.pm @ 3:d30fa12e4cc5 default tip

Merge heads 2:a5976b2dce6f and 1:09613ce8151e which were created as a result of a recently fixed bug.
author devteam <devteam@galaxyproject.org>
date Mon, 13 Jan 2014 10:38:30 -0500
parents 1f6dce3d34e0
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
1 # $Id: WebDBSeqI.pm,v 1.30.2.1 2003/06/12 09:29:38 heikki Exp $
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
2 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
3 # BioPerl module for Bio::DB::WebDBSeqI
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
4 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
5 # Cared for by Jason Stajich <jason@bioperl.org>
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
6 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
7 # Copyright Jason Stajich
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
8 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
9 # You may distribute this module under the same terms as perl itself
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
10 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
11 # POD documentation - main docs before the code
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
12 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
13
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
14 =head1 NAME
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
15
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
16 Bio::DB::WebDBSeqI - Object Interface to generalize Web Databases
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
17 for retrieving sequences
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
18
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
19 =head1 SYNOPSIS
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
20
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
21 # get a WebDBSeqI object somehow
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
22 # assuming it is a nucleotide db
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
23 my $seq = $db->get_Seq_by_id('ROA1_HUMAN')
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
24
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
25 =head1 DESCRIPTION
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
26
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
27
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
28
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
29
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
30 Provides core set of functionality for connecting to a web based
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
31 database for retriving sequences.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
32
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
33 Users wishing to add another Web Based Sequence Dabatase will need to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
34 extend this class (see Bio::DB::SwissProt or Bio::DB::NCBIHelper for
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
35 examples) and implement the get_request method which returns a
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
36 HTTP::Request for the specified uids (accessions, ids, etc depending
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
37 on what query types the database accepts).
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
38
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
39
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
40
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
41 =head1 FEEDBACK
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
42
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
43 =head2 Mailing Lists
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
44
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
45 User feedback is an integral part of the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
46 evolution of this and other Bioperl modules. Send
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
47 your comments and suggestions preferably to one
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
48 of the Bioperl mailing lists. Your participation
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
49 is much appreciated.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
50
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
51 bioperl-l@bioperl.org - General discussion
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
52 http://bioperl.org/MailList.shtml - About the mailing lists
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
53
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
54 =head2 Reporting Bugs
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
55
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
56 Report bugs to the Bioperl bug tracking system to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
57 help us keep track the bugs and their resolution.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
58 Bug reports can be submitted via email or the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
59 web:
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
60
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
61 bioperl-bugs@bio.perl.org
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
62 http://bugzilla.bioperl.org/
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
63
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
64 =head1 AUTHOR - Jason Stajich
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
65
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
66 Email E<lt> jason@bioperl.org E<gt>
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
67
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
68 =head1 APPENDIX
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
69
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
70 The rest of the documentation details each of the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
71 object methods. Internal methods are usually
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
72 preceded with a _
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
73
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
74 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
75
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
76 # Let the code begin...
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
77
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
78 package Bio::DB::WebDBSeqI;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
79 use strict;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
80 use vars qw(@ISA $MODVERSION %RETRIEVAL_TYPES $DEFAULT_RETRIEVAL_TYPE
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
81 $DEFAULTFORMAT $LAST_INVOCATION_TIME);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
82
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
83 use Bio::DB::RandomAccessI;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
84 use Bio::SeqIO;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
85 use Bio::Root::IO;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
86 use LWP::UserAgent;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
87 use HTTP::Request::Common;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
88 use HTTP::Response;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
89 use File::Spec;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
90 use IO::String;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
91 use Bio::Root::Root;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
92
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
93 @ISA = qw(Bio::DB::RandomAccessI);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
94
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
95 BEGIN {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
96 $MODVERSION = '0.8';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
97 %RETRIEVAL_TYPES = ( 'io_string' => 1,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
98 'tempfile' => 1,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
99 'pipeline' => 1,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
100 );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
101 $DEFAULT_RETRIEVAL_TYPE = 'pipeline';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
102 $DEFAULTFORMAT = 'fasta';
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
103 $LAST_INVOCATION_TIME = 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
104 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
105
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
106 sub new {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
107 my ($class, @args) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
108 my $self = $class->SUPER::new(@args);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
109 my ($baseaddress, $params, $ret_type, $format,$delay,$db) =
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
110 $self->_rearrange([qw(BASEADDRESS PARAMS RETRIEVALTYPE FORMAT DELAY DB)],
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
111 @args);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
112
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
113 $ret_type = $DEFAULT_RETRIEVAL_TYPE unless ( $ret_type);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
114 $baseaddress && $self->url_base_address($baseaddress);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
115 $params && $self->url_params($params);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
116 $db && $self->db($db);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
117 $ret_type && $self->retrieval_type($ret_type);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
118 $delay = $self->delay_policy unless defined $delay;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
119 $self->delay($delay);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
120
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
121 # insure we always have a default format set for retrieval
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
122 # even though this will be immedietly overwritten by most sub classes
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
123 $format = $self->default_format unless ( defined $format &&
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
124 $format ne '' );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
125
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
126 $self->request_format($format);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
127 my $ua = new LWP::UserAgent;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
128 $ua->agent(ref($self) ."/$MODVERSION");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
129 $self->ua($ua);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
130 $self->{'_authentication'} = [];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
131 return $self;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
132 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
133
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
134 # from Bio::DB::RandomAccessI
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
135
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
136 =head2 get_Seq_by_id
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
137
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
138 Title : get_Seq_by_id
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
139 Usage : $seq = $db->get_Seq_by_id('ROA1_HUMAN')
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
140 Function: Gets a Bio::Seq object by its name
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
141 Returns : a Bio::Seq object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
142 Args : the id (as a string) of a sequence
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
143 Throws : "id does not exist" exception
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
144
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
145
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
146 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
147
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
148 sub get_Seq_by_id {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
149 my ($self,$seqid) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
150 $self->_sleep;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
151 my $seqio = $self->get_Stream_by_id([$seqid]);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
152 $self->throw("id does not exist") if( !defined $seqio ) ;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
153 my @seqs;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
154 while( my $seq = $seqio->next_seq() ) { push @seqs, $seq; }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
155 $self->throw("id does not exist") unless @seqs;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
156 if( wantarray ) { return @seqs } else { return shift @seqs }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
157 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
158
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
159 =head2 get_Seq_by_acc
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
160
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
161 Title : get_Seq_by_acc
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
162 Usage : $seq = $db->get_Seq_by_acc('X77802');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
163 Function: Gets a Bio::Seq object by accession number
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
164 Returns : A Bio::Seq object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
165 Args : accession number (as a string)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
166 Throws : "acc does not exist" exception
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
167
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
168 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
169
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
170 sub get_Seq_by_acc {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
171 my ($self,$seqid) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
172 $self->_sleep;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
173 my $seqio = $self->get_Stream_by_acc($seqid);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
174 $self->throw("acc does not exist") if( ! defined $seqio );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
175 my @seqs;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
176 while( my $seq = $seqio->next_seq() ) { push @seqs, $seq; }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
177 $self->throw("acc does not exist") unless @seqs;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
178 if( wantarray ) { return @seqs } else { return shift @seqs }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
179 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
180
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
181
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
182 =head2 get_Seq_by_gi
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
183
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
184 Title : get_Seq_by_gi
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
185 Usage : $seq = $db->get_Seq_by_gi('405830');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
186 Function: Gets a Bio::Seq object by gi number
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
187 Returns : A Bio::Seq object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
188 Args : gi number (as a string)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
189 Throws : "gi does not exist" exception
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
190
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
191 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
192
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
193 sub get_Seq_by_gi {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
194 my ($self,$seqid) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
195 $self->_sleep;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
196 my $seqio = $self->get_Stream_by_gi($seqid);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
197 $self->throw("gi does not exist") if( !defined $seqio );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
198 my @seqs;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
199 while( my $seq = $seqio->next_seq() ) { push @seqs, $seq; }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
200 $self->throw("gi does not exist") unless @seqs;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
201 if( wantarray ) { return @seqs } else { return shift @seqs }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
202 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
203
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
204 =head2 get_Seq_by_version
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
205
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
206 Title : get_Seq_by_version
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
207 Usage : $seq = $db->get_Seq_by_version('X77802.1');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
208 Function: Gets a Bio::Seq object by sequence version
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
209 Returns : A Bio::Seq object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
210 Args : accession.version (as a string)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
211 Throws : "acc.version does not exist" exception
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
212
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
213 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
214
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
215 sub get_Seq_by_version {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
216 my ($self,$seqid) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
217 $self->_sleep;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
218 my $seqio = $self->get_Stream_by_version($seqid);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
219 $self->throw("accession.version does not exist") if( !defined $seqio );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
220 my @seqs;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
221 while( my $seq = $seqio->next_seq() ) { push @seqs, $seq; }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
222 $self->throw("accession.version does not exist") unless @seqs;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
223 if( wantarray ) { return @seqs } else { return shift @seqs }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
224 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
225
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
226 # implementing class must define these
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
227
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
228 =head2 get_request
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
229
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
230 Title : get_request
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
231 Usage : my $url = $self->get_request
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
232 Function: returns a HTTP::Request object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
233 Returns :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
234 Args : %qualifiers = a hash of qualifiers (ids, format, etc)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
235
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
236 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
237
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
238 sub get_request {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
239 my ($self) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
240 my $msg = "Implementing class must define method get_request in class WebDBSeqI";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
241 $self->throw($msg);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
242 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
243
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
244 # class methods
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
245
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
246 =head2 get_Stream_by_id
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
247
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
248 Title : get_Stream_by_id
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
249 Usage : $stream = $db->get_Stream_by_id( [$uid1, $uid2] );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
250 Function: Gets a series of Seq objects by unique identifiers
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
251 Returns : a Bio::SeqIO stream object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
252 Args : $ref : a reference to an array of unique identifiers for
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
253 the desired sequence entries
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
254
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
255
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
256 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
257
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
258 sub get_Stream_by_id {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
259 my ($self, $ids) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
260 my ($webfmt,$localfmt) = $self->request_format;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
261 return $self->get_seq_stream('-uids' => $ids, '-mode' => 'single',
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
262 '-format' => $webfmt);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
263 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
264
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
265 *get_Stream_by_batch = sub {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
266 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
267 $self->deprecated('get_Stream_by_batch() is deprecated; use get_Stream_by_id() instead');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
268 $self->get_Stream_by_id(@_)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
269 };
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
270
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
271
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
272 =head2 get_Stream_by_acc
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
273
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
274 Title : get_Stream_by_acc
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
275 Usage : $seq = $db->get_Stream_by_acc([$acc1, $acc2]);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
276 Function: Gets a series of Seq objects by accession numbers
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
277 Returns : a Bio::SeqIO stream object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
278 Args : $ref : a reference to an array of accession numbers for
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
279 the desired sequence entries
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
280 Note : For GenBank, this just calls the same code for get_Stream_by_id()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
281
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
282 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
283
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
284 sub get_Stream_by_acc {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
285 my ($self, $ids ) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
286 return $self->get_seq_stream('-uids' => $ids, '-mode' => 'single');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
287 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
288
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
289
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
290 =head2 get_Stream_by_gi
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
291
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
292 Title : get_Stream_by_gi
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
293 Usage : $seq = $db->get_Stream_by_gi([$gi1, $gi2]);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
294 Function: Gets a series of Seq objects by gi numbers
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
295 Returns : a Bio::SeqIO stream object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
296 Args : $ref : a reference to an array of gi numbers for
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
297 the desired sequence entries
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
298 Note : For GenBank, this just calls the same code for get_Stream_by_id()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
299
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
300 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
301
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
302 sub get_Stream_by_gi {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
303 my ($self, $ids ) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
304 return $self->get_seq_stream('-uids' => $ids, '-mode' => 'gi');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
305 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
306
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
307 =head2 get_Stream_by_version
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
308
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
309 Title : get_Stream_by_version
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
310 Usage : $seq = $db->get_Stream_by_version([$version1, $version2]);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
311 Function: Gets a series of Seq objects by accession.versions
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
312 Returns : a Bio::SeqIO stream object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
313 Args : $ref : a reference to an array of accession.version strings for
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
314 the desired sequence entries
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
315 Note : For GenBank, this is implemeted in NCBIHelper
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
316
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
317 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
318
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
319 sub get_Stream_by_version {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
320 my ($self, $ids ) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
321 # $self->throw("Implementing class should define this method!");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
322 return $self->get_seq_stream('-uids' => $ids, '-mode' => 'version'); # how it should work
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
323 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
324
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
325 =head2 get_Stream_by_query
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
326
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
327 Title : get_Stream_by_query
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
328 Usage : $stream = $db->get_Stream_by_query($query);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
329 Function: Gets a series of Seq objects by way of a query string or oject
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
330 Returns : a Bio::SeqIO stream object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
331 Args : $query : A string that uses the appropriate query language
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
332 for the database or a Bio::DB::QueryI object. It is suggested
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
333 that you create the Bio::DB::Query object first and interrogate
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
334 it for the entry count before you fetch a potentially large stream.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
335
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
336 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
337
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
338 sub get_Stream_by_query {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
339 my ($self, $query ) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
340 return $self->get_seq_stream('-query' => $query, '-mode'=>'query');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
341 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
342
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
343 =head2 default_format
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
344
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
345 Title : default_format
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
346 Usage : my $format = $self->default_format
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
347 Function: Returns default sequence format for this module
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
348 Returns : string
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
349 Args : none
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
350
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
351 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
352
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
353 sub default_format {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
354 return $DEFAULTFORMAT;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
355 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
356
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
357 # sorry, but this is hacked in because of BioFetch problems...
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
358 sub db {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
359 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
360 my $d = $self->{_db};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
361 $self->{_db} = shift if @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
362 $d;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
363 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
364
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
365 =head2 request_format
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
366
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
367 Title : request_format
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
368 Usage : my ($req_format, $ioformat) = $self->request_format;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
369 $self->request_format("genbank");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
370 $self->request_format("fasta");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
371 Function: Get/Set sequence format retrieval. The get-form will normally not
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
372 be used outside of this and derived modules.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
373 Returns : Array of two strings, the first representing the format for
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
374 retrieval, and the second specifying the corresponding SeqIO format.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
375 Args : $format = sequence format
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
376
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
377 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
378
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
379 sub request_format {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
380 my ($self, $value) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
381
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
382 if( defined $value ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
383 $self->{'_format'} = [ $value, $value];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
384 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
385 return @{$self->{'_format'}};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
386 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
387
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
388 =head2 get_seq_stream
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
389
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
390 Title : get_seq_stream
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
391 Usage : my $seqio = $self->get_seq_sream(%qualifiers)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
392 Function: builds a url and queries a web db
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
393 Returns : a Bio::SeqIO stream capable of producing sequence
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
394 Args : %qualifiers = a hash qualifiers that the implementing class
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
395 will process to make a url suitable for web querying
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
396
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
397 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
398
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
399 sub get_seq_stream {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
400 my ($self, %qualifiers) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
401 my ($rformat, $ioformat) = $self->request_format();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
402 my $seen = 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
403 foreach my $key ( keys %qualifiers ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
404 if( $key =~ /format/i ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
405 $rformat = $qualifiers{$key};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
406 $seen = 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
407 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
408 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
409 $qualifiers{'-format'} = $rformat if( !$seen);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
410 ($rformat, $ioformat) = $self->request_format($rformat);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
411
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
412 my $request = $self->get_request(%qualifiers);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
413 $request->proxy_authorization_basic($self->authentication)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
414 if ( $self->authentication);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
415 $self->debug("request is ". $request->as_string(). "\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
416
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
417 # workaround for MSWin systems
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
418 $self->retrieval_type('io_string') if $self->retrieval_type =~ /pipeline/ && $^O =~ /^MSWin/;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
419
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
420 if ($self->retrieval_type =~ /pipeline/) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
421 # Try to create a stream using POSIX fork-and-pipe facility.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
422 # this is a *big* win when fetching thousands of sequences from
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
423 # a web database because we can return the first entry while
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
424 # transmission is still in progress.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
425 # Also, no need to keep sequence in memory or in a temporary file.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
426 # If this fails (Windows, MacOS 9), we fall back to non-pipelined access.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
427
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
428 # fork and pipe: _stream_request()=><STREAM>
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
429 my $result = eval { open(STREAM,"-|") };
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
430
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
431 if (defined $result) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
432 $DB::fork_TTY = '/dev/null'; # prevents complaints from debugger
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
433 if (!$result) { # in child process
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
434 $self->_stream_request($request);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
435 kill 9=>$$; # to prevent END{} blocks from executing in forked children
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
436 exit 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
437 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
438 else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
439 return Bio::SeqIO->new('-verbose' => $self->verbose,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
440 '-format' => $ioformat,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
441 '-fh' => \*STREAM);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
442 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
443 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
444 else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
445 $self->retrieval_type('io_string');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
446 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
447 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
448
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
449 if ($self->retrieval_type =~ /temp/i) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
450 my $dir = $self->io->tempdir( CLEANUP => 1);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
451 my ( $fh, $tmpfile) = $self->io()->tempfile( DIR => $dir );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
452 close $fh;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
453 my $resp = $self->_request($request, $tmpfile);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
454 if( ! -e $tmpfile || -z $tmpfile || ! $resp->is_success() ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
455 $self->throw("WebDBSeqI Error - check query sequences!\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
456 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
457 $self->postprocess_data('type' => 'file',
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
458 'location' => $tmpfile);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
459 # this may get reset when requesting batch mode
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
460 ($rformat,$ioformat) = $self->request_format();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
461 if( $self->verbose > 0 ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
462 open(ERR, "<$tmpfile");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
463 while(<ERR>) { $self->debug($_);}
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
464 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
465
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
466 return Bio::SeqIO->new('-verbose' => $self->verbose,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
467 '-format' => $ioformat,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
468 '-file' => $tmpfile);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
469 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
470
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
471 if ($self->retrieval_type =~ /io_string/i ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
472 my $resp = $self->_request($request);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
473 my $content = $resp->content_ref;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
474 $self->debug( "content is $$content\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
475 if (!$resp->is_success() || length($$content) == 0) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
476 $self->throw("WebDBSeqI Error - check query sequences!\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
477 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
478 ($rformat,$ioformat) = $self->request_format();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
479 $self->postprocess_data('type'=> 'string',
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
480 'location' => $content);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
481 $self->debug( "str is $$content\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
482 return Bio::SeqIO->new('-verbose' => $self->verbose,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
483 '-format' => $ioformat,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
484 '-fh' => new IO::String($$content));
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
485 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
486
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
487 # if we got here, we don't know how to handle the retrieval type
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
488 $self->throw("retrieval type " . $self->retrieval_type .
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
489 " unsupported\n");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
490 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
491
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
492 =head2 url_base_address
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
493
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
494 Title : url_base_address
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
495 Usage : my $address = $self->url_base_address or
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
496 $self->url_base_address($address)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
497 Function: Get/Set the base URL for the Web Database
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
498 Returns : Base URL for the Web Database
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
499 Args : $address - URL for the WebDatabase
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
500
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
501 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
502
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
503 sub url_base_address {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
504 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
505 my $d = $self->{'_baseaddress'};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
506 $self->{'_baseaddress'} = shift if @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
507 $d;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
508 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
509
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
510
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
511 =head2 proxy
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
512
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
513 Title : proxy
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
514 Usage : $httpproxy = $db->proxy('http') or
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
515 $db->proxy(['http','ftp'], 'http://myproxy' )
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
516 Function: Get/Set a proxy for use of proxy
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
517 Returns : a string indicating the proxy
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
518 Args : $protocol : an array ref of the protocol(s) to set/get
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
519 $proxyurl : url of the proxy to use for the specified protocol
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
520 $username : username (if proxy requires authentication)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
521 $password : password (if proxy requires authentication)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
522
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
523 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
524
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
525 sub proxy {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
526 my ($self,$protocol,$proxy,$username,$password) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
527 return undef if ( !defined $self->ua || !defined $protocol
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
528 || !defined $proxy );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
529 $self->authentication($username, $password)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
530 if ($username && $password);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
531 return $self->ua->proxy($protocol,$proxy);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
532 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
533
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
534 =head2 authentication
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
535
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
536 Title : authentication
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
537 Usage : $db->authentication($user,$pass)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
538 Function: Get/Set authentication credentials
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
539 Returns : Array of user/pass
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
540 Args : Array or user/pass
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
541
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
542
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
543 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
544
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
545 sub authentication{
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
546 my ($self,$u,$p) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
547
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
548 if( defined $u && defined $p ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
549 $self->{'_authentication'} = [ $u,$p];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
550 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
551 return @{$self->{'_authentication'}};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
552 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
553
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
554
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
555 =head2 retrieval_type
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
556
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
557 Title : retrieval_type
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
558 Usage : $self->retrieval_type($type);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
559 my $type = $self->retrieval_type
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
560 Function: Get/Set a proxy for retrieval_type (pipeline, io_string or tempfile)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
561 Returns : string representing retrieval type
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
562 Args : $value - the value to store
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
563
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
564 This setting affects how the data stream from the remote web server is
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
565 processed and passed to the Bio::SeqIO layer. Three types of retrieval
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
566 types are currently allowed:
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
567
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
568 pipeline Perform a fork in an attempt to begin streaming
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
569 while the data is still downloading from the remote
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
570 server. Disk, memory and speed efficient, but will
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
571 not work on Windows or MacOS 9 platforms.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
572
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
573 io_string Store downloaded database entry(s) in memory. Can be
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
574 problematic for batch downloads because entire set
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
575 of entries must fit in memory. Alll entries must be
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
576 downloaded before processing can begin.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
577
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
578 tempfile Store downloaded database entry(s) in a temporary file.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
579 All entries must be downloaded before processing can
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
580 begin.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
581
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
582 The default is pipeline, with automatic fallback to io_string if
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
583 pipelining is not available.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
584
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
585 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
586
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
587 sub retrieval_type {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
588 my ($self, $value) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
589 if( defined $value ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
590 $value = lc $value;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
591 if( ! $RETRIEVAL_TYPES{$value} ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
592 $self->warn("invalid retrieval type $value must be one of (" .
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
593 join(",", keys %RETRIEVAL_TYPES), ")");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
594 $value = $DEFAULT_RETRIEVAL_TYPE;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
595 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
596 $self->{'_retrieval_type'} = $value;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
597 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
598 return $self->{'_retrieval_type'};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
599 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
600
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
601 =head2 url_params
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
602
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
603 Title : url_params
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
604 Usage : my $params = $self->url_params or
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
605 $self->url_params($params)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
606 Function: Get/Set the URL parameters for the Web Database
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
607 Returns : url parameters for Web Database
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
608 Args : $params - parameters to be appended to the URL for the WebDatabase
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
609
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
610 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
611
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
612 sub url_params {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
613 my ($self, $value) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
614 if( defined $value ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
615 $self->{'_urlparams'} = $value;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
616 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
617 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
618
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
619 =head2 ua
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
620
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
621 Title : ua
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
622 Usage : my $ua = $self->ua or
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
623 $self->ua($ua)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
624 Function: Get/Set a LWP::UserAgent for use
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
625 Returns : reference to LWP::UserAgent Object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
626 Args : $ua - must be a LWP::UserAgent
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
627
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
628 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
629
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
630 sub ua {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
631 my ($self, $ua) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
632 if( defined $ua && $ua->isa("LWP::UserAgent") ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
633 $self->{'_ua'} = $ua;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
634 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
635 return $self->{'_ua'};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
636 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
637
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
638 =head2 postprocess_data
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
639
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
640 Title : postprocess_data
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
641 Usage : $self->postprocess_data ( 'type' => 'string',
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
642 'location' => \$datastr);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
643 Function: process downloaded data before loading into a Bio::SeqIO
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
644 Returns : void
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
645 Args : hash with two keys - 'type' can be 'string' or 'file'
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
646 - 'location' either file location or string
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
647 reference containing data
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
648
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
649 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
650
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
651 sub postprocess_data {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
652 my ( $self, %args) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
653 return;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
654 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
655
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
656 # private methods
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
657 sub _request {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
658
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
659 my ($self, $url,$tmpfile) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
660 my ($resp);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
661 if( defined $tmpfile && $tmpfile ne '' ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
662 $resp = $self->ua->request($url, $tmpfile);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
663 } else { $resp = $self->ua->request($url); }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
664
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
665 if( $resp->is_error ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
666 $self->throw("WebDBSeqI Request Error:\n".$resp->as_string);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
667 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
668 return $resp;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
669 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
670
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
671 # send web request to stdout for streaming purposes
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
672 sub _stream_request {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
673 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
674 my $request = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
675
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
676 # fork so as to pipe output of fetch process through to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
677 # postprocess_data method call.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
678 my $child = open (FETCH,"-|");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
679 $self->throw("Couldn't fork: $!") unless defined $child;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
680
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
681 if ($child) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
682 local ($/) = "//\n"; # assume genbank/swiss format
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
683 $| = 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
684 my $records = 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
685 while (my $record = <FETCH>) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
686 $records++;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
687 $self->postprocess_data('type' => 'string',
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
688 'location' => \$record);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
689 print STDOUT $record;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
690 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
691 $/ = "\n"; # reset to be safe;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
692 close(FETCH);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
693 close STDOUT;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
694 close STDERR;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
695 kill 9=>$$; # to prevent END{} blocks from executing in forked children
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
696 sleep;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
697 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
698 else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
699 $| = 1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
700 my $resp = $self->ua->request($request,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
701 sub { print shift }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
702 );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
703 if( $resp->is_error ) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
704 $self->throw("WebDBSeqI Request Error:\n".$resp->as_string);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
705 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
706
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
707 close STDOUT; close STDERR;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
708 kill 9=>$$; # to prevent END{} blocks from executing in forked children
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
709 sleep;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
710 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
711 exit 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
712 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
713
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
714 sub io {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
715 my ($self,$io) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
716
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
717 if(defined($io) || (! exists($self->{'_io'}))) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
718 $io = Bio::Root::IO->new() unless $io;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
719 $self->{'_io'} = $io;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
720 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
721 return $self->{'_io'};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
722 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
723
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
724
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
725 =head2 delay
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
726
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
727 Title : delay
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
728 Usage : $secs = $self->delay([$secs])
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
729 Function: get/set number of seconds to delay between fetches
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
730 Returns : number of seconds to delay
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
731 Args : new value
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
732
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
733 NOTE: the default is to use the value specified by delay_policy().
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
734 This can be overridden by calling this method, or by passing the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
735 -delay argument to new().
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
736
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
737 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
738
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
739 sub delay {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
740 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
741 my $d = $self->{'_delay'};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
742 $self->{'_delay'} = shift if @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
743 $d;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
744 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
745
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
746 =head2 delay_policy
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
747
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
748 Title : delay_policy
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
749 Usage : $secs = $self->delay_policy
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
750 Function: return number of seconds to delay between calls to remote db
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
751 Returns : number of seconds to delay
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
752 Args : none
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
753
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
754 NOTE: The default delay policy is 0s. Override in subclasses to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
755 implement delays. The timer has only second resolution, so the delay
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
756 will actually be +/- 1s.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
757
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
758 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
759
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
760 sub delay_policy {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
761 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
762 return 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
763 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
764
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
765 =head2 _sleep
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
766
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
767 Title : _sleep
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
768 Usage : $self->_sleep
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
769 Function: sleep for a number of seconds indicated by the delay policy
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
770 Returns : none
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
771 Args : none
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
772
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
773 NOTE: This method keeps track of the last time it was called and only
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
774 imposes a sleep if it was called more recently than the delay_policy()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
775 allows.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
776
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
777 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
778
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
779 sub _sleep {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
780 my $self = shift;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
781 my $last_invocation = $LAST_INVOCATION_TIME;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
782 if (time - $LAST_INVOCATION_TIME < $self->delay) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
783 my $delay = $self->delay - (time - $LAST_INVOCATION_TIME);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
784 warn "sleeping for $delay seconds\n" if $self->verbose;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
785 sleep $delay;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
786 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
787 $LAST_INVOCATION_TIME = time;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
788 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
789
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
790 1;