Bio/SearchIO/blast_pull.pm

   1 # $Id$
   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;