~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to Bio/SearchIO/blast_pull.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# $Id: blast_pull.pm 11480 2007-06-14 14:16:21Z sendu $
 
2
#
 
3
# BioPerl module for Bio::SearchIO::blast_pull
 
4
#
 
5
# Cared for by Sendu Bala <bix@sendu.me.uk>
 
6
#
 
7
# Copyright Sendu Bala
 
8
#
 
9
# You may distribute this module under the same terms as perl itself
 
10
 
 
11
# POD documentation - main docs before the code
 
12
 
 
13
=head1 NAME
 
14
 
 
15
Bio::SearchIO::blast_pull - A parser for BLAST output
 
16
 
 
17
=head1 SYNOPSIS
 
18
 
 
19
    # do not use this class directly it is available through Bio::SearchIO
 
20
    use Bio::SearchIO;
 
21
    my $in = Bio::SearchIO->new(-format => 'blast_pull',
 
22
                               -file   => 't/data/new_blastn.txt');
 
23
    while (my $result = $in->next_result) {
 
24
        # this is a Bio::Search::Result::BlastPullResult object
 
25
        print "Results for ", $result->query_name(), "\n";
 
26
        while (my $hit = $result->next_hit) {
 
27
            print $hit->name(), "\n";
 
28
            while (my $hsp = $hit->next_hsp) {
 
29
                print "length is ", $hsp->length(), "\n";
 
30
            }
 
31
        }
 
32
    }
 
33
 
 
34
=head1 DESCRIPTION
 
35
 
 
36
This object implements a pull-parser for BLAST output. It is fast since it
 
37
only does work on request (hence 'pull').
 
38
 
 
39
Currently only NCBI BLASTN and BLASTP are supported.
 
40
 
 
41
=head1 FEEDBACK
 
42
 
 
43
=head2 Mailing Lists
 
44
 
 
45
User feedback is an integral part of the evolution of this and other
 
46
Bioperl modules. Send your comments and suggestions preferably to
 
47
the Bioperl mailing list.  Your participation is much appreciated.
 
48
 
 
49
  bioperl-l@bioperl.org                  - General discussion
 
50
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 
51
 
 
52
=head2 Reporting Bugs
 
53
 
 
54
Report bugs to the Bioperl bug tracking system to help us keep track
 
55
of the bugs and their resolution. Bug reports can be submitted via the
 
56
web:
 
57
 
 
58
  http://bugzilla.open-bio.org/
 
59
 
 
60
=head1 AUTHOR - Sendu Bala
 
61
 
 
62
Email bix@sendu.me.uk
 
63
 
 
64
=head1 APPENDIX
 
65
 
 
66
The rest of the documentation details each of the object methods.
 
67
Internal methods are usually preceded with a _
 
68
 
 
69
=cut
 
70
 
 
71
# Let the code begin...
 
72
 
 
73
package Bio::SearchIO::blast_pull;
 
74
 
 
75
use strict;
 
76
use Bio::Search::Result::BlastPullResult;
 
77
 
 
78
use base qw(Bio::SearchIO Bio::PullParserI);
 
79
 
 
80
=head2 new
 
81
 
 
82
 Title   : new
 
83
 Usage   : my $obj = Bio::SearchIO::blast_pull->new();
 
84
 Function: Builds a new Bio::SearchIO::blast_pull object 
 
85
 Returns : Bio::SearchIO::blast_pull
 
86
 Args    : -fh/-file => BLAST output filename
 
87
           -format   => 'blast_pull'
 
88
           -evalue   => float or scientific notation number to be used
 
89
                        as an evalue cutoff for hits
 
90
           -score    => integer or scientific notation number to be used
 
91
                        as a score value cutoff for hits
 
92
           -piped_behaviour => 'temp_file'|'memory'|'sequential_read'
 
93
 
 
94
           -piped_behaviour defines what the parser should do if the input is
 
95
            an unseekable filehandle (eg. piped input), see
 
96
            Bio::PullParserI::chunk for details. Default is 'memory'.
 
97
 
 
98
=cut
 
99
 
 
100
sub _initialize {
 
101
    my ($self, @args) = @_;
 
102
    
 
103
    # don't do normal SearchIO initialization
 
104
    
 
105
    my ($writer, $file, $fh, $piped_behaviour, $evalue, $score) =
 
106
                            $self->_rearrange([qw(WRITER
 
107
                                                  FILE FH
 
108
                                                  PIPED_BEHAVIOUR
 
109
                                                  EVALUE
 
110
                                                  SCORE)], @args);
 
111
    $self->writer($writer) if $writer;
 
112
    
 
113
    $self->_fields( { ( header => undef,
 
114
                        algorithm => undef,
 
115
                        algorithm_version => undef,
 
116
                        algorithm_reference => '',
 
117
                        database_name => undef,
 
118
                        database_letters => undef,
 
119
                        database_entries => undef,
 
120
                        next_result => undef,
 
121
                        evalue_cutoff => '[unset]',
 
122
                        score_cutoff => '[unset]' ) } );
 
123
    
 
124
    $self->_fields->{evalue_cutoff} = $evalue if $evalue;
 
125
    $self->_fields->{score_cutoff} = $score if $score;
 
126
    
 
127
    $self->_dependencies( { ( algorithm => 'header',
 
128
                              algorithm_version => 'header',
 
129
                              database_name => 'header',
 
130
                              database_letters => 'header',
 
131
                              database_entries => 'header' ) } );
 
132
    
 
133
    $self->chunk($file || $fh || $self->throw("-file or -fh must be supplied"),
 
134
                 -piped_behaviour => $piped_behaviour || 'memory');
 
135
}
 
136
 
 
137
sub _discover_header {
 
138
    my $self = shift;
 
139
    $self->_chunk_seek(0);
 
140
    my $header = $self->_get_chunk_by_end("\nQuery=");
 
141
    $self->{_after_header} = $self->_chunk_tell;
 
142
    
 
143
    #*** won't catch all types? only support blastn/p now anyway
 
144
    $header =~ /^(\S+) (\S+\s+\S+)/;
 
145
    $self->_fields->{algorithm} = $1;
 
146
    $self->_fields->{algorithm_version} = $2;
 
147
    
 
148
    my ($database) = $header =~ /^Database: (.+)/sm;
 
149
    
 
150
    unless ($database) {
 
151
        # earlier versions put query before database?
 
152
        my $header2 = $self->_get_chunk_by_end(".done\n");
 
153
        ($database) = $header2 =~ /^Database: (.+)/sm;
 
154
    }
 
155
    
 
156
    $database =~ s/\s+(\d\S+) sequences; (\d\S+) total letters.*//s;
 
157
    my $entries = $1;
 
158
    my $letters = $2;
 
159
    $database =~ s/\n//g;
 
160
    $entries =~ s/,//g;
 
161
    $letters =~ s/,//g;
 
162
    $self->_fields->{database_name} = $database;
 
163
    $self->_fields->{database_entries} = $entries;
 
164
    $self->_fields->{database_letters} = $letters;
 
165
    
 
166
    $self->_fields->{header} = 1;
 
167
}
 
168
 
 
169
sub _discover_next_result {
 
170
    my $self = shift;
 
171
    return if $self->{_after_results};
 
172
    my $type = $self->get_field('algorithm'); # also sets _after_header if not set
 
173
    
 
174
    if ($type eq 'BLASTN' || $type eq 'BLASTP') {
 
175
        unless ($self->_sequential) {
 
176
            $self->_chunk_seek($self->{_end_of_previous_result} || $self->{_after_header});
 
177
            
 
178
            my ($start, $end) = $self->_find_chunk_by_end("\nQuery=");
 
179
            return if ($start == $end);
 
180
            
 
181
            unless ($end) {
 
182
                $start = $self->{_end_of_previous_result} || $self->{_after_header};
 
183
                $end = undef;
 
184
            }
 
185
            
 
186
            $self->_fields->{next_result} = Bio::Search::Result::BlastPullResult->new(-chunk => [($self->chunk, $start, $end)],
 
187
                                                                                     -parent => $self);
 
188
            
 
189
            $self->{_end_of_previous_result} = $end;
 
190
        }
 
191
        else {
 
192
            #*** doesn't work for the last result, needs fixing - try getting the database end chunk on failure?...
 
193
            $self->throw("sequential mode not yet implemented");
 
194
            my $chunk = $self->_get_chunk_by_end("\nQuery=");
 
195
            $chunk || return;
 
196
            $self->_fields->{next_result} = Bio::Search::Result::BlastPullResult->new(-chunk => [$chunk],
 
197
                                                                                   -parent => $self);
 
198
        }
 
199
    }
 
200
    else {
 
201
        $self->throw("Can only handle NCBI BLASTN and BLASTP right now");
 
202
    }
 
203
}
 
204
 
 
205
=head2 next_result
 
206
 
 
207
 Title   : next_result
 
208
 Usage   : my $hit = $searchio->next_result;
 
209
 Function: Returns the next Result from a search
 
210
 Returns : Bio::Search::Result::ResultI object
 
211
 Args    : none
 
212
 
 
213
=cut
 
214
 
 
215
sub next_result {
 
216
    my $self = shift;
 
217
    my $result = $self->get_field('next_result') || return;
 
218
    
 
219
    undef $self->_fields->{next_result};
 
220
    
 
221
    $self->{'_result_count'}++;
 
222
    return $result;
 
223
}
 
224
 
 
225
=head2 result_count
 
226
 
 
227
 Title   : result_count
 
228
 Usage   : my $count = $searchio->result_count
 
229
 Function: Returns the number of results we have processed.
 
230
 Returns : integer
 
231
 Args    : none
 
232
 
 
233
=cut
 
234
 
 
235
sub result_count {
 
236
    my $self = shift;
 
237
    return $self->{'_result_count'};
 
238
}
 
239
 
 
240
=head2 rewind
 
241
 
 
242
 Title   : rewind
 
243
 Usage   : $searchio->rewind;
 
244
 Function: Allow one to reset the Result iterator to the beginning, so that
 
245
           next_result() will subsequently return the first result and so on.
 
246
 
 
247
           NB: result objects are not cached, so you will get new result objects
 
248
           each time you rewind. Also, note that result_count() counts the
 
249
           number of times you have called next_result(), so will not be able
 
250
           tell you how many results there were in the file if you use rewind().
 
251
 
 
252
 Returns : n/a
 
253
 Args    : none
 
254
 
 
255
=cut
 
256
 
 
257
sub rewind {
 
258
        my $self = shift;
 
259
        delete $self->{_end_of_previous_result};
 
260
}
 
261
 
 
262
1;