Bio/SearchIO/FastHitEventBuilder.pm

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