Bio/SearchIO/sim4.pm

   1 #
   2 # BioPerl module for Bio::SearchIO::sim4
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason-at-bioperl-dot-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::sim4 - parser for Sim4 alignments
  17
  18 =head1 SYNOPSIS
  19
  20   # do not use this module directly, it is a driver for SearchIO
  21   use Bio::SearchIO;
  22   my $searchio = Bio::SearchIO->new(-file => 'results.sim4',
  23                                    -format => 'sim4');
  24
  25   while ( my $result = $searchio->next_result ) {
  26       while ( my $hit = $result->next_hit ) {
  27           while ( my $hsp = $hit->next_hsp ) {
  28               # ...
  29           }
  30       }
  31   }
  32
  33 =head1 DESCRIPTION
  34
  35 This is a driver for the SearchIO system for parsing Sim4.
  36 http://globin.cse.psu.edu/html/docs/sim4.html
  37
  38 Cannot parse LAV or 'exon file' formats (A=2 or A=5)
  39
  40 =head1 FEEDBACK
  41
  42 =head2 Mailing Lists
  43
  44 User feedback is an integral part of the evolution of this and other
  45 Bioperl modules. Send your comments and suggestions preferably to
  46 the Bioperl mailing list.  Your participation is much appreciated.
  47
  48   bioperl-l@bioperl.org                  - General discussion
  49   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  50
  51 =head2 Support
  52
  53 Please direct usage questions or support issues to the mailing list:
  54
  55 I<bioperl-l@bioperl.org>
  56
  57 rather than to the module maintainer directly. Many experienced and
  58 reponsive experts will be able look at the problem and quickly
  59 address it. Please include a thorough description of the problem
  60 with code and data examples if at all possible.
  61
  62 =head2 Reporting Bugs
  63
  64 Report bugs to the Bioperl bug tracking system to help us keep track
  65 of the bugs and their resolution. Bug reports can be submitted via the
  66 web:
  67
  68   https://redmine.open-bio.org/projects/bioperl/
  69
  70 =head1 AUTHOR - Jason Stajich
  71
  72 Email jason-at-bioperl-dot-org
  73
  74 =head1 CONTRIBUTORS
  75
  76 Luc Gauthier (lgauthie@hotmail.com)
  77
  78 =head1 APPENDIX
  79
  80 The rest of the documentation details each of the object methods.
  81 Internal methods are usually preceded with a _
  82
  83 =cut
  84
  85
  86 # Let the code begin...
  87
  88
  89 package Bio::SearchIO::sim4;
  90
  91 use strict;
  92 use vars qw($DEFAULTFORMAT %ALIGN_TYPES
  93             %MAPPING %MODEMAP $DEFAULT_WRITER_CLASS);
  94
  95 use POSIX;
  96 use Bio::SearchIO::SearchResultEventBuilder;
  97
  98 use base qw(Bio::SearchIO);
  99
 100 $DEFAULTFORMAT = 'SIM4';
 101 $DEFAULT_WRITER_CLASS = 'Bio::SearchIO::Writer::HitTableWriter';
 102
 103 %ALIGN_TYPES = (
 104     0 => 'Ruler',
 105     1 => 'Query',
 106     2 => 'Mid',
 107     3 => 'Sbjct'
 108 );
 109
 110 %MODEMAP = (
 111     'Sim4Output' => 'result',
 112     'Hit'        => 'hit',
 113     'Hsp'        => 'hsp'
 114 );
 115
 116 %MAPPING = (
 117     'Hsp_query-from'=>  'HSP-query_start',
 118     'Hsp_query-to'  =>  'HSP-query_end',
 119     'Hsp_qseq'      =>  'HSP-query_seq',
 120     'Hsp_qlength'   =>  'HSP-query_length',
 121     'Hsp_querygaps'  => 'HSP-query_gaps',
 122     'Hsp_hit-from'  =>  'HSP-hit_start',
 123     'Hsp_hit-to'    =>  'HSP-hit_end',
 124     'Hsp_hseq'      =>  'HSP-hit_seq',
 125     'Hsp_hlength'   =>  'HSP-hit_length',
 126     'Hsp_hitgaps'    => 'HSP-hit_gaps',
 127     'Hsp_midline'   =>  'HSP-homology_seq',
 128     'Hsp_score'     =>  'HSP-score',
 129     'Hsp_align-len' =>  'HSP-hsp_length',
 130     'Hsp_identity'  =>  'HSP-identical',
 131
 132     'Hit_id'        => 'HIT-name',
 133     'Hit_desc'      => 'HIT-description',
 134     'Hit_len'       => 'HIT-length',
 135
 136     'Sim4Output_program'   => 'RESULT-algorithm_name',
 137     'Sim4Output_query-def' => 'RESULT-query_name',
 138     'Sim4Output_query-desc'=> 'RESULT-query_description',
 139     'Sim4Output_query-len' => 'RESULT-query_length',
 140 );
 141
 142
 143
 144 =head2 new
 145
 146  Title   : new
 147  Usage   : my $obj = Bio::SearchIO::sim4->new();
 148  Function: Builds a new Bio::SearchIO::sim4 object
 149  Returns : an instance of Bio::SearchIO::sim4
 150  Args    :
 151
 152
 153 =cut
 154
 155
 156 =head2 next_result
 157
 158  Title   : next_result
 159  Usage   : my $result = $searchio->next_result;
 160  Function: Returns the next Result from a search
 161  Returns : Bio::Search::Result::ResultI object
 162  Args    : none
 163
 164 =cut
 165
 166 sub next_result {
 167     my ($self) = @_;
 168     local $/ = "\n";
 169     local $_;
 170
 171     # Declare/adjust needed variables
 172     $self->{'_last_data'} = '';
 173     my ($seentop, $qfull, @hsps, %alignment, $format);
 174     my $hit_direction = 1;
 175
 176     # Start document and main element
 177     $self->start_document();
 178     $self->start_element({'Name' => 'Sim4Output'});
 179     my $lastquery = '';
 180     # Read output report until EOF
 181     while( defined($_ = $self->_readline) ) {
 182         # Skip empty lines, chomp filled ones
 183         next if( /^\s+$/); chomp;
 184
 185         # Make sure sim4 output format is not 2 or 5
 186         if (!$seentop) {
 187             if ( /^\#:lav/ ) { $format = 2; }
 188             elsif ( /^<|>/ ) { $format = 5; }
 189             $self->throw("Bio::SearchIO::sim4 module cannot parse 'type $format' outputs.") if $format;
 190         }
 191
 192         # This line indicates the start of a new hit
 193         if( /^seq1\s*=\s*(\S+),\s+(\d+)/ ) {
 194             my ($nm,$desc) = ($1,$2);
 195             # First hit? Adjust some parameters if so
 196             if ( ! $seentop ) {
 197                 $self->element( {'Name' => 'Sim4Output_query-def',
 198                                  'Data' => $nm} );
 199                 $self->element( {'Name' => 'Sim4Output_query-len',
 200                                  'Data' => $desc} );
 201                 $seentop = 1;
 202             } elsif( $nm ne $lastquery ) {
 203                 $self->_pushback($_);
 204                 last;
 205             }
 206             $lastquery = $nm;
 207             # A previous HSP may need to be ended
 208             $self->end_element({'Name' => 'Hsp'}) if ( $self->in_element('hsp') );
 209             # A previous hit exists? End it and reset needed variables
 210             if ( $self->in_element('hit') ) {
 211                 foreach (@hsps) {
 212                     $self->start_element({'Name' => 'Hsp'});
 213                     while (my ($name, $data) = each %$_) {
 214                         $self->{'_currentHSP'}{$name} = $data;
 215                     }
 216                     $self->end_element({'Name' => 'Hsp'});
 217                     $self->{'_currentHSP'} = {};
 218                 }
 219                 $format = 0 if @hsps;
 220                 @hsps = ();
 221                 %alignment = ();
 222                 $qfull = 0;
 223                 $hit_direction = 1;
 224                 $self->end_element({'Name' => 'Hit'});
 225             }
 226
 227         # This line describes the current hit... so let's start it
 228         } elsif( /^seq2\s*=\s*(\S+)\s+\(>?(\S+)\s*\),\s*(\d+)/ ) {
 229             $self->start_element({'Name' => 'Hit'});
 230             $self->element( {'Name' => 'Hit_id', 'Data' => $2} );
 231             $self->element( {'Name' => 'Hit_desc', 'Data' => $1} );
 232             $self->element( {'Name' => 'Hit_len', 'Data' => $3} );
 233
 234         # This line may give additional details about query or subject
 235         } elsif( /^>(\S+)\s*(.*)?/ ) {
 236             # Previous line was query details... this time subject details
 237             if( $qfull )  {
 238                 $format = 4 if !$format;
 239                 $self->element({'Name' => 'Hit_desc', 'Data' => $2});
 240             # First line of this type is always query details for a given hit
 241             } else {
 242                 $self->element({'Name' => 'Sim4Output_query-desc', 'Data' => $2});
 243                 $qfull = 1;
 244             }
 245
 246         # This line indicates that subject is on reverse strand
 247         } elsif( /^\(complement\)/ ) {
 248             $hit_direction = -1;
 249
 250         # This line describes the current HSP... so add it to @hsps array
 251         } elsif( /^\(?(\d+)\-(\d+)\)?\s+\(?(\d+)\-(\d+)\)?\s+(\d+)/ ) {
 252                 my ($qs,$qe,$hs,$he,$pid) = ($1,$2,$3,$4,$5);
 253                 push @hsps, {
 254                     'Hsp_query-from' => $qs,
 255                     'Hsp_query-to' => $qe,
 256                     'Hsp_hit-from' => $hit_direction >= 0 ? $hs : $he,
 257                     'Hsp_hit-to' => $hit_direction >= 0 ? $he : $hs,
 258                     'Hsp_identity' => 0, #can't determine correctly from raw pct
 259                     'Hsp_qlength' => abs($qe - $qs) + 1,
 260                     'Hsp_hlength' => abs($he - $hs) + 1,
 261                     'Hsp_align-len' => abs($qe - $qs) + 1,
 262                 };
 263
 264         # This line indicates the start of an alignment block
 265         } elsif( /^\s+(\d+)\s/ ) {
 266             # Store the current alignment block in a hash
 267             for( my $i = 0; defined($_) && $i < 4; $i++ ) {
 268                 my ($start, $string) = /^\s+(\d*)\s(.*)/;
 269                 $alignment{$ALIGN_TYPES{$i}} = { start => $start, string => $i != 2
 270                     ? $string
 271                     : (' ' x (length($alignment{$ALIGN_TYPES{$i-1}}{string}) - length($string))) . $string
 272                 };
 273                 $_ = $self->_readline();
 274             }
 275
 276             # 'Ruler' line indicates the start of a new HSP
 277             if ($alignment{Ruler}{start} == 0) {
 278                 $format = @hsps ? 3 : 1 if !$format;
 279                 # A previous HSP may need to be ended
 280                 $self->end_element({'Name' => 'Hsp'}) if ( $self->in_element('hsp') );
 281                 # Start the new HSP and fill the '_currentHSP' property with available details
 282                 $self->start_element({'Name' => 'Hsp'});
 283                 $self->{'_currentHSP'} = @hsps ? shift @hsps : {
 284                     'Hsp_query-from' => $alignment{Query}{start},
 285                     'Hsp_hit-from' => $alignment{Sbjct}{start},
 286                 }
 287             }
 288
 289             # Midline indicates a boundary between two HSPs
 290             if ( $alignment{Mid}{string} =~ /<|>/g ) {
 291                 my ($hsp_start, $hsp_end);
 292                 # Are we currently in an open HSP?
 293                 if ( $self->in_element('hsp') ) {
 294                     # Find end pos, adjust 'gaps', 'seq' and 'midline' properties... then close HSP
 295                     $hsp_end = (pos $alignment{Mid}{string}) - 1;
 296                     $self->{'_currentHSP'}{'Hsp_querygaps'} +=
 297                         ($self->{'_currentHSP'}{'Hsp_qseq'} .= substr($alignment{Query}{string}, 0, $hsp_end)) =~ s/ /-/g;
 298                     $self->{'_currentHSP'}{'Hsp_hitgaps'} +=
 299                         ($self->{'_currentHSP'}{'Hsp_hseq'} .= substr($alignment{Sbjct}{string}, 0, $hsp_end)) =~ s/ /-/g;
 300                     ($self->{'_currentHSP'}{'Hsp_midline'} .= substr($alignment{Mid}{string}, 0, $hsp_end)) =~ s/-/ /g;
 301                     $self->end_element({'Name' => 'Hsp'});
 302
 303                     # Does a new HSP start in the current alignment block?
 304                     if ( $alignment{Mid}{string} =~ /\|/g ) {
 305                         # Find start pos, start new HSP and fill it with available details
 306                         $hsp_start = (pos $alignment{Mid}{string}) - 1;
 307                         $self->start_element({'Name' => 'Hsp'});
 308                         $self->{'_currentHSP'} = @hsps ? shift @hsps : {};
 309                         $self->{'_currentHSP'}{'Hsp_querygaps'} +=
 310                             ($self->{'_currentHSP'}{'Hsp_qseq'} = substr($alignment{Query}{string}, $hsp_start)) =~ s/ /-/g;
 311                         $self->{'_currentHSP'}{'Hsp_hitgaps'} +=
 312                             ($self->{'_currentHSP'}{'Hsp_hseq'} = substr($alignment{Sbjct}{string}, $hsp_start)) =~ s/ /-/g;
 313                         ($self->{'_currentHSP'}{'Hsp_midline'} = substr($alignment{Mid}{string}, $hsp_start)) =~ s/-/ /g;
 314                     }
 315                 }
 316                 # No HSP is currently open...
 317                 else {
 318                     # Find start pos, start new HSP and fill it with available
 319                     # details then skip to next alignment block
 320                     $hsp_start = index($alignment{Mid}{string}, '|');
 321                     $self->start_element({'Name' => 'Hsp'});
 322                     $self->{'_currentHSP'} = @hsps ? shift @hsps : {
 323                         'Hsp_query-from' => $alignment{Query}{start},
 324                     };
 325                     $self->{'_currentHSP'}{'Hsp_querygaps'} +=
 326                         ($self->{'_currentHSP'}{'Hsp_qseq'} = substr($alignment{Query}{string}, $hsp_start)) =~ s/ /-/g;
 327                     $self->{'_currentHSP'}{'Hsp_hitgaps'} +=
 328                         ($self->{'_currentHSP'}{'Hsp_hseq'} = substr($alignment{Sbjct}{string}, $hsp_start)) =~ s/ /-/g;
 329                     ($self->{'_currentHSP'}{'Hsp_midline'} = substr($alignment{Mid}{string}, $hsp_start)) =~ s/-/ /g;
 330                     next;
 331                 }
 332             }
 333             # Current alignment block does not contain HSPs boundary
 334             else {
 335                 # Start a new HSP if none is currently open
 336                 # (Happens if last boundary finished at the very end of previous block)
 337                 if ( !$self->in_element('hsp') ) {
 338                     $self->start_element({'Name' => 'Hsp'});
 339                     $self->{'_currentHSP'} = @hsps ? shift @hsps : {
 340                         'Hsp_query-from' => $alignment{Query}{start},
 341                         'Hsp_hit-from' => $alignment{Sbjct}{start},
 342                     }
 343                 }
 344                 # Adjust details of the current HSP
 345                 $self->{'_currentHSP'}{'Hsp_query-from'} ||=
 346                     $alignment{Query}{start} -
 347                     length($self->{'_currentHSP'}{'Hsp_qseq'} || '');
 348                 $self->{'_currentHSP'}{'Hsp_hit-from'} ||=
 349                     $alignment{Sbjct}{start} -
 350                     length($self->{'_currentHSP'}{'Hsp_hseq'} || '');
 351                 $self->{'_currentHSP'}{'Hsp_querygaps'} +=
 352                     ($self->{'_currentHSP'}{'Hsp_qseq'} .=
 353                      $alignment{Query}{string}) =~ s/ /-/g;
 354                 $self->{'_currentHSP'}{'Hsp_hitgaps'} +=
 355                     ($self->{'_currentHSP'}{'Hsp_hseq'} .=
 356                      $alignment{Sbjct}{string}) =~ s/ /-/g;
 357                 ($self->{'_currentHSP'}{'Hsp_midline'} .=
 358                  $alignment{Mid}{string}) =~ s/-/ /g;
 359             }
 360         }
 361     }
 362
 363     # We are done reading the sim4 report, end everything and return
 364     if( $seentop ) {
 365         # end HSP if needed
 366         $self->end_element({'Name' => 'Hsp'}) if ( $self->in_element('hsp') );
 367         # end Hit if needed
 368         if ( $self->in_element('hit') ) {
 369             foreach (@hsps) {
 370                 $self->start_element({'Name' => 'Hsp'});
 371                 while (my ($name, $data) = each %$_) {
 372                     $self->{'_currentHSP'}{$name} = $data;
 373                 }
 374                 $self->end_element({'Name' => 'Hsp'});
 375             }
 376             $self->end_element({'Name' => 'Hit'});
 377         }
 378         # adjust result's algorithm name, end output and return
 379         $self->element({'Name' => 'Sim4Output_program',
 380                         'Data' => $DEFAULTFORMAT . ' (A=' . (defined $format ? $format : '?') . ')'});
 381         $self->end_element({'Name' => 'Sim4Output'});
 382         return $self->end_document();
 383     }
 384     return;
 385 }
 386
 387 =head2 start_element
 388
 389  Title   : start_element
 390  Usage   : $eventgenerator->start_element
 391  Function: Handles a start element event
 392  Returns : none
 393  Args    : hashref with at least 2 keys 'Data' and 'Name'
 394
 395
 396 =cut
 397
 398 sub start_element{
 399    my ($self,$data) = @_;
 400    # we currently don't care about attributes
 401    my $nm = $data->{'Name'};
 402    my $type = $MODEMAP{$nm};
 403
 404    if( $type ) {
 405        if( $self->_will_handle($type) ) {
 406            my $func = sprintf("start_%s",lc $type);
 407            $self->_eventHandler->$func($data->{'Attributes'});
 408        }
 409        unshift @{$self->{'_elements'}}, $type;
 410
 411        if($type eq 'result') {
 412            $self->{'_values'} = {};
 413            $self->{'_result'}= undef;
 414        }
 415    }
 416
 417 }
 418
 419 =head2 end_element
 420
 421  Title   : start_element
 422  Usage   : $eventgenerator->end_element
 423  Function: Handles an end element event
 424  Returns : none
 425  Args    : hashref with at least 2 keys 'Data' and 'Name'
 426
 427
 428 =cut
 429
 430 sub end_element {
 431     my ($self,$data) = @_;
 432     my $nm = $data->{'Name'};
 433     my $type = $MODEMAP{$nm};
 434     my $rc;
 435
 436     if( $nm eq 'Hsp' ) {
 437         $self->{'_currentHSP'}{'Hsp_midline'} ||= '';
 438         $self->{'_currentHSP'}{'Hsp_query-to'} ||=
 439             $self->{'_currentHSP'}{'Hsp_query-from'} + length($self->{'_currentHSP'}{'Hsp_qseq'}) - 1 - $self->{'_currentHSP'}{'Hsp_querygaps'};
 440         $self->{'_currentHSP'}{'Hsp_hit-to'} ||=
 441             $self->{'_currentHSP'}{'Hsp_hit-from'} + length($self->{'_currentHSP'}{'Hsp_hseq'}) - 1 - $self->{'_currentHSP'}{'Hsp_hitgaps'};
 442         $self->{'_currentHSP'}{'Hsp_identity'} ||=
 443             ($self->{'_currentHSP'}{'Hsp_midline'} =~ tr/\|//);
 444         $self->{'_currentHSP'}{'Hsp_qlength'} ||= abs($self->{'_currentHSP'}{'Hsp_query-to'} - $self->{'_currentHSP'}{'Hsp_query-from'}) + 1;
 445         $self->{'_currentHSP'}{'Hsp_hlength'} ||= abs($self->{'_currentHSP'}{'Hsp_hit-to'} - $self->{'_currentHSP'}{'Hsp_hit-from'}) + 1;
 446         $self->{'_currentHSP'}{'Hsp_align-len'} ||= abs($self->{'_currentHSP'}{'Hsp_query-to'} - $self->{'_currentHSP'}{'Hsp_query-from'}) + 1;
 447         $self->{'_currentHSP'}{'Hsp_score'} ||= int(100 * ($self->{'_currentHSP'}{'Hsp_identity'} / $self->{'_currentHSP'}{'Hsp_align-len'}));
 448         foreach (keys %{$self->{'_currentHSP'}}) {
 449             $self->element({'Name' => $_, 'Data' => delete ${$self->{'_currentHSP'}}{$_}});
 450         }
 451     }
 452
 453     if( $type = $MODEMAP{$nm} ) {
 454         if( $self->_will_handle($type) ) {
 455             my $func = sprintf("end_%s",lc $type);
 456             $rc = $self->_eventHandler->$func($self->{'_reporttype'},
 457                                               $self->{'_values'});
 458         }
 459         shift @{$self->{'_elements'}};
 460
 461     } elsif( $MAPPING{$nm} ) {
 462
 463         if ( ref($MAPPING{$nm}) =~ /hash/i ) {
 464             my $key = (keys %{$MAPPING{$nm}})[0];
 465             $self->{'_values'}->{$key}->{$MAPPING{$nm}->{$key}} = $self->{'_last_data'};
 466         } else {
 467             $self->{'_values'}->{$MAPPING{$nm}} = $self->{'_last_data'};
 468         }
 469     } else {
 470         $self->debug( "unknown nm $nm, ignoring\n");
 471     }
 472     $self->{'_last_data'} = ''; # remove read data if we are at
 473                                 # end of an element
 474     $self->{'_result'} = $rc if( defined $type && $type eq 'result' );
 475     return $rc;
 476 }
 477
 478 =head2 element
 479
 480  Title   : element
 481  Usage   : $eventhandler->element({'Name' => $name, 'Data' => $str});
 482  Function: Convience method that calls start_element, characters, end_element
 483  Returns : none
 484  Args    : Hash ref with the keys 'Name' and 'Data'
 485
 486
 487 =cut
 488
 489 sub element{
 490    my ($self,$data) = @_;
 491    $self->start_element($data);
 492    $self->characters($data);
 493    $self->end_element($data);
 494 }
 495
 496 =head2 characters
 497
 498  Title   : characters
 499  Usage   : $eventgenerator->characters($str)
 500  Function: Send a character events
 501  Returns : none
 502  Args    : string
 503
 504
 505 =cut
 506
 507 sub characters{
 508    my ($self,$data) = @_;
 509    return unless ( defined $data->{'Data'} && $data->{'Data'} !~ /^\s+$/ );
 510
 511    if( $self->in_element('hsp') &&
 512        $data->{'Name'} =~ /Hsp\_(qseq|hseq|midline)/ ) {
 513        $self->{'_last_hspdata'}->{$data->{'Name'}} .= $data->{'Data'};
 514    }
 515
 516    $self->{'_last_data'} = $data->{'Data'};
 517 }
 518
 519 =head2 within_element
 520
 521  Title   : within_element
 522  Usage   : if( $eventgenerator->within_element($element) ) {}
 523  Function: Test if we are within a particular element
 524            This is different than 'in' because within can be tested
 525            for a whole block.
 526  Returns : boolean
 527  Args    : string element name
 528
 529
 530 =cut
 531
 532 sub within_element{
 533    my ($self,$name) = @_;
 534    return 0 if ( ! defined $name &&
 535                  ! defined  $self->{'_elements'} ||
 536                  scalar @{$self->{'_elements'}} == 0) ;
 537    foreach (  @{$self->{'_elements'}} ) {
 538        if( $_ eq $name  ) {
 539            return 1;
 540        }
 541    }
 542    return 0;
 543 }
 544
 545
 546 =head2 in_element
 547
 548  Title   : in_element
 549  Usage   : if( $eventgenerator->in_element($element) ) {}
 550  Function: Test if we are in a particular element
 551            This is different than 'in' because within can be tested
 552            for a whole block.
 553  Returns : boolean
 554  Args    : string element name
 555
 556
 557 =cut
 558
 559 sub in_element{
 560    my ($self,$name) = @_;
 561    return 0 if ! defined $self->{'_elements'}->[0];
 562    return ( $self->{'_elements'}->[0] eq $name)
 563 }
 564
 565 =head2 start_document
 566
 567  Title   : start_document
 568  Usage   : $eventgenerator->start_document
 569  Function: Handle a start document event
 570  Returns : none
 571  Args    : none
 572
 573
 574 =cut
 575
 576 sub start_document{
 577     my ($self) = @_;
 578     $self->{'_lasttype'} = '';
 579     $self->{'_values'} = {};
 580     $self->{'_result'}= undef;
 581     $self->{'_elements'} = [];
 582     $self->{'_reporttype'} = $DEFAULTFORMAT;
 583 }
 584
 585
 586 =head2 end_document
 587
 588  Title   : end_document
 589  Usage   : $eventgenerator->end_document
 590  Function: Handles an end document event
 591  Returns : Bio::Search::Result::ResultI object
 592  Args    : none
 593
 594
 595 =cut
 596
 597 sub end_document{
 598    my ($self,@args) = @_;
 599    return $self->{'_result'};
 600 }
 601
 602
 603 sub write_result {
 604    my ($self, $blast, @args) = @_;
 605
 606    if( not defined($self->writer) ) {
 607        $self->warn("Writer not defined. Using a $DEFAULT_WRITER_CLASS");
 608        $self->writer( $DEFAULT_WRITER_CLASS->new() );
 609    }
 610    $self->SUPER::write_result( $blast, @args );
 611 }
 612
 613 sub result_count {
 614     return 1; # can a sim4 report contain more than one result?
 615 }
 616
 617 sub report_count { shift->result_count }
 618
 619 =head2 _will_handle
 620
 621  Title   : _will_handle
 622  Usage   : Private method. For internal use only.
 623               if( $self->_will_handle($type) ) { ... }
 624  Function: Provides an optimized way to check whether or not an element of a
 625            given type is to be handled.
 626  Returns : Reference to EventHandler object if the element type is to be handled.
 627            undef if the element type is not to be handled.
 628  Args    : string containing type of element.
 629
 630 Optimizations:
 631
 632   1. Using the cached pointer to the EventHandler to minimize repeated lookups.
 633   2. Caching the will_handle status for each type that is encountered
 634      so that it only need be checked by calling handler->will_handle($type) once.
 635
 636 This does not lead to a major savings by itself (only 5-10%).
 637 In combination with other optimizations, or for large parse jobs, the
 638 savings good be significant.
 639
 640 To test against the unoptimized version, remove the parentheses from
 641 around the third term in the ternary " ? : " operator and add two
 642 calls to $self-E<gt>_eventHandler().
 643
 644 =cut
 645
 646 sub _will_handle {
 647     my ($self,$type) = @_;
 648     my $handler = $self->{'_handler_cache'} ||= $self->_eventHandler;
 649
 650     my $will_handle = defined($self->{'_will_handle_cache'}->{$type})
 651                              ? $self->{'_will_handle_cache'}->{$type}
 652                              : ($self->{'_will_handle_cache'}->{$type} =
 653                                $handler->will_handle($type));
 654
 655     return $will_handle ? $handler : undef;
 656 }
 657
 658 1;