| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# |
|
2
|
|
|
|
|
|
|
# BioPerl module for Bio::SearchIO::Writer::TextResultWriter |
|
3
|
|
|
|
|
|
|
# |
|
4
|
|
|
|
|
|
|
# Please direct questions and support issues to |
|
5
|
|
|
|
|
|
|
# |
|
6
|
|
|
|
|
|
|
# Cared for by Jason Stajich |
|
7
|
|
|
|
|
|
|
# |
|
8
|
|
|
|
|
|
|
# Copyright Jason Stajich |
|
9
|
|
|
|
|
|
|
# |
|
10
|
|
|
|
|
|
|
# You may distribute this module under the same terms as perl itself |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# POD documentation - main docs before the code |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Bio::SearchIO::Writer::TextResultWriter - Object to implement writing |
|
17
|
|
|
|
|
|
|
a Bio::Search::ResultI in Text. |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
use Bio::SearchIO; |
|
22
|
|
|
|
|
|
|
use Bio::SearchIO::Writer::TextResultWriter; |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my $in = Bio::SearchIO->new(-format => 'blast', |
|
25
|
|
|
|
|
|
|
-file => shift @ARGV); |
|
26
|
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $writer = Bio::SearchIO::Writer::TextResultWriter->new(); |
|
28
|
|
|
|
|
|
|
my $out = Bio::SearchIO->new(-writer => $writer); |
|
29
|
|
|
|
|
|
|
$out->write_result($in->next_result); |
|
30
|
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
This object implements the SearchWriterI interface which will produce |
|
34
|
|
|
|
|
|
|
a set of Text for a specific Bio::Search::Report::ReportI interface. |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
You can also provide the argument -filters =E \%hash to filter the at |
|
37
|
|
|
|
|
|
|
the hsp, hit, or result level. %hash is an associative array which |
|
38
|
|
|
|
|
|
|
contains any or all of the keys (HSP, HIT, RESULT). The values |
|
39
|
|
|
|
|
|
|
pointed to by these keys would be references to a subroutine which |
|
40
|
|
|
|
|
|
|
expects to be passed an object - one of Bio::Search::HSP::HSPI, |
|
41
|
|
|
|
|
|
|
Bio::Search::Hit::HitI, and Bio::Search::Result::ResultI respectively. |
|
42
|
|
|
|
|
|
|
Each function needs to return a boolean value as to whether or not the |
|
43
|
|
|
|
|
|
|
passed element should be included in the output report - true if it is |
|
44
|
|
|
|
|
|
|
to be included, false if it to be omitted. |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
For example to filter on sequences in the database which are too short |
|
47
|
|
|
|
|
|
|
for your criteria you would do the following. |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
Define a hit filter method |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub hit_filter { |
|
52
|
|
|
|
|
|
|
my $hit = shift; |
|
53
|
|
|
|
|
|
|
return $hit->length E 100; # test if length of the hit sequence |
|
54
|
|
|
|
|
|
|
# long enough |
|
55
|
|
|
|
|
|
|
} |
|
56
|
|
|
|
|
|
|
my $writer = Bio::SearchIO::Writer::TextResultWriter->new( |
|
57
|
|
|
|
|
|
|
-filters => { 'HIT' =E \&hit_filter } |
|
58
|
|
|
|
|
|
|
); |
|
59
|
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
Another example would be to filter HSPs on percent identity, let's |
|
61
|
|
|
|
|
|
|
only include HSPs which are 75% identical or better. |
|
62
|
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub hsp_filter { |
|
64
|
|
|
|
|
|
|
my $hsp = shift; |
|
65
|
|
|
|
|
|
|
return $hsp->percent_identity E 75; |
|
66
|
|
|
|
|
|
|
} |
|
67
|
|
|
|
|
|
|
my $writer = Bio::SearchIO::Writer::TextResultWriter->new( |
|
68
|
|
|
|
|
|
|
-filters => { 'HSP' =E \&hsp_filter } |
|
69
|
|
|
|
|
|
|
); |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
See L for more info on the filter method. |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
This module will use the module Text::Wrap if it is installed to wrap |
|
75
|
|
|
|
|
|
|
the Query description line. If you do not have Text::Wrap installed |
|
76
|
|
|
|
|
|
|
this module will work fine but you won't have the Query line wrapped. |
|
77
|
|
|
|
|
|
|
You will see a warning about this when you first instantiate a |
|
78
|
|
|
|
|
|
|
TextResultWriter - to avoid these warnings from showing up, simply set |
|
79
|
|
|
|
|
|
|
the verbosity upon initialization to -1 like this: my $writer = new |
|
80
|
|
|
|
|
|
|
Bio::SearchIO::Writer::TextResultWriter(-verbose =E -1); |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 FEEDBACK |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 Mailing Lists |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
User feedback is an integral part of the evolution of this and other |
|
87
|
|
|
|
|
|
|
Bioperl modules. Send your comments and suggestions preferably to |
|
88
|
|
|
|
|
|
|
the Bioperl mailing list. Your participation is much appreciated. |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
bioperl-l@bioperl.org - General discussion |
|
91
|
|
|
|
|
|
|
http://bioperl.org/wiki/Mailing_lists - About the mailing lists |
|
92
|
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=head2 Support |
|
94
|
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Please direct usage questions or support issues to the mailing list: |
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
I |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
rather than to the module maintainer directly. Many experienced and |
|
100
|
|
|
|
|
|
|
reponsive experts will be able look at the problem and quickly |
|
101
|
|
|
|
|
|
|
address it. Please include a thorough description of the problem |
|
102
|
|
|
|
|
|
|
with code and data examples if at all possible. |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head2 Reporting Bugs |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Report bugs to the Bioperl bug tracking system to help us keep track |
|
107
|
|
|
|
|
|
|
of the bugs and their resolution. Bug reports can be submitted via the |
|
108
|
|
|
|
|
|
|
web: |
|
109
|
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
https://github.com/bioperl/bioperl-live/issues |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 AUTHOR - Jason Stajich |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Email jason@bioperl.org |
|
115
|
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=head1 APPENDIX |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
The rest of the documentation details each of the object methods. |
|
119
|
|
|
|
|
|
|
Internal methods are usually preceded with a _ |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=cut |
|
122
|
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# Let the code begin... |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
package Bio::SearchIO::Writer::TextResultWriter; |
|
128
|
1
|
|
|
1
|
|
991
|
use vars qw($MaxNameLen $MaxDescLen $AlignmentLineWidth $DescLineLen $TextWrapLoaded); |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
55
|
|
|
129
|
1
|
|
|
1
|
|
5
|
use strict; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
48
|
|
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# Object preamble - inherits from Bio::Root::RootI |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
BEGIN { |
|
134
|
1
|
|
|
1
|
|
2
|
$MaxDescLen = 65; |
|
135
|
1
|
|
|
|
|
2
|
$AlignmentLineWidth = 60; |
|
136
|
1
|
|
|
|
|
1
|
eval { require Text::Wrap; $TextWrapLoaded = 1;}; |
|
|
1
|
|
|
|
|
271
|
|
|
|
1
|
|
|
|
|
2572
|
|
|
137
|
1
|
50
|
|
|
|
36
|
if( $@ ) { |
|
138
|
0
|
|
|
|
|
0
|
$TextWrapLoaded = 0; |
|
139
|
|
|
|
|
|
|
} |
|
140
|
|
|
|
|
|
|
} |
|
141
|
|
|
|
|
|
|
|
|
142
|
1
|
|
|
1
|
|
410
|
use POSIX; |
|
|
1
|
|
|
|
|
6927
|
|
|
|
1
|
|
|
|
|
5
|
|
|
143
|
|
|
|
|
|
|
|
|
144
|
1
|
|
|
1
|
|
3633
|
use base qw(Bio::Root::Root Bio::SearchIO::SearchWriterI); |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
436
|
|
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head2 new |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Title : new |
|
149
|
|
|
|
|
|
|
Usage : my $obj = Bio::SearchIO::Writer::TextResultWriter->new(); |
|
150
|
|
|
|
|
|
|
Function: Builds a new Bio::SearchIO::Writer::TextResultWriter object |
|
151
|
|
|
|
|
|
|
Returns : Bio::SearchIO::Writer::TextResultWriter |
|
152
|
|
|
|
|
|
|
Args : -filters => hashref with any or all of the keys (HSP HIT RESULT) |
|
153
|
|
|
|
|
|
|
which have values pointing to a subroutine reference |
|
154
|
|
|
|
|
|
|
which will expect to get a Hit,HSP, Result object respectively |
|
155
|
|
|
|
|
|
|
-no_wublastlinks => boolean. Do not display WU-BLAST lines even if |
|
156
|
|
|
|
|
|
|
they are parsed out |
|
157
|
|
|
|
|
|
|
Links = (1) |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=cut |
|
160
|
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub new { |
|
162
|
1
|
|
|
1
|
1
|
17
|
my($class,@args) = @_; |
|
163
|
|
|
|
|
|
|
|
|
164
|
1
|
|
|
|
|
8
|
my $self = $class->SUPER::new(@args); |
|
165
|
1
|
|
|
|
|
8
|
my ($filters,$nowublastlinks) = $self->_rearrange([qw(FILTERS |
|
166
|
|
|
|
|
|
|
NO_WUBLASTLINKS)], |
|
167
|
|
|
|
|
|
|
@args); |
|
168
|
1
|
50
|
|
|
|
4
|
if( defined $filters ) { |
|
169
|
0
|
0
|
|
|
|
0
|
if( !ref($filters) =~ /HASH/i ) { |
|
170
|
0
|
|
|
|
|
0
|
$self->warn("Did not provide a hashref for the FILTERS option, ignoring."); |
|
171
|
|
|
|
|
|
|
} else { |
|
172
|
0
|
|
|
|
|
0
|
while( my ($type,$code) = each %{$filters} ) { |
|
|
0
|
|
|
|
|
0
|
|
|
173
|
0
|
|
|
|
|
0
|
$self->filter($type,$code); |
|
174
|
|
|
|
|
|
|
} |
|
175
|
|
|
|
|
|
|
} |
|
176
|
|
|
|
|
|
|
} |
|
177
|
1
|
|
|
|
|
5
|
$self->no_wublastlinks(! $nowublastlinks); |
|
178
|
1
|
50
|
|
|
|
3
|
unless( $TextWrapLoaded ) { |
|
179
|
0
|
|
|
|
|
0
|
$self->warn("Could not load Text::Wrap - the Query Description will not be line wrapped\n"); |
|
180
|
|
|
|
|
|
|
} else { |
|
181
|
1
|
|
|
|
|
2
|
$Text::Wrap::columns = $MaxDescLen; |
|
182
|
|
|
|
|
|
|
} |
|
183
|
1
|
|
|
|
|
8
|
return $self; |
|
184
|
|
|
|
|
|
|
} |
|
185
|
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head2 to_string |
|
188
|
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Purpose : Produces data for each Search::Result::ResultI in a string. |
|
190
|
|
|
|
|
|
|
: This is an abstract method. For some useful implementations, |
|
191
|
|
|
|
|
|
|
: see ResultTableWriter.pm, HitTableWriter.pm, |
|
192
|
|
|
|
|
|
|
: and HSPTableWriter.pm. |
|
193
|
|
|
|
|
|
|
Usage : print $writer->to_string( $result_obj, @args ); |
|
194
|
|
|
|
|
|
|
Argument : $result_obj = A Bio::Search::Result::ResultI object |
|
195
|
|
|
|
|
|
|
: @args = any additional arguments used by your implementation. |
|
196
|
|
|
|
|
|
|
Returns : String containing data for each search Result or any of its |
|
197
|
|
|
|
|
|
|
: sub-objects (Hits and HSPs). |
|
198
|
|
|
|
|
|
|
Throws : n/a |
|
199
|
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub to_string { |
|
203
|
1
|
|
|
1
|
1
|
2
|
my ($self,$result,$num) = @_; |
|
204
|
1
|
|
50
|
|
|
8
|
$num ||= 0; |
|
205
|
1
|
50
|
|
|
|
3
|
return unless defined $result; |
|
206
|
1
|
|
|
|
|
3
|
my $links = $self->no_wublastlinks; |
|
207
|
1
|
|
|
|
|
8
|
my ($resultfilter,$hitfilter, $hspfilter) = ( $self->filter('RESULT'), |
|
208
|
|
|
|
|
|
|
$self->filter('HIT'), |
|
209
|
|
|
|
|
|
|
$self->filter('HSP') ); |
|
210
|
1
|
50
|
33
|
|
|
4
|
return '' if( defined $resultfilter && ! &{$resultfilter}($result) ); |
|
|
0
|
|
|
|
|
0
|
|
|
211
|
|
|
|
|
|
|
|
|
212
|
1
|
|
|
|
|
1
|
my ($qtype,$dbtype,$dbseqtype,$type); |
|
213
|
1
|
|
|
|
|
5
|
my $alg = $result->algorithm; |
|
214
|
|
|
|
|
|
|
|
|
215
|
1
|
50
|
|
|
|
3
|
my $wublast = ($result->algorithm_version =~ /WashU/) ? 1 : 0; |
|
216
|
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# This is actually wrong for the FASTAs I think |
|
218
|
1
|
50
|
0
|
|
|
8
|
if( $alg =~ /T(FAST|BLAST)([XY])/i ) { |
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
219
|
1
|
|
|
|
|
2
|
$qtype = $dbtype = 'translated'; |
|
220
|
1
|
|
|
|
|
2
|
$dbseqtype = $type = 'PROTEIN'; |
|
221
|
|
|
|
|
|
|
} elsif( $alg =~ /T(FAST|BLAST)N/i ) { |
|
222
|
0
|
|
|
|
|
0
|
$qtype = ''; |
|
223
|
0
|
|
|
|
|
0
|
$dbtype = 'translated'; |
|
224
|
0
|
|
|
|
|
0
|
$type = 'PROTEIN'; |
|
225
|
0
|
|
|
|
|
0
|
$dbseqtype = 'NUCLEOTIDE'; |
|
226
|
|
|
|
|
|
|
} elsif( $alg =~ /(FAST|BLAST)N/i || |
|
227
|
|
|
|
|
|
|
$alg =~ /(WABA|EXONERATE)/i ) { |
|
228
|
0
|
|
|
|
|
0
|
$qtype = $dbtype = ''; |
|
229
|
0
|
|
|
|
|
0
|
$type = $dbseqtype = 'NUCLEOTIDE'; |
|
230
|
|
|
|
|
|
|
} elsif( $alg =~ /(FAST|BLAST)P/ || |
|
231
|
|
|
|
|
|
|
$alg =~ /SSEARCH|(HMM|SEARCH|PFAM)/i ) { |
|
232
|
0
|
|
|
|
|
0
|
$qtype = $dbtype = ''; |
|
233
|
0
|
|
|
|
|
0
|
$type = $dbseqtype = 'PROTEIN'; |
|
234
|
|
|
|
|
|
|
} elsif( $alg =~ /(FAST|BLAST)[XY]/i ) { |
|
235
|
0
|
|
|
|
|
0
|
$qtype = 'translated'; |
|
236
|
0
|
|
|
|
|
0
|
$dbtype = 'PROTEIN'; |
|
237
|
0
|
|
|
|
|
0
|
$dbseqtype = $type = 'PROTEIN'; |
|
238
|
|
|
|
|
|
|
} else { |
|
239
|
0
|
|
|
|
|
0
|
print STDERR "algorithm was ", $result->algorithm, " couldn't match\n"; |
|
240
|
|
|
|
|
|
|
} |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
|
|
243
|
1
|
50
|
|
|
|
11
|
my %baselens = ( 'Sbjct:' => ( $dbtype eq 'translated' ) ? 3 : 1, |
|
|
|
50
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
'Query:' => ( $qtype eq 'translated' ) ? 3 : 1); |
|
245
|
|
|
|
|
|
|
|
|
246
|
1
|
|
|
|
|
2
|
my $str; |
|
247
|
1
|
50
|
33
|
|
|
5
|
if( ! defined $num || $num <= 1 ) { |
|
248
|
1
|
|
|
|
|
1
|
$str = &{$self->start_report}($result); |
|
|
1
|
|
|
|
|
4
|
|
|
249
|
|
|
|
|
|
|
} |
|
250
|
|
|
|
|
|
|
|
|
251
|
1
|
|
|
|
|
2
|
$str .= &{$self->title}($result); |
|
|
1
|
|
|
|
|
3
|
|
|
252
|
1
|
|
|
|
|
6
|
$str .= $result->algorithm . " " . $result->algorithm_version . "\n\n\n"; |
|
253
|
1
|
|
33
|
|
|
6
|
$str .= $result->algorithm_reference || $self->algorithm_reference($result); |
|
254
|
1
|
|
|
|
|
5
|
$str .= &{$self->introduction}($result); |
|
|
1
|
|
|
|
|
6
|
|
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
|
|
257
|
1
|
|
|
|
|
3
|
$str .= qq{ |
|
258
|
|
|
|
|
|
|
Score E |
|
259
|
|
|
|
|
|
|
Sequences producing significant alignments: (bits) value |
|
260
|
|
|
|
|
|
|
}; |
|
261
|
1
|
|
|
|
|
2
|
my $hspstr = ''; |
|
262
|
1
|
50
|
|
|
|
15
|
if( $result->can('rewind')) { |
|
263
|
1
|
|
|
|
|
5
|
$result->rewind(); # support stream based parsing routines |
|
264
|
|
|
|
|
|
|
} |
|
265
|
1
|
|
|
|
|
4
|
while( my $hit = $result->next_hit ) { |
|
266
|
20
|
50
|
33
|
|
|
46
|
next if( defined $hitfilter && ! &{$hitfilter}($hit) ); |
|
|
0
|
|
|
|
|
0
|
|
|
267
|
20
|
|
|
|
|
46
|
my $nm = $hit->name(); |
|
268
|
20
|
50
|
|
|
|
36
|
$self->debug( "no $nm for name (".$hit->description(). "\n") |
|
269
|
|
|
|
|
|
|
unless $nm; |
|
270
|
20
|
|
|
|
|
28
|
my ($gi,$acc) = &{$self->id_parser}($nm); |
|
|
20
|
|
|
|
|
43
|
|
|
271
|
20
|
|
|
|
|
54
|
my $p = "%-$MaxDescLen". "s"; |
|
272
|
20
|
|
|
|
|
21
|
my $descsub; |
|
273
|
20
|
|
|
|
|
51
|
my $desc = sprintf("%s %s",$nm,$hit->description); |
|
274
|
20
|
50
|
|
|
|
52
|
if( length($desc) - 3 > $MaxDescLen) { |
|
275
|
20
|
|
|
|
|
62
|
$descsub = sprintf($p, |
|
276
|
|
|
|
|
|
|
substr($desc,0,$MaxDescLen-3) . |
|
277
|
|
|
|
|
|
|
"..."); |
|
278
|
|
|
|
|
|
|
} else { |
|
279
|
0
|
|
|
|
|
0
|
$descsub = sprintf($p,$desc); |
|
280
|
|
|
|
|
|
|
} |
|
281
|
20
|
0
|
|
|
|
57
|
$str .= $wublast ? sprintf("%s %-4s %s\n", |
|
|
|
0
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
$descsub, |
|
283
|
|
|
|
|
|
|
defined $hit->raw_score ? $hit->raw_score : ' ', |
|
284
|
|
|
|
|
|
|
defined $hit->significance ? $hit->significance : '?') : |
|
285
|
|
|
|
|
|
|
sprintf("%s %-4s %s\n", |
|
286
|
|
|
|
|
|
|
$descsub, |
|
287
|
|
|
|
|
|
|
defined $hit->bits ? $hit->bits: ' ', |
|
288
|
|
|
|
|
|
|
defined $hit->significance ? $hit->significance : '?'); |
|
289
|
20
|
|
|
|
|
56
|
my @hsps = $hit->hsps; |
|
290
|
20
|
50
|
|
|
|
43
|
if( @hsps ) { |
|
291
|
20
|
50
|
|
|
|
46
|
$hspstr .= sprintf(">%s %s\n%9sLength = %d\n\n", |
|
292
|
|
|
|
|
|
|
$hit->name, |
|
293
|
|
|
|
|
|
|
defined $hit->description ? $hit->description : '', |
|
294
|
|
|
|
|
|
|
'', # empty is for the %9s in the str formatting |
|
295
|
|
|
|
|
|
|
$hit->length); |
|
296
|
|
|
|
|
|
|
|
|
297
|
20
|
|
|
|
|
43
|
foreach my $hsp ( @hsps ) { |
|
298
|
21
|
50
|
33
|
|
|
38
|
next if( defined $hspfilter && ! &{$hspfilter}($hsp) ); |
|
|
0
|
|
|
|
|
0
|
|
|
299
|
21
|
|
|
|
|
48
|
$hspstr .= sprintf(" Score = %4s bits (%s), Expect = %s", |
|
300
|
|
|
|
|
|
|
$hsp->bits, $hsp->score, $hsp->evalue); |
|
301
|
21
|
50
|
|
|
|
51
|
if( $hsp->pvalue ) { |
|
302
|
0
|
|
|
|
|
0
|
$hspstr .= ", P = ".$hsp->pvalue; |
|
303
|
|
|
|
|
|
|
} |
|
304
|
21
|
|
|
|
|
65
|
$hspstr .= "\n"; |
|
305
|
21
|
|
|
|
|
40
|
$hspstr .= sprintf(" Identities = %d/%d (%d%%)", |
|
306
|
|
|
|
|
|
|
( $hsp->frac_identical('total') * |
|
307
|
|
|
|
|
|
|
$hsp->length('total')), |
|
308
|
|
|
|
|
|
|
$hsp->length('total'), |
|
309
|
|
|
|
|
|
|
POSIX::floor($hsp->frac_identical('total') |
|
310
|
|
|
|
|
|
|
* 100)); |
|
311
|
|
|
|
|
|
|
|
|
312
|
21
|
50
|
|
|
|
55
|
if( $type eq 'PROTEIN' ) { |
|
313
|
21
|
|
|
|
|
42
|
$hspstr .= sprintf(", Positives = %d/%d (%d%%)", |
|
314
|
|
|
|
|
|
|
( $hsp->frac_conserved('total') * |
|
315
|
|
|
|
|
|
|
$hsp->length('total')), |
|
316
|
|
|
|
|
|
|
$hsp->length('total'), |
|
317
|
|
|
|
|
|
|
POSIX::floor($hsp->frac_conserved('total') * 100)); |
|
318
|
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
} |
|
320
|
21
|
50
|
|
|
|
49
|
if( $hsp->gaps ) { |
|
321
|
0
|
|
|
|
|
0
|
$hspstr .= sprintf(", Gaps = %d/%d (%d%%)", |
|
322
|
|
|
|
|
|
|
$hsp->gaps('total'), |
|
323
|
|
|
|
|
|
|
$hsp->length('total'), |
|
324
|
|
|
|
|
|
|
POSIX::floor(100 * $hsp->gaps('total') / |
|
325
|
|
|
|
|
|
|
$hsp->length('total'))); |
|
326
|
|
|
|
|
|
|
} |
|
327
|
21
|
|
|
|
|
33
|
$hspstr .= "\n"; |
|
328
|
21
|
|
|
|
|
48
|
my ($hframe,$qframe) = ( $hsp->hit->frame, |
|
329
|
|
|
|
|
|
|
$hsp->query->frame); |
|
330
|
21
|
|
|
|
|
48
|
my ($hstrand,$qstrand) = ($hsp->hit->strand,$hsp->query->strand); |
|
331
|
|
|
|
|
|
|
# so TBLASTX will have Query/Hit frames |
|
332
|
|
|
|
|
|
|
# BLASTX will have Query frame |
|
333
|
|
|
|
|
|
|
# TBLASTN will have Hit frame |
|
334
|
21
|
50
|
33
|
|
|
46
|
if( $hstrand || $qstrand ) { |
|
335
|
21
|
|
|
|
|
35
|
$hspstr .= " Frame = "; |
|
336
|
21
|
|
|
|
|
31
|
my ($signq, $signh); |
|
337
|
21
|
50
|
|
|
|
46
|
unless( $hstrand ) { |
|
338
|
0
|
|
|
|
|
0
|
$hframe = undef; |
|
339
|
|
|
|
|
|
|
# if strand is null or 0 then it is protein |
|
340
|
|
|
|
|
|
|
# and this no frame |
|
341
|
|
|
|
|
|
|
} else { |
|
342
|
21
|
100
|
|
|
|
41
|
$signh = $hstrand < 0 ? '-' : '+'; |
|
343
|
|
|
|
|
|
|
} |
|
344
|
21
|
50
|
|
|
|
32
|
unless( $qstrand ) { |
|
345
|
0
|
|
|
|
|
0
|
$qframe = undef; |
|
346
|
|
|
|
|
|
|
# if strand is null or 0 then it is protein |
|
347
|
|
|
|
|
|
|
} else { |
|
348
|
21
|
100
|
|
|
|
31
|
$signq =$qstrand < 0 ? '-' : '+'; |
|
349
|
|
|
|
|
|
|
} |
|
350
|
|
|
|
|
|
|
# remember bioperl stores frames as 0,1,2 (GFF way) |
|
351
|
|
|
|
|
|
|
# BLAST reports reports as 1,2,3 so |
|
352
|
|
|
|
|
|
|
# we have to add 1 to the frame values |
|
353
|
21
|
50
|
33
|
|
|
87
|
if( defined $hframe && ! defined $qframe) { |
|
|
|
50
|
33
|
|
|
|
|
|
354
|
0
|
|
|
|
|
0
|
$hspstr .= "$signh".($hframe+1); |
|
355
|
|
|
|
|
|
|
} elsif( defined $qframe && ! defined $hframe) { |
|
356
|
0
|
|
|
|
|
0
|
$hspstr .= "$signq".($qframe+1); |
|
357
|
|
|
|
|
|
|
} else { |
|
358
|
21
|
|
|
|
|
89
|
$hspstr .= sprintf(" %s%d / %s%d", |
|
359
|
|
|
|
|
|
|
$signq,$qframe+1, |
|
360
|
|
|
|
|
|
|
$signh, $hframe+1); |
|
361
|
|
|
|
|
|
|
} |
|
362
|
|
|
|
|
|
|
} |
|
363
|
|
|
|
|
|
|
|
|
364
|
21
|
50
|
33
|
|
|
142
|
if( $links && |
|
|
|
|
33
|
|
|
|
|
|
365
|
|
|
|
|
|
|
$hsp->can('links') && defined(my $lnks = $hsp->links) ) { |
|
366
|
0
|
|
|
|
|
0
|
$hspstr .= sprintf(" Links = %s\n",$lnks); |
|
367
|
|
|
|
|
|
|
} |
|
368
|
21
|
|
|
|
|
30
|
$hspstr .= "\n\n"; |
|
369
|
|
|
|
|
|
|
|
|
370
|
21
|
100
|
50
|
|
|
42
|
my @hspvals = ( {'name' => 'Query:', |
|
|
|
100
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
'seq' => $hsp->query_string, |
|
372
|
|
|
|
|
|
|
'start' => ( $qstrand >= 0 ? |
|
373
|
|
|
|
|
|
|
$hsp->query->start : |
|
374
|
|
|
|
|
|
|
$hsp->query->end), |
|
375
|
|
|
|
|
|
|
'end' => ($qstrand >= 0 ? |
|
376
|
|
|
|
|
|
|
$hsp->query->end : |
|
377
|
|
|
|
|
|
|
$hsp->query->start), |
|
378
|
|
|
|
|
|
|
'index' => 0, |
|
379
|
|
|
|
|
|
|
'direction' => $qstrand || 1 |
|
380
|
|
|
|
|
|
|
}, |
|
381
|
|
|
|
|
|
|
{ 'name' => ' 'x6, # this might need to adjust for long coordinates?? |
|
382
|
|
|
|
|
|
|
'seq' => $hsp->homology_string, |
|
383
|
|
|
|
|
|
|
'start' => undef, |
|
384
|
|
|
|
|
|
|
'end' => undef, |
|
385
|
|
|
|
|
|
|
'index' => 0, |
|
386
|
|
|
|
|
|
|
'direction' => 1 |
|
387
|
|
|
|
|
|
|
}, |
|
388
|
|
|
|
|
|
|
{ 'name' => 'Sbjct:', |
|
389
|
|
|
|
|
|
|
'seq' => $hsp->hit_string, |
|
390
|
|
|
|
|
|
|
'start' => ($hstrand >= 0 ? |
|
391
|
|
|
|
|
|
|
$hsp->hit->start : $hsp->hit->end), |
|
392
|
|
|
|
|
|
|
'end' => ($hstrand >= 0 ? |
|
393
|
|
|
|
|
|
|
$hsp->hit->end : $hsp->hit->start), |
|
394
|
|
|
|
|
|
|
'index' => 0, |
|
395
|
|
|
|
|
|
|
'direction' => $hstrand || 1 |
|
396
|
|
|
|
|
|
|
} |
|
397
|
|
|
|
|
|
|
); |
|
398
|
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
# let's set the expected length (in chars) of the starting number |
|
401
|
|
|
|
|
|
|
# in an alignment block so we can have things line up |
|
402
|
|
|
|
|
|
|
# Just going to try and set to the largest |
|
403
|
|
|
|
|
|
|
|
|
404
|
85
|
|
|
|
|
151
|
my ($numwidth) = sort { $b <=> $a }(length($hspvals[0]->{'start'}), |
|
405
|
|
|
|
|
|
|
length($hspvals[0]->{'end'}), |
|
406
|
|
|
|
|
|
|
length($hspvals[2]->{'start'}), |
|
407
|
21
|
|
|
|
|
123
|
length($hspvals[2]->{'end'})); |
|
408
|
21
|
|
|
|
|
37
|
my $count = 0; |
|
409
|
21
|
|
|
|
|
51
|
while ( $count <= $hsp->length('total') ) { |
|
410
|
21
|
|
|
|
|
44
|
foreach my $v ( @hspvals ) { |
|
411
|
63
|
|
|
|
|
117
|
my $piece = substr($v->{'seq'}, $v->{'index'} +$count, |
|
412
|
|
|
|
|
|
|
$AlignmentLineWidth); |
|
413
|
63
|
|
|
|
|
72
|
my $cp = $piece; |
|
414
|
63
|
|
|
|
|
78
|
my $plen = scalar ( $cp =~ tr/\-//); |
|
415
|
63
|
|
|
|
|
95
|
my ($start,$end) = ('',''); |
|
416
|
63
|
100
|
|
|
|
103
|
if( defined $v->{'start'} ) { |
|
417
|
42
|
|
|
|
|
48
|
$start = $v->{'start'}; |
|
418
|
|
|
|
|
|
|
# since strand can be + or - use the direction |
|
419
|
|
|
|
|
|
|
# to signify which whether to add or subtract from end |
|
420
|
|
|
|
|
|
|
my $d = $v->{'direction'} * ( $AlignmentLineWidth - $plen )* |
|
421
|
42
|
|
|
|
|
80
|
$baselens{$v->{'name'}}; |
|
422
|
42
|
50
|
|
|
|
66
|
if( length($piece) < $AlignmentLineWidth ) { |
|
423
|
|
|
|
|
|
|
$d = (length($piece) - $plen) * $v->{'direction'} * |
|
424
|
42
|
|
|
|
|
56
|
$baselens{$v->{'name'}}; |
|
425
|
|
|
|
|
|
|
} |
|
426
|
42
|
|
|
|
|
52
|
$end = $v->{'start'} + $d - $v->{'direction'}; |
|
427
|
42
|
|
|
|
|
49
|
$v->{'start'} += $d; |
|
428
|
|
|
|
|
|
|
} |
|
429
|
|
|
|
|
|
|
$hspstr .= sprintf("%s %-".$numwidth."s %s %s\n", |
|
430
|
63
|
|
|
|
|
226
|
$v->{'name'}, |
|
431
|
|
|
|
|
|
|
$start, |
|
432
|
|
|
|
|
|
|
$piece, |
|
433
|
|
|
|
|
|
|
$end |
|
434
|
|
|
|
|
|
|
); |
|
435
|
|
|
|
|
|
|
} |
|
436
|
21
|
|
|
|
|
26
|
$count += $AlignmentLineWidth; |
|
437
|
21
|
|
|
|
|
41
|
$hspstr .= "\n"; |
|
438
|
|
|
|
|
|
|
} |
|
439
|
|
|
|
|
|
|
} |
|
440
|
20
|
|
|
|
|
86
|
$hspstr .= "\n"; |
|
441
|
|
|
|
|
|
|
} |
|
442
|
|
|
|
|
|
|
} |
|
443
|
1
|
|
|
|
|
23
|
$str .= "\n\n".$hspstr; |
|
444
|
|
|
|
|
|
|
|
|
445
|
1
|
|
33
|
|
|
6
|
$str .= sprintf(qq{ Database: %s |
|
|
|
|
50
|
|
|
|
|
|
446
|
|
|
|
|
|
|
Posted date: %s |
|
447
|
|
|
|
|
|
|
Number of letters in database: %s |
|
448
|
|
|
|
|
|
|
Number of sequences in database: %s |
|
449
|
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
Matrix: %s |
|
451
|
|
|
|
|
|
|
}, |
|
452
|
|
|
|
|
|
|
$result->database_name(), |
|
453
|
|
|
|
|
|
|
$result->get_statistic('posted_date') || |
|
454
|
|
|
|
|
|
|
POSIX::strftime("%b %d, %Y %I:%M %p",localtime), |
|
455
|
|
|
|
|
|
|
&_numwithcommas($result->database_letters()), |
|
456
|
|
|
|
|
|
|
&_numwithcommas($result->database_entries()), |
|
457
|
|
|
|
|
|
|
$result->get_parameter('matrix') || ''); |
|
458
|
|
|
|
|
|
|
|
|
459
|
1
|
50
|
|
|
|
4
|
if( defined (my $open = $result->get_parameter('gapopen')) ) { |
|
460
|
0
|
|
0
|
|
|
0
|
$str .= sprintf("Gap Penalties Existence: %d, Extension: %d\n", |
|
|
|
|
0
|
|
|
|
|
|
461
|
|
|
|
|
|
|
$open || 0, $result->get_parameter('gapext') || 0); |
|
462
|
|
|
|
|
|
|
} |
|
463
|
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
# skip those params we've already output |
|
465
|
1
|
|
|
|
|
5
|
foreach my $param ( grep { ! /matrix|gapopen|gapext/i } |
|
|
3
|
|
|
|
|
11
|
|
|
466
|
|
|
|
|
|
|
$result->available_parameters ) { |
|
467
|
2
|
|
|
|
|
8
|
$str .= "$param: ". $result->get_parameter($param) ."\n"; |
|
468
|
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
} |
|
470
|
1
|
|
|
|
|
5
|
$str .= "Search Statistics\n"; |
|
471
|
|
|
|
|
|
|
# skip posted date, we already output it |
|
472
|
1
|
|
|
|
|
9
|
foreach my $stat ( sort grep { ! /posted_date/ } |
|
|
27
|
|
|
|
|
45
|
|
|
473
|
|
|
|
|
|
|
$result->available_statistics ) { |
|
474
|
26
|
|
|
|
|
46
|
my $expect = $result->get_parameter('expect'); |
|
475
|
26
|
|
|
|
|
48
|
my $v = $result->get_statistic($stat); |
|
476
|
26
|
100
|
|
|
|
75
|
if( $v =~ /^\d+$/ ) { |
|
477
|
18
|
|
|
|
|
28
|
$v = &_numwithcommas($v); |
|
478
|
|
|
|
|
|
|
} |
|
479
|
26
|
100
|
66
|
|
|
65
|
if( defined $expect && |
|
480
|
|
|
|
|
|
|
$stat eq 'seqs_better_than_cutoff' ) { |
|
481
|
1
|
|
|
|
|
3
|
$str .= "seqs_better_than_$expect: $v\n"; |
|
482
|
|
|
|
|
|
|
} else { |
|
483
|
25
|
|
|
|
|
75
|
my $v = |
|
484
|
|
|
|
|
|
|
$str .= "$stat: $v\n"; |
|
485
|
|
|
|
|
|
|
} |
|
486
|
|
|
|
|
|
|
} |
|
487
|
1
|
|
|
|
|
3
|
$str .= "\n\n"; |
|
488
|
1
|
|
|
|
|
15
|
return $str; |
|
489
|
|
|
|
|
|
|
} |
|
490
|
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
=head2 start_report |
|
493
|
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
Title : start_report |
|
495
|
|
|
|
|
|
|
Usage : $index->start_report( CODE ) |
|
496
|
|
|
|
|
|
|
Function: Stores or returns the code to |
|
497
|
|
|
|
|
|
|
write the start of the block, the block |
|
498
|
|
|
|
|
|
|
and the start of the block of HTML. Useful |
|
499
|
|
|
|
|
|
|
for (for instance) specifying alternative |
|
500
|
|
|
|
|
|
|
HTML if you are embedding the output in |
|
501
|
|
|
|
|
|
|
an HTML page which you have already started. |
|
502
|
|
|
|
|
|
|
(For example a routine returning a null string). |
|
503
|
|
|
|
|
|
|
Returns \&default_start_report (see below) if not |
|
504
|
|
|
|
|
|
|
set. |
|
505
|
|
|
|
|
|
|
Example : $index->start_report( \&my_start_report ) |
|
506
|
|
|
|
|
|
|
Returns : ref to CODE if called without arguments |
|
507
|
|
|
|
|
|
|
Args : CODE |
|
508
|
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=cut |
|
510
|
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub start_report { |
|
512
|
1
|
|
|
1
|
1
|
2
|
my( $self, $code ) = @_; |
|
513
|
1
|
50
|
|
|
|
3
|
if ($code) { |
|
514
|
0
|
|
|
|
|
0
|
$self->{'_start_report'} = $code; |
|
515
|
|
|
|
|
|
|
} |
|
516
|
1
|
|
50
|
|
|
7
|
return $self->{'_start_report'} || \&default_start_report; |
|
517
|
|
|
|
|
|
|
} |
|
518
|
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=head2 default_start_report |
|
520
|
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
Title : default_start_report |
|
522
|
|
|
|
|
|
|
Usage : $self->default_start_report($result) |
|
523
|
|
|
|
|
|
|
Function: The default method to call when starting a report. |
|
524
|
|
|
|
|
|
|
Returns : sting |
|
525
|
|
|
|
|
|
|
Args : First argument is a Bio::Search::Result::ResultI |
|
526
|
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=cut |
|
528
|
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
sub default_start_report { |
|
530
|
1
|
|
|
1
|
1
|
3
|
my ($result) = @_; |
|
531
|
1
|
|
|
|
|
3
|
return ""; |
|
532
|
|
|
|
|
|
|
} |
|
533
|
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=head2 title |
|
535
|
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
Title : title |
|
537
|
|
|
|
|
|
|
Usage : $self->title($CODE) |
|
538
|
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
Function: Stores or returns the code to provide HTML for the given |
|
540
|
|
|
|
|
|
|
BLAST report that will appear at the top of the BLAST report |
|
541
|
|
|
|
|
|
|
HTML output. Useful for (for instance) specifying |
|
542
|
|
|
|
|
|
|
alternative routines to write your own titles. |
|
543
|
|
|
|
|
|
|
Returns \&default_title (see below) if not |
|
544
|
|
|
|
|
|
|
set. |
|
545
|
|
|
|
|
|
|
Example : $index->title( \&my_title ) |
|
546
|
|
|
|
|
|
|
Returns : ref to CODE if called without arguments |
|
547
|
|
|
|
|
|
|
Args : CODE |
|
548
|
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=cut |
|
550
|
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub title { |
|
552
|
1
|
|
|
1
|
1
|
2
|
my( $self, $code ) = @_; |
|
553
|
1
|
50
|
|
|
|
3
|
if ($code) { |
|
554
|
0
|
|
|
|
|
0
|
$self->{'_title'} = $code; |
|
555
|
|
|
|
|
|
|
} |
|
556
|
1
|
|
50
|
|
|
6
|
return $self->{'_title'} || \&default_title; |
|
557
|
|
|
|
|
|
|
} |
|
558
|
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=head2 default_title |
|
560
|
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
Title : default_title |
|
562
|
|
|
|
|
|
|
Usage : $self->default_title($result) |
|
563
|
|
|
|
|
|
|
Function: Provides HTML for the given BLAST report that will appear |
|
564
|
|
|
|
|
|
|
at the top of the BLAST report output. |
|
565
|
|
|
|
|
|
|
Returns : empty for text implementation |
|
566
|
|
|
|
|
|
|
Args : First argument is a Bio::Search::Result::ResultI |
|
567
|
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=cut |
|
569
|
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
sub default_title { |
|
571
|
1
|
|
|
1
|
1
|
3
|
my ($result) = @_; |
|
572
|
1
|
|
|
|
|
2
|
return ""; |
|
573
|
|
|
|
|
|
|
# The HTML implementation |
|
574
|
|
|
|
|
|
|
# return sprintf( |
|
575
|
|
|
|
|
|
|
# qq{Bioperl Reformatted HTML of %s Search Report for %s}, |
|
576
|
|
|
|
|
|
|
# $result->algorithm, |
|
577
|
|
|
|
|
|
|
# $result->query_name()); |
|
578
|
|
|
|
|
|
|
} |
|
579
|
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=head2 introduction |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
Title : introduction |
|
584
|
|
|
|
|
|
|
Usage : $self->introduction($CODE) |
|
585
|
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
Function: Stores or returns the code to provide HTML for the given |
|
587
|
|
|
|
|
|
|
BLAST report detailing the query and the |
|
588
|
|
|
|
|
|
|
database information. |
|
589
|
|
|
|
|
|
|
Useful for (for instance) specifying |
|
590
|
|
|
|
|
|
|
routines returning alternative introductions. |
|
591
|
|
|
|
|
|
|
Returns \&default_introduction (see below) if not |
|
592
|
|
|
|
|
|
|
set. |
|
593
|
|
|
|
|
|
|
Example : $index->introduction( \&my_introduction ) |
|
594
|
|
|
|
|
|
|
Returns : ref to CODE if called without arguments |
|
595
|
|
|
|
|
|
|
Args : CODE |
|
596
|
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=cut |
|
598
|
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
sub introduction { |
|
600
|
1
|
|
|
1
|
1
|
2
|
my( $self, $code ) = @_; |
|
601
|
1
|
50
|
|
|
|
3
|
if ($code) { |
|
602
|
0
|
|
|
|
|
0
|
$self->{'_introduction'} = $code; |
|
603
|
|
|
|
|
|
|
} |
|
604
|
1
|
|
50
|
|
|
7
|
return $self->{'_introduction'} || \&default_introduction; |
|
605
|
|
|
|
|
|
|
} |
|
606
|
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
=head2 default_introduction |
|
608
|
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
Title : default_introduction |
|
610
|
|
|
|
|
|
|
Usage : $self->default_introduction($result) |
|
611
|
|
|
|
|
|
|
Function: Outputs HTML to provide the query |
|
612
|
|
|
|
|
|
|
and the database information |
|
613
|
|
|
|
|
|
|
Returns : string containing HTML |
|
614
|
|
|
|
|
|
|
Args : First argument is a Bio::Search::Result::ResultI |
|
615
|
|
|
|
|
|
|
Second argument is string holding literature citation |
|
616
|
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
=cut |
|
618
|
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
sub default_introduction { |
|
620
|
1
|
|
|
1
|
1
|
5
|
my ($result) = @_; |
|
621
|
|
|
|
|
|
|
|
|
622
|
1
|
|
|
|
|
5
|
return sprintf( |
|
623
|
|
|
|
|
|
|
qq{ |
|
624
|
|
|
|
|
|
|
Query= %s |
|
625
|
|
|
|
|
|
|
(%s letters) |
|
626
|
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
Database: %s |
|
628
|
|
|
|
|
|
|
%s sequences; %s total letters |
|
629
|
|
|
|
|
|
|
}, |
|
630
|
|
|
|
|
|
|
&_linewrap($result->query_name . " " . |
|
631
|
|
|
|
|
|
|
$result->query_description), |
|
632
|
|
|
|
|
|
|
&_numwithcommas($result->query_length), |
|
633
|
|
|
|
|
|
|
$result->database_name(), |
|
634
|
|
|
|
|
|
|
&_numwithcommas($result->database_entries()), |
|
635
|
|
|
|
|
|
|
&_numwithcommas($result->database_letters()), |
|
636
|
|
|
|
|
|
|
); |
|
637
|
|
|
|
|
|
|
} |
|
638
|
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=head2 end_report |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
Title : end_report |
|
642
|
|
|
|
|
|
|
Usage : $self->end_report() |
|
643
|
|
|
|
|
|
|
Function: The method to call when ending a report, this is |
|
644
|
|
|
|
|
|
|
mostly for cleanup for formats which require you to |
|
645
|
|
|
|
|
|
|
have something at the end of the document () |
|
646
|
|
|
|
|
|
|
for HTML |
|
647
|
|
|
|
|
|
|
Returns : string |
|
648
|
|
|
|
|
|
|
Args : none |
|
649
|
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
=cut |
|
651
|
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
sub end_report { |
|
653
|
1
|
|
|
1
|
1
|
3
|
return ""; |
|
654
|
|
|
|
|
|
|
} |
|
655
|
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
# copied from Bio::Index::Fasta |
|
658
|
|
|
|
|
|
|
# useful here as well |
|
659
|
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=head2 id_parser |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
Title : id_parser |
|
663
|
|
|
|
|
|
|
Usage : $index->id_parser( CODE ) |
|
664
|
|
|
|
|
|
|
Function: Stores or returns the code used by record_id to |
|
665
|
|
|
|
|
|
|
parse the ID for record from a string. Useful |
|
666
|
|
|
|
|
|
|
for (for instance) specifying a different |
|
667
|
|
|
|
|
|
|
parser for different flavours of FASTA file. |
|
668
|
|
|
|
|
|
|
Returns \&default_id_parser (see below) if not |
|
669
|
|
|
|
|
|
|
set. If you supply your own id_parser |
|
670
|
|
|
|
|
|
|
subroutine, then it should expect a fasta |
|
671
|
|
|
|
|
|
|
description line. An entry will be added to |
|
672
|
|
|
|
|
|
|
the index for each string in the list returned. |
|
673
|
|
|
|
|
|
|
Example : $index->id_parser( \&my_id_parser ) |
|
674
|
|
|
|
|
|
|
Returns : ref to CODE if called without arguments |
|
675
|
|
|
|
|
|
|
Args : CODE |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=cut |
|
678
|
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
sub id_parser { |
|
680
|
20
|
|
|
20
|
1
|
32
|
my( $self, $code ) = @_; |
|
681
|
|
|
|
|
|
|
|
|
682
|
20
|
50
|
|
|
|
32
|
if ($code) { |
|
683
|
0
|
|
|
|
|
0
|
$self->{'_id_parser'} = $code; |
|
684
|
|
|
|
|
|
|
} |
|
685
|
20
|
|
50
|
|
|
80
|
return $self->{'_id_parser'} || \&default_id_parser; |
|
686
|
|
|
|
|
|
|
} |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=head2 default_id_parser |
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
Title : default_id_parser |
|
693
|
|
|
|
|
|
|
Usage : $id = default_id_parser( $header ) |
|
694
|
|
|
|
|
|
|
Function: The default Fasta ID parser for Fasta.pm |
|
695
|
|
|
|
|
|
|
Returns $1 from applying the regexp /^>\s*(\S+)/ |
|
696
|
|
|
|
|
|
|
to $header. |
|
697
|
|
|
|
|
|
|
Returns : ID string |
|
698
|
|
|
|
|
|
|
Args : a fasta header line string |
|
699
|
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=cut |
|
701
|
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
sub default_id_parser { |
|
703
|
20
|
|
|
20
|
1
|
30
|
my ($string) = @_; |
|
704
|
20
|
|
|
|
|
25
|
my ($gi,$acc); |
|
705
|
20
|
50
|
|
|
|
62
|
if( $string =~ s/gi\|(\d+)\|?// ) |
|
706
|
0
|
|
|
|
|
0
|
{ $gi = $1; $acc = $1;} |
|
|
0
|
|
|
|
|
0
|
|
|
707
|
|
|
|
|
|
|
|
|
708
|
20
|
50
|
|
|
|
118
|
if( $string =~ /(\w+)\|([A-Z\d\.\_]+)(\|[A-Z\d\_]+)?/ ) { |
|
709
|
20
|
50
|
|
|
|
75
|
$acc = defined $2 ? $2 : $1; |
|
710
|
|
|
|
|
|
|
} else { |
|
711
|
0
|
|
|
|
|
0
|
$acc = $string; |
|
712
|
0
|
|
|
|
|
0
|
$acc =~ s/^\s+(\S+)/$1/; |
|
713
|
0
|
|
|
|
|
0
|
$acc =~ s/(\S+)\s+$/$1/; |
|
714
|
|
|
|
|
|
|
} |
|
715
|
20
|
|
|
|
|
48
|
return ($gi,$acc); |
|
716
|
|
|
|
|
|
|
} |
|
717
|
|
|
|
|
|
|
|
|
718
|
0
|
0
|
|
0
|
0
|
0
|
sub MIN { $a <=> $b ? $a : $b; } |
|
719
|
0
|
0
|
|
0
|
0
|
0
|
sub MAX { $a <=> $b ? $b : $a; } |
|
720
|
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=head2 algorithm_reference |
|
723
|
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
Title : algorithm_reference |
|
725
|
|
|
|
|
|
|
Usage : my $reference = $writer->algorithm_reference($result); |
|
726
|
|
|
|
|
|
|
Function: Returns the appropriate Bibliographic reference for the |
|
727
|
|
|
|
|
|
|
algorithm format being produced |
|
728
|
|
|
|
|
|
|
Returns : String |
|
729
|
|
|
|
|
|
|
Args : L to reference |
|
730
|
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=cut |
|
733
|
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
sub algorithm_reference{ |
|
735
|
0
|
|
|
0
|
1
|
0
|
my ($self,$result) = @_; |
|
736
|
0
|
0
|
0
|
|
|
0
|
return '' if( ! defined $result || !ref($result) || |
|
|
|
|
0
|
|
|
|
|
|
737
|
|
|
|
|
|
|
! $result->isa('Bio::Search::Result::ResultI')) ; |
|
738
|
0
|
0
|
|
|
|
0
|
if( $result->algorithm =~ /BLAST/i ) { |
|
|
|
0
|
|
|
|
|
|
|
739
|
0
|
|
|
|
|
0
|
my $res = $result->algorithm . ' '. $result->algorithm_version. "\n"; |
|
740
|
0
|
0
|
|
|
|
0
|
if( $result->algorithm_version =~ /WashU/i ) { |
|
741
|
0
|
|
|
|
|
0
|
return $res .qq{ |
|
742
|
|
|
|
|
|
|
Copyright (C) 1996-2000 Washington University, Saint Louis, Missouri USA. |
|
743
|
|
|
|
|
|
|
All Rights Reserved. |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
Reference: Gish, W. (1996-2000) http://blast.wustl.edu |
|
746
|
|
|
|
|
|
|
}; |
|
747
|
|
|
|
|
|
|
} else { |
|
748
|
0
|
|
|
|
|
0
|
return $res . qq{ |
|
749
|
|
|
|
|
|
|
Reference: Altschul, Stephen F., Thomas L. Madden, Alejandro A. Schaffer, |
|
750
|
|
|
|
|
|
|
Jinghui Zhang, Zheng Zhang, Webb Miller, and David J. Lipman (1997), |
|
751
|
|
|
|
|
|
|
"Gapped BLAST and PSI-BLAST: a new generation of protein database search |
|
752
|
|
|
|
|
|
|
programs", Nucleic Acids Res. 25:3389-3402. |
|
753
|
|
|
|
|
|
|
}; |
|
754
|
|
|
|
|
|
|
} |
|
755
|
|
|
|
|
|
|
} elsif( $result->algorithm =~ /FAST/i ) { |
|
756
|
0
|
|
|
|
|
0
|
return $result->algorithm. " ". $result->algorithm_version . "\n". |
|
757
|
|
|
|
|
|
|
"\nReference: Pearson et al, Genomics (1997) 46:24-36\n"; |
|
758
|
|
|
|
|
|
|
} else { |
|
759
|
0
|
|
|
|
|
0
|
return ''; |
|
760
|
|
|
|
|
|
|
} |
|
761
|
|
|
|
|
|
|
} |
|
762
|
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
# from Perl Cookbook 2.17 |
|
764
|
|
|
|
|
|
|
sub _numwithcommas { |
|
765
|
23
|
|
|
23
|
|
32
|
my $num = reverse( $_[0] ); |
|
766
|
23
|
|
|
|
|
81
|
$num =~ s/(\d{3})(?=\d)(?!\d*\.)/$1,/g; |
|
767
|
23
|
|
|
|
|
70
|
return scalar reverse $num; |
|
768
|
|
|
|
|
|
|
} |
|
769
|
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
sub _linewrap { |
|
771
|
1
|
|
|
1
|
|
3
|
my ($str) = @_; |
|
772
|
1
|
50
|
|
|
|
5
|
if($TextWrapLoaded) { |
|
773
|
1
|
|
|
|
|
8
|
return Text::Wrap::wrap("","",$str); # use Text::Wrap |
|
774
|
0
|
|
|
|
|
0
|
} else { return $str; } # cannot wrap |
|
775
|
|
|
|
|
|
|
} |
|
776
|
|
|
|
|
|
|
=head2 Methods Bio::SearchIO::SearchWriterI |
|
777
|
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
L inherited methods. |
|
779
|
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=head2 filter |
|
781
|
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
Title : filter |
|
783
|
|
|
|
|
|
|
Usage : $writer->filter('hsp', \&hsp_filter); |
|
784
|
|
|
|
|
|
|
Function: Filter out either at HSP,Hit,or Result level |
|
785
|
|
|
|
|
|
|
Returns : none |
|
786
|
|
|
|
|
|
|
Args : string => data type, |
|
787
|
|
|
|
|
|
|
CODE reference |
|
788
|
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=cut |
|
791
|
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
=head2 no_wublastlinks |
|
793
|
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
Title : no_wublastlinks |
|
795
|
|
|
|
|
|
|
Usage : $obj->no_wublastlinks($newval) |
|
796
|
|
|
|
|
|
|
Function: Get/Set boolean value regarding whether or not to display |
|
797
|
|
|
|
|
|
|
Link = (1) |
|
798
|
|
|
|
|
|
|
type output in the report output (WU-BLAST only) |
|
799
|
|
|
|
|
|
|
Returns : boolean |
|
800
|
|
|
|
|
|
|
Args : on set, new boolean value (a scalar or undef, optional) |
|
801
|
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=cut |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
sub no_wublastlinks{ |
|
806
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
|
807
|
|
|
|
|
|
|
|
|
808
|
2
|
100
|
|
|
|
11
|
return $self->{'no_wublastlinks'} = shift if @_; |
|
809
|
1
|
|
|
|
|
3
|
return $self->{'no_wublastlinks'}; |
|
810
|
|
|
|
|
|
|
} |
|
811
|
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
1; |