annotate variant_effect_predictor/Bio/Tools/Run/RemoteBlast.pm @ 0:1f6dce3d34e0

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