Bio/SearchIO/FastHitEventBuilder.pm

   1 #
   2 # BioPerl module for Bio::SearchIO::FastHitEventBuilder
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason@bioperl.org>
   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::FastHitEventBuilder - Event Handler for SearchIO events.
  17
  18 =head1 SYNOPSIS
  19
  20   # Do not use this object directly, this object is part of the SearchIO
  21   # event based parsing system.
  22
  23   # to use the FastHitEventBuilder do this
  24
  25   use Bio::SearchIO::FastHitEventBuilder;
  26
  27   my $searchio = Bio::SearchIO->new(-format => $format, -file => $file);
  28
  29   $searchio->attach_EventHandler(Bio::SearchIO::FastHitEventBuilder->new());
  30
  31   while( my $r = $searchio->next_result ) {
  32    while( my $h = $r->next_hit ) {
  33     # note that Hits will NOT have HSPs
  34    }
  35   }
  36
  37 =head1 DESCRIPTION
  38
  39 This object handles Search Events generated by the SearchIO classes
  40 and build appropriate Bio::Search::* objects from them.  This object
  41 is intended for lightweight parsers which only want Hits and not deal
  42 with the overhead of HSPs.  It is a lot faster than the standard
  43 parser event handler but of course you are getting less information
  44 and less objects out.
  45
  46
  47 =head1 FEEDBACK
  48
  49 =head2 Mailing Lists
  50
  51 User feedback is an integral part of the evolution of this and other
  52 Bioperl modules. Send your comments and suggestions preferably to
  53 the Bioperl mailing list.  Your participation is much appreciated.
  54
  55   bioperl-l@bioperl.org                  - General discussion
  56   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  57
  58 =head2 Support
  59
  60 Please direct usage questions or support issues to the mailing list:
  61
  62 I<bioperl-l@bioperl.org>
  63
  64 rather than to the module maintainer directly. Many experienced and
  65 reponsive experts will be able look at the problem and quickly
  66 address it. Please include a thorough description of the problem
  67 with code and data examples if at all possible.
  68
  69 =head2 Reporting Bugs
  70
  71 Report bugs to the Bioperl bug tracking system to help us keep track
  72 of the bugs and their resolution. Bug reports can be submitted via the
  73 web:
  74
  75   https://github.com/bioperl/bioperl-live/issues
  76
  77 =head1 AUTHOR - Jason Stajich
  78
  79 Email jason-at-bioperl.org
  80
  81 =head1 APPENDIX
  82
  83 The rest of the documentation details each of the object methods.
  84 Internal methods are usually preceded with a _
  85
  86 =cut
  87
  88
  89 # Let the code begin...
  90
  91
  92 package Bio::SearchIO::FastHitEventBuilder;
  93 use vars qw(%KNOWNEVENTS);
  94 use strict;
  95
  96 use Bio::Search::HSP::HSPFactory;
  97 use Bio::Search::Hit::HitFactory;
  98 use Bio::Search::Result::ResultFactory;
  99
 100 use base qw(Bio::Root::Root Bio::SearchIO::EventHandlerI);
 101
 102 =head2 new
 103
 104  Title   : new
 105  Usage   : my $obj = Bio::SearchIO::FastHitEventBuilder->new();
 106  Function: Builds a new Bio::SearchIO::FastHitEventBuilder object
 107  Returns : Bio::SearchIO::FastHitEventBuilder
 108  Args    : -hit_factory    => Bio::Factory::ObjectFactoryI
 109            -result_factory => Bio::Factory::ObjectFactoryI
 110
 111 See L<Bio::Factory::ObjectFactoryI> for more information
 112
 113 =cut
 114
 115 sub new {
 116     my ($class,@args) = @_;
 117     my $self = $class->SUPER::new(@args);
 118     my ($hitF,$resultF) = $self->_rearrange([qw(HIT_FACTORY
 119                                                       RESULT_FACTORY)],@args);
 120     $self->register_factory('hit', $hitF ||
 121                             Bio::Factory::ObjectFactory->new(
 122                                       -type      => 'Bio::Search::Hit::GenericHit',
 123                                       -interface => 'Bio::Search::Hit::HitI'));
 124
 125     $self->register_factory('result', $resultF ||
 126                             Bio::Factory::ObjectFactory->new(
 127                                       -type      => 'Bio::Search::Result::GenericResult',
 128                                       -interface => 'Bio::Search::Result::ResultI'));
 129
 130     return $self;
 131 }
 132
 133 # new comes from the superclass
 134
 135 =head2 will_handle
 136
 137  Title   : will_handle
 138  Usage   : if( $handler->will_handle($event_type) ) { ... }
 139  Function: Tests if this event builder knows how to process a specific event
 140  Returns : boolean
 141  Args    : event type name
 142
 143
 144 =cut
 145
 146 sub will_handle{
 147    my ($self,$type) = @_;
 148    # these are the events we recognize
 149    return ( $type eq 'hit' || $type eq 'result' );
 150 }
 151
 152 =head2 SAX methods
 153
 154 =cut
 155
 156 =head2 start_result
 157
 158  Title   : start_result
 159  Usage   : $handler->start_result($resulttype)
 160  Function: Begins a result event cycle
 161  Returns : none
 162  Args    : Type of Report
 163
 164 =cut
 165
 166 sub start_result {
 167    my ($self,$type) = @_;
 168    $self->{'_resulttype'} = $type;
 169    $self->{'_hits'} = [];
 170    return;
 171 }
 172
 173 =head2 end_result
 174
 175  Title   : end_result
 176  Usage   : my @results = $parser->end_result
 177  Function: Finishes a result handler cycle Returns : A Bio::Search::Result::ResultI
 178  Args    : none
 179
 180 =cut
 181
 182 sub end_result {
 183     my ($self,$type,$data) = @_;
 184     if( defined $data->{'runid'} &&
 185         $data->{'runid'} !~ /^\s+$/ ) {
 186
 187         if( $data->{'runid'} !~ /^lcl\|/) {
 188             $data->{"RESULT-query_name"}= $data->{'runid'};
 189         } else {
 190             ($data->{"RESULT-query_name"},$data->{"RESULT-query_description"}) = split(/\s+/,$data->{"RESULT-query_description"},2);
 191         }
 192
 193         if( my @a = split(/\|/,$data->{'RESULT-query_name'}) ) {
 194             my $acc = pop @a ; # this is for accession |1234|gb|AAABB1.1|AAABB1
 195             # this is for |123|gb|ABC1.1|
 196             $acc = pop @a if( ! defined $acc || $acc =~ /^\s+$/);
 197             $data->{"RESULT-query_accession"}= $acc;
 198         }
 199         delete $data->{'runid'};
 200     }
 201     my %args = map { my $v = $data->{$_}; s/RESULT//; ($_ => $v); }
 202                grep { /^RESULT/ } keys %{$data};
 203
 204     $args{'-algorithm'} =  uc( $args{'-algorithm_name'} || $type);
 205     $args{'-hits'}      =  $self->{'_hits'};
 206     my $result = $self->factory('result')->create(%args);
 207     $self->{'_hits'} = [];
 208     return $result;
 209 }
 210
 211 =head2 start_hit
 212
 213  Title   : start_hit
 214  Usage   : $handler->start_hit()
 215  Function: Starts a Hit event cycle
 216  Returns : none
 217  Args    : type of event and associated hashref
 218
 219
 220 =cut
 221
 222 sub start_hit{
 223     my ($self,$type) = @_;
 224     return;
 225 }
 226
 227
 228 =head2 end_hit
 229
 230  Title   : end_hit
 231  Usage   : $handler->end_hit()
 232  Function: Ends a Hit event cycle
 233  Returns : Bio::Search::Hit::HitI object
 234  Args    : type of event and associated hashref
 235
 236
 237 =cut
 238
 239 sub end_hit{
 240     my ($self,$type,$data) = @_;
 241     my %args = map { my $v = $data->{$_}; s/HIT//; ($_ => $v); } grep { /^HIT/ } keys %{$data};
 242     $args{'-algorithm'} =  uc( $args{'-algorithm_name'} || $type);
 243     $args{'-query_len'} =  $data->{'RESULT-query_length'};
 244     my ($hitrank) = scalar @{$self->{'_hits'}} + 1;
 245     $args{'-rank'} = $hitrank;
 246     my $hit = $self->factory('hit')->create(%args);
 247     push @{$self->{'_hits'}}, $hit;
 248     $self->{'_hsps'} = [];
 249     return $hit;
 250 }
 251
 252 =head2 Factory methods
 253
 254 =cut
 255
 256 =head2 register_factory
 257
 258  Title   : register_factory
 259  Usage   : $handler->register_factory('TYPE',$factory);
 260  Function: Register a specific factory for a object type class
 261  Returns : none
 262  Args    : string representing the class and
 263            Bio::Factory::ObjectFactoryI
 264
 265 See L<Bio::Factory::ObjectFactoryI> for more information
 266
 267 =cut
 268
 269 sub register_factory{
 270    my ($self, $type,$f) = @_;
 271    if( ! defined $f || ! ref($f) ||
 272        ! $f->isa('Bio::Factory::ObjectFactoryI') ) {
 273        $self->throw("Cannot set factory to value $f".ref($f)."\n");
 274    }
 275    $self->{'_factories'}->{lc($type)} = $f;
 276 }
 277
 278
 279 =head2 factory
 280
 281  Title   : factory
 282  Usage   : my $f = $handler->factory('TYPE');
 283  Function: Retrieves the associated factory for requested 'TYPE'
 284  Returns : a Bio::Factory::ObjectFactoryI or undef if none registered
 285  Args    : name of factory class to retrieve
 286
 287 See L<Bio::Factory::ObjectFactoryI> for more information
 288
 289 =cut
 290
 291 sub factory{
 292    my ($self,$type) = @_;
 293    return $self->{'_factories'}->{lc($type)} || $self->throw("No factory registered for $type");
 294 }
 295
 296 =head2 inclusion_threshold
 297
 298 See L<Bio::SearchIO::blast::inclusion_threshold>.
 299
 300 =cut
 301
 302 sub inclusion_threshold {
 303     my $self = shift;
 304     return $self->{'_inclusion_threshold'} = shift if @_;
 305     return $self->{'_inclusion_threshold'};
 306 }
 307
 308 1;