t/AlignIO/AlignIO.t: fix number of tests in plan (fixup c523e6bed866)
[bioperl-live.git] / Bio / Tools / Analysis / Protein / NetPhos.pm
blob81543d70bbeafbbfa428130a54feb155e0f77510
2 # BioPerl module for Bio::Tools::Analysis::Protein::NetPhos
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Heikki Lehvaslaiho <heikki-at-bioperl-dot-org>
8 # Copyright Richard Adams
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
14 =head1 NAME
16 Bio::Tools::Analysis::Protein::NetPhos - a wrapper around NetPhos server
18 =head1 SYNOPSIS
20 use Bio::Tools::Analysis::Protein::NetPhos;
22 my $seq; # a Bio::PrimarySeqI object
23 my $threshold = "0.90";
25 my $netphos = Bio::Tools::Analysis::Protein::NetPhos->new
26 ( -seq => $seq,
27 -threshold => $threshold );
29 # run NetPhos prediction on a sequence
30 my $netphos->run();
32 # alternatively you can say
33 $netphos->seq($seq)->threshold($threshold)->run;
35 die "Could not get a result" unless $netphos->status =~ /^COMPLETED/;
37 print $netphos->result; # print raw prediction to STDOUT
39 foreach my $feat ( $netphos->result('Bio::SeqFeatureI') ) {
41 # do something to SeqFeature
42 # e.g. print as GFF
43 print $feat->gff_string, "\n";
44 # or store within the sequence - if it is a Bio::RichSeqI
45 $seq->add_SeqFeature($feat)
49 =head1 DESCRIPTION
51 This class is wrapper around the NetPhos 2.0 server which produces
52 neural network predictions for serine, threonine and tyrosine
53 phosphorylation sites in eukaryotic proteins.
55 See L<http://www.cbs.dtu.dk/services/NetPhos/>.
57 This the first implementation of Bio::SimpleAnalysisI which hopefully
58 will make it easier to write wrappers on various services. This class
59 uses a web resource and therefore inherits from Bio::WebAgent.
61 =head1 SEE ALSO
63 L<Bio::SimpleAnalysisI>,
64 L<Bio::WebAgent>
66 =head1 FEEDBACK
68 =head2 Mailing Lists
70 User feedback is an integral part of the evolution of this and other
71 Bioperl modules. Send your comments and suggestions preferably to one
72 of the Bioperl mailing lists. Your participation is much appreciated.
74 bioperl-l@bioperl.org - General discussion
75 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
77 =head2 Support
79 Please direct usage questions or support issues to the mailing list:
81 I<bioperl-l@bioperl.org>
83 rather than to the module maintainer directly. Many experienced and
84 reponsive experts will be able look at the problem and quickly
85 address it. Please include a thorough description of the problem
86 with code and data examples if at all possible.
88 =head2 Reporting Bugs
90 Report bugs to the Bioperl bug tracking system to help us keep track
91 the bugs and their resolution. Bug reports can be submitted via the
92 web:
94 https://github.com/bioperl/bioperl-live/issues
96 =head1 AUTHORS
98 Richard Adams, Richard.Adams@ed.ac.uk,
99 Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
101 =head1 APPENDIX
103 The rest of the documentation details each of the object
104 methods. Internal methods are usually preceded with a _
106 =cut
109 # Let the code begin...
112 package Bio::Tools::Analysis::Protein::NetPhos;
113 use vars qw($FLOAT);
114 use strict;
115 use IO::String;
116 use Bio::SeqIO;
117 use HTTP::Request::Common qw (POST);
118 use Bio::SeqFeature::Generic;
120 use base qw(Bio::Tools::Analysis::SimpleAnalysisBase);
122 $FLOAT = '[+-]?\d*\.\d*';
123 my $URL = 'http://www.cbs.dtu.dk/cgi-bin/nph-webface';
126 my $ANALYSIS_SPEC =
128 'name' => 'NetPhos',
129 'type' => 'Protein',
130 'version' => '2.0',
131 'supplier' => 'Center for Biological Sequence Analysis,
132 Technical University of Denmark',
133 'description' => 'Prediction of serine, threonine and tyrosine
134 phosphorylation sites in eukaryotic proteins',
137 my $INPUT_SPEC =
140 'mandatory' => 'true',
141 'type' => 'Bio::PrimarySeqI',
142 'name' => 'seq',
145 'mandatory' => 'false',
146 'type' => 'float',
147 'name' => 'threshold',
148 'default' => 0.8,
152 my $RESULT_SPEC =
154 '' => 'bulk', # same as undef
155 'Bio::SeqFeatureI' => 'ARRAY of Bio::SeqFeeature::Generic',
156 'raw' => 'Array of [ position, score, residue ]'
160 =head2 result
162 Name : result
163 Usage : $job->result (...)
164 Returns : a result created by running an analysis
165 Args : none (but an implementation may choose
166 to add arguments for instructions how to process
167 the raw result)
169 The method returns a scalar representing a result of an executed
170 job. If the job was terminated by an error the result may contain an
171 error message instead of the real data (or both, depending on the
172 implementation).
174 This implementation returns differently processed data depending on
175 argument:
177 =over 3
179 =item undef
181 Returns the raw ASCII data stream but without HTML tags
183 =item 'Bio::SeqFeatureI'
185 The argument string defined the type of bioperl objects returned in an
186 array. The objects are L<Bio::SeqFeature::Generic>.
188 =item anything else
190 Array of array references of [ position, score, residue].
193 =back
196 =cut
198 sub result {
199 my ($self,$value) = @_;
201 my @predictions;
202 my @fts;
204 if ($value ) {
206 my $result = IO::String->new($self->{'_result'});
207 while (<$result>) {
208 next if /^____/;
209 /^\S+ +(\d+) +\w+ +(0\.\d+) +.([STY])/;
210 next unless $3 and $2 > $self->threshold;
211 push @predictions, [$1, $2, $3];
213 if ($value eq 'Bio::SeqFeatureI') {
214 foreach (@predictions) {
215 push @fts, Bio::SeqFeature::Generic->new
216 (-start => $_->[0],
217 -end => $_->[0] ,
218 -source => 'NetPhos',
219 -primary => 'Site',
220 -tag => {
221 score => $_->[1],
222 residue => $_->[2] });
224 return @fts;
226 return \@predictions;
229 return $self->{'_result'};
232 =head2 threshold
234 Usage : $job->threshold(...)
235 Returns : The significance threshold of a prediction
236 Args : None (retrieves value) or a value between 0 and 1.
237 Purpose : Get/setter of the threshold to be sumitted for analysis.
239 =cut
241 sub threshold {
242 my ($self,$value) = @_;
243 if( defined $value) {
244 if ( $value !~ /$FLOAT/ or $value < 0 or $value > 1 ) {
245 $self->throw("I need a value between 0 and 1 , not [". $value. "]")
247 $self->{'_threshold'} = $value;
248 return $self;
250 return $self->{'_threshold'} || $self->input_spec->[1]{'default'} ;
253 sub _init
255 my $self = shift;
256 $self->url($URL);
257 $self->{'_ANALYSIS_SPEC'} =$ANALYSIS_SPEC;
258 $self->{'_INPUT_SPEC'} =$INPUT_SPEC;
259 $self->{'_RESULT_SPEC'} =$RESULT_SPEC;
260 $self->{'_ANALYSIS_NAME'} =$ANALYSIS_SPEC->{name};
261 return $self;
264 sub _run {
265 my $self = shift;
267 # format the sequence into fasta
268 my $seq_fasta;
269 my $stringfh = IO::String->new($seq_fasta);
270 my $seqout = Bio::SeqIO->new(-fh => $stringfh,
271 -format => 'fasta');
272 $seqout->write_seq($self->seq);
273 $self->debug($seq_fasta);
275 # delay repeated calls by default by 3 sec, set delay() to change
276 $self->sleep;
278 $self->status('TERMINATED_BY_ERROR');
280 my $request = POST $self->url,
281 Content_Type => 'form-data',
282 Content => [configfile => '/usr/opt/www/pub/CBS/services/NetPhos-2.0/NetPhos.cf',
283 SEQPASTE => $seq_fasta];
284 my $content = $self->request($request);
285 my $text = $content->content;
287 my ($result_url) = $text =~ /follow <a href="(.*?)"/;
288 return 0 unless $result_url;
289 $self->debug("url is $result_url\n\n");
291 my $ua2 = $self->clone;
292 my $content2 = $ua2->request(POST $result_url);
294 my $ua3 = $self->clone;
295 $result_url =~ s/&.*//;
296 $self->debug("final result url is $result_url\n");
297 my $content3 = $ua3->request(POST $result_url);
298 #print Dumper $content3;
299 my $response = $content3->content;
302 $response =~ s/.*<pre>(.*)<\/pre>.*/$1/s;
303 $response =~ s/<.*?>//gs;
305 $self->{'_result'} = $response;
307 $self->status('COMPLETED') if $response ne '';