annotate variant_effect_predictor/Bio/Tools/Run/RemoteBlast.pm @ 1:d6778b5d8382 draft default tip

Deleted selected files
author willmclaren
date Fri, 03 Aug 2012 10:05:43 -0400
parents 21066c0abaf5
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
1 # $Id: RemoteBlast.pm,v 1.14.2.2 2003/09/03 18:29:50 jason Exp $
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
2 #
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
3 # BioPerl module for Bio::Tools::Run::RemoteBlast
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
4 #
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
5 # Cared for by Jason Stajich, Mat Wiepert
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
6 #
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
7 # Copyright Jason Stajich
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
8 #
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
9 # You may distribute this module under the same terms as perl itself
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
10
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
11 # POD documentation - main docs before the code
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
12
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
13 =head1 NAME
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
14
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
15 Bio::Tools::Run::RemoteBlast - Object for remote execution of the NCBI Blast
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
16 via HTTP
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
17
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
18 =head1 SYNOPSIS
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
19
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
20 #Remote-blast "factory object" creation and blast-parameter initialization
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
21
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
22 use Bio::Tools::Run::RemoteBlast;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
23 use strict;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
24 my $prog = 'blastp';
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
25 my $db = 'swissprot';
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
26 my $e_val= '1e-10';
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
27
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
28 my @params = ( '-prog' => $prog,
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
29 '-data' => $db,
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
30 '-expect' => $e_val,
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
31 '-readmethod' => 'SearchIO' );
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
32
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
33 my $factory = Bio::Tools::Run::RemoteBlast->new(@params);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
34
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
35 #change a paramter
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
36 $Bio::Tools::Run::RemoteBlast::HEADER{'ENTREZ_QUERY'} = 'Homo sapiens [ORGN]';
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
37
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
38 #remove a parameter
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
39 delete $Bio::Tools::Run::RemoteBlast::HEADER{'FILTER'};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
40
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
41 my $v = 1;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
42 #$v is just to turn on and off the messages
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
43
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
44 my $str = Bio::SeqIO->new(-file=>'amino.fa' , '-format' => 'fasta' );
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
45
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
46 while (my $input = $str->next_seq()){
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
47 #Blast a sequence against a database:
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
48
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
49 #Alternatively, you could pass in a file with many
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
50 #sequences rather than loop through sequence one at a time
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
51 #Remove the loop starting 'while (my $input = $str->next_seq())'
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
52 #and swap the two lines below for an example of that.
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
53 my $r = $factory->submit_blast($input);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
54 #my $r = $factory->submit_blast('amino.fa');
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
55
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
56 print STDERR "waiting..." if( $v > 0 );
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
57 while ( my @rids = $factory->each_rid ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
58 foreach my $rid ( @rids ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
59 my $rc = $factory->retrieve_blast($rid);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
60 if( !ref($rc) ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
61 if( $rc < 0 ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
62 $factory->remove_rid($rid);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
63 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
64 print STDERR "." if ( $v > 0 );
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
65 sleep 5;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
66 } else {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
67 my $result = $rc->next_result();
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
68 #save the output
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
69 my $filename = $result->query_name()."\.out";
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
70 $factory->save_output($filename);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
71 $factory->remove_rid($rid);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
72 print "\nQuery Name: ", $result->query_name(), "\n";
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
73 while ( my $hit = $result->next_hit ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
74 next unless ( $v > 0);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
75 print "\thit name is ", $hit->name, "\n";
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
76 while( my $hsp = $hit->next_hsp ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
77 print "\t\tscore is ", $hsp->score, "\n";
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
78 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
79 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
80 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
81 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
82 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
83 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
84
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
85 # This example shows how to change a CGI parameter:
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
86 $Bio::Tools::Run::RemoteBlast::HEADER{'MATRIX_NAME'} = 'BLOSUM25';
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
87
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
88 # And this is how to delete a CGI parameter:
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
89 delete $Bio::Tools::Run::RemoteBlast::HEADER{'FILTER'};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
90
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
91
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
92 =head1 DESCRIPTION
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
93
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
94 Class for remote execution of the NCBI Blast via HTTP.
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
95
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
96 For a description of the many CGI parameters see:
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
97 http://www.ncbi.nlm.nih.gov/BLAST/Doc/urlapi.html
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
98
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
99 Various additional options and input formats are available.
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
100
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
101 =head1 FEEDBACK
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
102
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
103 =head2 Mailing Lists
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
104
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
105 User feedback is an integral part of the evolution of this and other
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
106 Bioperl modules. Send your comments and suggestions preferably to one
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
107 of the Bioperl mailing lists. Your participation is much appreciated.
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
108
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
109 bioperl-l@bioperl.org - General discussion
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
110 http://bio.perl.org/MailList.html - About the mailing lists
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
111
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
112 =head2 Reporting Bugs
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
113
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
114 Report bugs to the Bioperl bug tracking system to help us keep track
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
115 the bugs and their resolution. Bug reports can be submitted via email
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
116 or the web:
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
117
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
118 bioperl-bugs@bio.perl.org
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
119 http://bio.perl.org/bioperl-bugs/
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
120
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
121 =head1 AUTHOR - Jason Stajich
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
122
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
123 Email jason@bioperl.org
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
124
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
125 =head1 APPENDIX
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
126
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
127 The rest of the documentation details each of the object
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
128 methods. Internal methods are usually preceded with a _
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
129
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
130 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
131
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
132 package Bio::Tools::Run::RemoteBlast;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
133
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
134 use vars qw($AUTOLOAD @ISA %BLAST_PARAMS $URLBASE %HEADER %RETRIEVALHEADER
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
135 $RIDLINE);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
136 use strict;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
137
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
138 use Bio::Root::Root;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
139 use Bio::Root::IO;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
140 use Bio::SeqIO;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
141 use IO::String;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
142 use Bio::Tools::BPlite;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
143 use Bio::SearchIO;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
144 use LWP;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
145 use HTTP::Request::Common;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
146 BEGIN {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
147 $URLBASE = 'http://www.ncbi.nlm.nih.gov/blast/Blast.cgi';
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
148 %HEADER = ('CMD' => 'Put',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
149 'PROGRAM' => '',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
150 'DATABASE' => '',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
151 'FILTER' => 'L',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
152 'EXPECT' => '',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
153 'QUERY' => '',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
154 'CDD_SEARCH' => 'off',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
155 'COMPOSITION_BASED_STATISTICS' => 'off',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
156 'FORMAT_OBJECT' => 'Alignment',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
157 'SERVICE' => 'plain',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
158 );
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
159
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
160 %RETRIEVALHEADER = ('CMD' => 'Get',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
161 'RID' => '',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
162 'ALIGNMENT_VIEW' => 'Pairwise',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
163 'DESCRIPTIONS' => 100,
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
164 'ALIGNMENTS' => 50,
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
165 'FORMAT_TYPE' => 'Text',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
166 );
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
167
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
168 $RIDLINE = 'RID\s+=\s+(\S+)';
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
169
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
170 %BLAST_PARAMS = ( 'prog' => 'blastp',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
171 'data' => 'nr',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
172 'expect' => '1e-3',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
173 'readmethod' => 'SearchIO'
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
174 );
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
175
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
176 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
177
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
178 @ISA = qw(Bio::Root::Root Bio::Root::IO);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
179
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
180 sub new {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
181 my ($caller, @args) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
182 # chained new
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
183 my $self = $caller->SUPER::new(@args);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
184 # so that tempfiles are cleaned up
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
185 $self->_initialize_io();
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
186 my ($prog, $data, $expect,
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
187 $readmethod) = $self->_rearrange([qw(PROG DATA
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
188 EXPECT
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
189 READMETHOD)],
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
190 @args);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
191
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
192 $readmethod = $BLAST_PARAMS{'readmethod'} unless defined $readmethod;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
193 $prog = $BLAST_PARAMS{'prog'} unless defined $prog;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
194 $data = $BLAST_PARAMS{'data'} unless defined $data;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
195 $expect = $BLAST_PARAMS{'expect'} unless defined $expect;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
196 $self->readmethod($readmethod);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
197 $self->program($prog);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
198 $self->database($data);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
199 $self->expect($expect);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
200
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
201 return $self;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
202 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
203
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
204 =head2 header
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
205
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
206 Title : header
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
207 Usage : my $header = $self->header
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
208 Function: Get/Set HTTP header for blast query
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
209 Returns : string
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
210 Args : none
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
211
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
212 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
213
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
214 sub header {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
215 my ($self) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
216 my %h = %HEADER;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
217 $h{'PROGRAM'} = $self->program;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
218 $h{'DATABASE'} = $self->database;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
219 $h{'EXPECT'} = $self->expect;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
220 return %h;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
221 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
222
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
223 =head2 readmethod
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
224
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
225 Title : readmethod
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
226 Usage : my $readmethod = $self->readmethod
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
227 Function: Get/Set the method to read the blast report
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
228 Returns : string
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
229 Args : string [ Blast, BPlite ]
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
230
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
231 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
232
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
233 sub readmethod {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
234 my ($self, $val) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
235 if( defined $val ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
236 $self->{'_readmethod'} = $val;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
237 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
238 return $self->{'_readmethod'};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
239 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
240
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
241
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
242 =head2 program
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
243
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
244 Title : program
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
245 Usage : my $prog = $self->program
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
246 Function: Get/Set the program to run
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
247 Returns : string
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
248 Args : string [ blastp, blastn, blastx, tblastn, tblastx ]
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
249
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
250 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
251
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
252 sub program {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
253 my ($self, $val) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
254 if( defined $val ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
255 $val = lc $val;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
256 if( $val !~ /t?blast[pnx]/ ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
257 $self->warn("trying to set program to an invalid program name ($val) -- defaulting to blastp");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
258 $val = 'blastp';
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
259 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
260 # $self->{'_program'} = $val;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
261 $HEADER{'PROGRAM'} = $val;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
262 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
263 return $HEADER{'PROGRAM'};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
264 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
265
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
266
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
267 =head2 database
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
268
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
269 Title : database
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
270 Usage : my $db = $self->database
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
271 Function: Get/Set the database to search
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
272 Returns : string
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
273 Args : string [ swissprot, nr, nt, etc... ]
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
274
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
275 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
276
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
277 sub database {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
278 my ($self, $val) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
279 if( defined $val ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
280 # $self->{'_database'} = $val;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
281 $HEADER{'DATABASE'} = $val;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
282 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
283 return $HEADER{'DATABASE'};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
284 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
285
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
286
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
287 =head2 expect
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
288
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
289 Title : expect
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
290 Usage : my $expect = $self->expect
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
291 Function: Get/Set the E value cutoff
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
292 Returns : string
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
293 Args : string [ '1e-4' ]
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
294
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
295 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
296
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
297 sub expect {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
298 my ($self, $val) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
299 if( defined $val ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
300 # $self->{'_expect'} = $val;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
301 $HEADER{'EXPECT'} = $val;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
302 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
303 return $HEADER{'EXPECT'};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
304 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
305
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
306 =head2 ua
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
307
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
308 Title : ua
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
309 Usage : my $ua = $self->ua or
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
310 $self->ua($ua)
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
311 Function: Get/Set a LWP::UserAgent for use
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
312 Returns : reference to LWP::UserAgent Object
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
313 Args : none
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
314 Comments: Will create a UserAgent if none has been requested before.
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
315
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
316 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
317
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
318 sub ua {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
319 my ($self, $value) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
320 if( ! defined $self->{'_ua'} ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
321 $self->{'_ua'} = new LWP::UserAgent;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
322 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
323 return $self->{'_ua'};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
324 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
325
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
326 =head2 proxy
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
327
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
328 Title : proxy
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
329 Usage : $httpproxy = $db->proxy('http') or
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
330 $db->proxy(['http','ftp'], 'http://myproxy' )
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
331 Function: Get/Set a proxy for use of proxy
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
332 Returns : a string indicating the proxy
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
333 Args : $protocol : an array ref of the protocol(s) to set/get
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
334 $proxyurl : url of the proxy to use for the specified protocol
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
335
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
336 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
337
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
338 sub proxy {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
339 my ($self,$protocol,$proxy) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
340 return undef if ( !defined $self->ua || !defined $protocol
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
341 || !defined $proxy );
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
342 return $self->ua->proxy($protocol,$proxy);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
343 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
344
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
345 sub add_rid {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
346 my ($self, @vals) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
347 foreach ( @vals ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
348 $self->{'_rids'}->{$_} = 1;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
349 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
350 return scalar keys %{$self->{'_rids'}};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
351 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
352
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
353 sub remove_rid {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
354 my ($self, @vals) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
355 foreach ( @vals ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
356 delete $self->{'_rids'}->{$_};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
357 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
358 return scalar keys %{$self->{'_rids'}};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
359 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
360
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
361 sub each_rid {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
362 my ($self) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
363 return keys %{$self->{'_rids'}};
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
364 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
365
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
366 =head2 submit_blast
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
367
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
368 Title : submit_blast
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
369 Usage : $self->submit_blast([$seq1,$seq2]);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
370 Function: Submit blast jobs to ncbi blast queue on sequence(s)
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
371 Returns : Blast report object as defined by $self->readmethod
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
372 Args : input can be:
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
373 * sequence object
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
374 * array ref of sequence objects
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
375 * filename of file containing fasta formatted sequences
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
376
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
377 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
378
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
379 sub submit_blast {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
380 my ($self, $input) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
381 my @seqs = $self->_load_input($input);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
382 return 0 unless ( @seqs );
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
383 my $tcount = 0;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
384 my %header = $self->header;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
385 foreach my $seq ( @seqs ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
386 #If query has a fasta header, the output has the query line.
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
387 $header{'QUERY'} = ">".(defined $seq->display_id() ? $seq->display_id() : "").
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
388 " ".(defined $seq->desc() ? $seq->desc() : "")."\n".$seq->seq();
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
389 my $request = POST $URLBASE, [%header];
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
390 $self->warn($request->as_string) if ( $self->verbose > 0);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
391 my $response = $self->ua->request( $request);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
392
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
393 if( $response->is_success ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
394 if( $self->verbose > 0 ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
395 my ($tempfh) = $self->tempfile();
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
396 # Hmm, what exactly are we trying to do here?
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
397 print $tempfh $response->content;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
398 close($tempfh);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
399 undef $tempfh;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
400 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
401 my @subdata = split(/\n/, $response->content );
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
402 my $count = 0;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
403 foreach ( @subdata ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
404 if( /$RIDLINE/ ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
405 $count++;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
406 print STDERR $_ if( $self->verbose > 0);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
407 $self->add_rid($1);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
408 last;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
409 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
410 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
411 if( $count == 0 ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
412 $self->warn("req was ". $request->as_string() . "\n");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
413 $self->warn(join('', @subdata));
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
414 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
415 $tcount += $count;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
416 } else {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
417 # should try and be a little more verbose here
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
418 $self->warn("req was ". $request->as_string() . "\n" .
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
419 $response->error_as_HTML);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
420 $tcount = -1;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
421 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
422 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
423 return $tcount;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
424 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
425
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
426 =head2 retrieve_blast
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
427
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
428 Title : retrieve_blast
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
429 Usage : my $blastreport = $blastfactory->retrieve_blast($rid);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
430 Function: Attempts to retrieve a blast report from remote blast queue
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
431 Returns : -1 on error,
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
432 0 on 'job not finished',
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
433 Bio::Tools::BPlite or Bio::Tools::Blast object
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
434 (depending on how object was initialized) on success
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
435 Args : Remote Blast ID (RID)
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
436
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
437 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
438
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
439 sub retrieve_blast {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
440 my($self, $rid) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
441 my (undef,$tempfile) = $self->tempfile();
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
442 my %hdr = %RETRIEVALHEADER;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
443 $hdr{'RID'} = $rid;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
444 my $req = POST $URLBASE, [%hdr];
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
445 if( $self->verbose > 0 ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
446 $self->warn("retrieve request is " . $req->as_string());
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
447 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
448 my $response = $self->ua->request($req, $tempfile);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
449 if( $self->verbose > 0 ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
450 open(TMP, $tempfile) or $self->throw("cannot open $tempfile");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
451 while(<TMP>) { print $_; }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
452 close TMP;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
453 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
454 if( $response->is_success ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
455 my $size = -s $tempfile;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
456 if( $size > 1000 ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
457 my $blastobj;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
458 if( $self->readmethod =~ /BPlite/ ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
459 $blastobj = new Bio::Tools::BPlite(-file => $tempfile);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
460 } else {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
461 $blastobj = new Bio::SearchIO(-file => $tempfile,
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
462 -format => 'blast');
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
463 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
464 #save tempfile
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
465 $self->file($tempfile);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
466 return $blastobj;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
467 } elsif( $size < 500 ) { # search had a problem
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
468 open(ERR, "<$tempfile") or $self->throw("cannot open file $tempfile");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
469 $self->warn(join("", <ERR>));
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
470 close ERR;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
471 return -1;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
472 } else { # still working
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
473 return 0;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
474 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
475 } else {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
476 $self->warn($response->error_as_HTML);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
477 return -1;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
478 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
479 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
480
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
481 =head2 save_output
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
482
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
483 Title : saveoutput
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
484 Usage : my $saveoutput = $self->save_output($filename)
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
485 Function: Method to save the blast report
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
486 Returns : 1 (throws error otherwise)
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
487 Args : string [rid, filename]
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
488
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
489 =cut
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
490
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
491 sub save_output {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
492 my ($self, $filename) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
493 if( ! defined $filename ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
494 $self->throw("Can't save blast output. You must specify a filename to save to.");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
495 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
496 #should be set when retrieving blast
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
497 my $blastfile = $self->file;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
498 #open temp file and output file, have to filter out some HTML
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
499 open(TMP, $blastfile) or $self->throw("cannot open $blastfile");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
500 open(SAVEOUT, ">$filename") or $self->throw("cannot open $filename");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
501 my $seentop=0;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
502 while(<TMP>) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
503 next if (/<pre>/);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
504 if( /^(?:[T]?BLAST[NPX])\s*.+$/i ||
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
505 /^RPS-BLAST\s*.+$/i ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
506 $seentop=1;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
507 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
508 next if !$seentop;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
509 if( $seentop ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
510 print SAVEOUT;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
511 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
512 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
513 close SAVEOUT;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
514 close TMP;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
515 return 1;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
516 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
517
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
518 sub _load_input {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
519 my ($self, $input) = @_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
520
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
521 if( ! defined $input ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
522 $self->throw("Calling remote blast with no input");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
523 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
524 my @seqs;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
525 if( ! ref $input ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
526 if( -e $input ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
527 my $seqio = new Bio::SeqIO(-format => 'fasta', -file => $input);
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
528 while( my $seq = $seqio->next_seq ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
529 push @seqs, $seq;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
530 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
531 } else {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
532 $self->throw("Input $input was not a valid filename");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
533 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
534 } elsif( ref($input) =~ /ARRAY/i ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
535 foreach ( @$input ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
536 if( ref($_) && $_->isa('Bio::PrimarySeqI') ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
537 push @seqs, $_;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
538 } else {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
539 $self->warn("Trying to add a " . ref($_) .
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
540 " but expected a Bio::PrimarySeqI");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
541 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
542 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
543 if( ! @seqs) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
544 $self->throw("Did not pass in valid input -- no sequence objects found");
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
545 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
546 } elsif( $input->isa('Bio::PrimarySeqI') ) {
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
547 push @seqs, $input;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
548 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
549 return @seqs;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
550 }
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
551 1;
21066c0abaf5 Uploaded
willmclaren
parents:
diff changeset
552 __END__