branch-1-6/Bio/SearchIO/fasta.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::SearchIO::fasta
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Jason Stajich <jason-at-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::fasta - A SearchIO parser for FASTA results
  18
  19 =head1 SYNOPSIS
  20
  21   # Do not use this object directly, use it through the SearchIO system
  22    use Bio::SearchIO;
  23    my $searchio = Bio::SearchIO->new(-format => 'fasta',
  24                     -file   => 'report.FASTA');
  25    while( my $result = $searchio->next_result ) {
  26     # ... do what you would normally doi with Bio::SearchIO.
  27    }
  28
  29 =head1 DESCRIPTION
  30
  31 This object contains the event based parsing code for FASTA format
  32 reports.  It creates L<Bio::Search::HSP::FastaHSP> objects instead of
  33 L<Bio::Search::HSP::GenericHSP> for the HSP objects.
  34
  35 This module will parse -m 9 -d 0 output as well as default m 1 output
  36 from FASTA as well as SSEARCH.
  37
  38 Also see the SearchIO HOWTO:
  39 L<http://bioperl.open-bio.org/wiki/HOWTO:SearchIO>.
  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 Support
  53
  54 Please direct usage questions or support issues to the mailing list:
  55
  56 I<bioperl-l@bioperl.org>
  57
  58 rather than to the module maintainer directly. Many experienced and
  59 reponsive experts will be able look at the problem and quickly
  60 address it. Please include a thorough description of the problem
  61 with code and data examples if at all possible.
  62
  63 =head2 Reporting Bugs
  64
  65 Report bugs to the Bioperl bug tracking system to help us keep track
  66 of the bugs and their resolution. Bug reports can be submitted via the
  67 web:
  68
  69   http://bugzilla.open-bio.org/
  70
  71 =head1 AUTHOR - Jason Stajich, Aaron Mackey
  72
  73 Email jason-at-bioperl.org
  74
  75 =head1 APPENDIX
  76
  77 The rest of the documentation details each of the object methods.
  78 Internal methods are usually preceded with a _
  79
  80 =cut
  81
  82 # Let the code begin...
  83
  84 package Bio::SearchIO::fasta;
  85 use vars qw(%MODEMAP %MAPPING $IDLENGTH);
  86 use strict;
  87
  88 # Object preamble - inherits from Bio::Root::RootI
  89
  90 use Bio::Factory::ObjectFactory;
  91
  92 BEGIN {
  93
  94     # Set IDLENGTH to a new value if you have
  95     # compile FASTA with a different ID length
  96     # (actually newest FASTA allows the setting of this
  97     #  via -C parameter, default is 6)
  98     $IDLENGTH = 6;
  99
 100     # mapping of NCBI Blast terms to Bioperl hash keys
 101     %MODEMAP = (
 102         'FastaOutput' => 'result',
 103         'Hit'         => 'hit',
 104         'Hsp'         => 'hsp'
 105     );
 106
 107     # This should really be done more intelligently, like with
 108     # XSLT
 109
 110     %MAPPING = (
 111         'Hsp_bit-score'   => 'HSP-bits',
 112         'Hsp_score'       => 'HSP-score',
 113         'Hsp_sw-score'    => 'HSP-swscore',
 114         'Hsp_evalue'      => 'HSP-evalue',
 115         'Hsp_query-from'  => 'HSP-query_start',
 116         'Hsp_query-to'    => 'HSP-query_end',
 117         'Hsp_hit-from'    => 'HSP-hit_start',
 118         'Hsp_hit-to'      => 'HSP-hit_end',
 119         'Hsp_positive'    => 'HSP-conserved',
 120         'Hsp_identity'    => 'HSP-identical',
 121         'Hsp_gaps'        => 'HSP-hsp_gaps',
 122         'Hsp_hitgaps'     => 'HSP-hit_gaps',
 123         'Hsp_querygaps'   => 'HSP-query_gaps',
 124         'Hsp_qseq'        => 'HSP-query_seq',
 125         'Hsp_hseq'        => 'HSP-hit_seq',
 126         'Hsp_midline'     => 'HSP-homology_seq',
 127         'Hsp_align-len'   => 'HSP-hsp_length',
 128         'Hsp_query-frame' => 'HSP-query_frame',
 129         'Hsp_hit-frame'   => 'HSP-hit_frame',
 130
 131         'Hit_id'        => 'HIT-name',
 132         'Hit_len'       => 'HIT-length',
 133         'Hit_accession' => 'HIT-accession',
 134         'Hit_def'       => 'HIT-description',
 135         'Hit_signif'    => 'HIT-significance',
 136         'Hit_score'     => 'HIT-score',
 137
 138         'FastaOutput_program'   => 'RESULT-algorithm_name',
 139         'FastaOutput_version'   => 'RESULT-algorithm_version',
 140         'FastaOutput_query-def' => 'RESULT-query_name',
 141         'FastaOutput_querydesc' => 'RESULT-query_description',
 142         'FastaOutput_query-len' => 'RESULT-query_length',
 143         'FastaOutput_db'        => 'RESULT-database_name',
 144         'FastaOutput_db-len'    => 'RESULT-database_entries',
 145         'FastaOutput_db-let'    => 'RESULT-database_letters',
 146
 147         'Parameters_matrix'      => { 'RESULT-parameters' => 'matrix' },
 148         'Parameters_expect'      => { 'RESULT-parameters' => 'expect' },
 149         'Parameters_include'     => { 'RESULT-parameters' => 'include' },
 150         'Parameters_sc-match'    => { 'RESULT-parameters' => 'match' },
 151         'Parameters_sc-mismatch' => { 'RESULT-parameters' => 'mismatch' },
 152         'Parameters_gap-open'    => { 'RESULT-parameters' => 'gapopen' },
 153         'Parameters_gap-ext'     => { 'RESULT-parameters' => 'gapext' },
 154         'Parameters_word-size'   => { 'RESULT-parameters' => 'wordsize' },
 155         'Parameters_ktup'        => { 'RESULT-parameters' => 'ktup' },
 156         'Parameters_filter'      => { 'RESULT-parameters' => 'filter' },
 157         'Statistics_db-num'      => { 'RESULT-statistics' => 'dbentries' },
 158         'Statistics_db-len'      => { 'RESULT-statistics' => 'dbletters' },
 159         'Statistics_hsp-len'     => { 'RESULT-statistics' => 'hsplength' },
 160         'Statistics_eff-space'   => { 'RESULT-statistics' => 'effectivespace' },
 161         'Statistics_kappa'       => { 'RESULT-statistics' => 'kappa' },
 162         'Statistics_lambda'      => { 'RESULT-statistics' => 'lambda' },
 163         'Statistics_entropy'     => { 'RESULT-statistics' => 'entropy' },
 164     );
 165 }
 166
 167 use base qw(Bio::SearchIO);
 168
 169 =head2 new
 170
 171  Title   : new
 172  Usage   : my $obj = Bio::SearchIO::fasta->new();
 173  Function: Builds a new Bio::SearchIO::fasta object
 174  Returns : Bio::SearchIO::fasta
 175  Args    : -idlength - set ID length to something other
 176                        than the default (7), this is only
 177                        necessary if you have compiled FASTA
 178                        with a new default id length to display
 179                        in the HSP alignment blocks
 180
 181 =cut
 182
 183 sub _initialize {
 184     my ( $self, @args ) = @_;
 185     $self->SUPER::_initialize(@args);
 186     return unless @args;
 187     my ($idlength) = $self->_rearrange( [qw(IDLENGTH)], @args );
 188     $self->idlength( $idlength || $IDLENGTH );
 189     $self->_eventHandler->register_factory(
 190         'hsp',
 191         Bio::Factory::ObjectFactory->new(
 192             -type      => 'Bio::Search::HSP::FastaHSP',
 193             -interface => 'Bio::Search::HSP::HSPI'
 194         )
 195     );
 196     return 1;
 197 }
 198
 199 =head2 next_result
 200
 201  Title   : next_result
 202  Usage   : my $hit = $searchio->next_result;
 203  Function: Returns the next Result from a search
 204  Returns : Bio::Search::Result::ResultI object
 205  Args    : none
 206
 207 =cut
 208
 209 sub next_result {
 210     my ($self) = @_;
 211     local $/ = "\n";
 212     local $_;
 213
 214     my $data    = '';
 215     my $seentop = 0;
 216     my $current_hsp;
 217     $self->start_document();
 218     my @hit_signifs;
 219     while ( defined( $_ = $self->_readline ) ) {
 220         next if ( !$self->in_element('hsp')
 221             && /^\s+$/ );    # skip empty lines
 222         if (
 223                m/(\S+)\s+searches\s+a\s+(protein\s+or\s+DNA\s+)?sequence/oxi
 224             || /(\S+)\s+compares\s+a/
 225             || (   m/^\#\s+/
 226                 && ( $_ = $self->_readline )
 227                 && /(\S+)\s+searches\s+a\s+(protein\s+or\s+DNA\s+)?sequence/oxi
 228                 || /(\S+)\s+compares\s+a/ )
 229           )
 230         {
 231             if ($seentop) {
 232                 $self->_pushback($_);
 233                 $self->end_element( { 'Name' => 'FastaOutput' } );
 234                 return $self->end_document();
 235             }
 236             $self->{'_reporttype'} = $1;
 237             $self->start_element( { 'Name' => 'FastaOutput' } );
 238             $self->{'_result_count'}++;
 239             $seentop = 1;
 240             #$self->debug( "reporttype is " . $self->{'_reporttype'} . "\n" );
 241             $self->element(
 242                 {
 243                     'Name' => 'FastaOutput_program',
 244                     'Data' => $self->{'_reporttype'}
 245                 }
 246             );
 247             $_ = $self->_readline();
 248             my ($version) = (/version\s+(\S+)/);
 249             $version = '' unless defined $version;
 250             $self->{'_version'} = $version;
 251             $self->element(
 252                 {
 253                     'Name' => 'FastaOutput_version',
 254                     'Data' => $version
 255                 }
 256             );
 257
 258             my ( $last, $leadin, $type, $querylen, $querytype, $querydef );
 259
 260             while ( defined( $_ = $self->_readline() ) ) {
 261                 if (
 262                     /^ (
 263                        (?:\s+>) |             # fa33 lead-in
 264                        (?:\s*\d+\s*>>>)       # fa34 mlib lead-in
 265                       )
 266                       (.*)
 267                    /x
 268                   )
 269                 {
 270                     ( $leadin, $querydef ) = ( $1, $2 );
 271                     if ( $leadin =~ m/>>>/ ) {
 272                         if ( $querydef =~
 273                             /^(.*?)\s+(?:\-\s+)?(\d+)\s+(aa|nt).*$/o )
 274                         {
 275                             ( $querydef, $querylen, $querytype ) =
 276                               ( $1, $2, $3 );
 277                             last;
 278                         }
 279                     }
 280                     else {
 281                         if ( $last =~ /(\S+)[:,]\s*(\d+)\s+(aa|nt)/ ) {
 282                             ( $querylen, $querytype ) = ( $2, $3 );
 283                             $querydef ||= $1;
 284                             last;
 285                         }
 286                     }
 287                 }
 288                 elsif (m/^\s*vs\s+\S+/o) {
 289                     if ( $last =~ /(\S+)[,:]\s+(\d+)\s+(aa|nt)/o ) {
 290                         ( $querydef, $querylen, $querytype ) = ( $1, $2, $3 );
 291                         last;
 292                     }
 293                 }
 294                 $last = $_;
 295             }
 296             if (   $self->{'_reporttype'}
 297                 && $self->{'_reporttype'} eq 'FASTA' )
 298             {
 299                 if ( $querytype eq 'nt' ) {
 300                     $self->{'_reporttype'} = 'FASTN';
 301                 }
 302                 elsif ( $querytype eq 'aa' ) {
 303                     $self->{'_reporttype'} = 'FASTP';
 304                 }
 305             }
 306             my ( $name, $descr ) = $querydef =~ m/^(\S+)\s*(.*?)\s*$/o;
 307             $self->element(
 308                 {
 309                     'Name' => 'FastaOutput_query-def',
 310                     'Data' => $name
 311                 }
 312             );
 313             $self->element(
 314                 {
 315                     'Name' => 'FastaOutput_querydesc',
 316                     'Data' => $descr
 317                 }
 318             );
 319             if ($querylen) {
 320                 $self->element(
 321                     {
 322                         'Name' => 'FastaOutput_query-len',
 323                         'Data' => $querylen
 324                     }
 325                 );
 326             }
 327             else {
 328                 $self->warn("unable to find and set query length");
 329             }
 330             if (
 331                    $last =~ /^\s*vs\s+(\S+)/
 332                 || ( $last =~ /^searching\s+(\S+)\s+library/ )
 333                 || ( $last =~ /^Library:\s+(\S+)\s+/ )
 334                 || (
 335                     defined $_
 336                     && (   /^\s*vs\s+(\S+)/
 337                         || /^Library:\s+(\S+)\s+/ )
 338                 )
 339                 || ( defined( $_ = $self->_readline() )
 340                     && ( /^\s*vs\s+(\S+)/ || /^Library:\s+(\S+)/ ) )
 341               )
 342             {
 343                 $self->element(
 344                     {
 345                         'Name' => 'FastaOutput_db',
 346                         'Data' => $1
 347                     }
 348                 );
 349             }
 350             elsif (m/^\s+opt(?:\s+E\(\))?$/o) {
 351
 352            # histogram ... read over it more rapidly than the larger outer loop:
 353                 while ( defined( $_ = $self->_readline ) ) {
 354                     last if m/^>\d+/;
 355                 }
 356             }
 357         }
 358         elsif (/(\d+)\s+residues\s+in\s+(\d+)\s+(?:library\s+)?sequences/) {
 359             $self->element(
 360                 {
 361                     'Name' => 'FastaOutput_db-let',
 362                     'Data' => $1
 363                 }
 364             );
 365             $self->element(
 366                 {
 367                     'Name' => 'FastaOutput_db-len',
 368                     'Data' => $2
 369                 }
 370             );
 371             $self->element(
 372                 {
 373                     'Name' => 'Statistics_db-len',
 374                     'Data' => $1
 375                 }
 376             );
 377             $self->element(
 378                 {
 379                     'Name' => 'Statistics_db-num',
 380                     'Data' => $2
 381                 }
 382             );
 383         }
 384         elsif (/Lambda=\s*(\S+)/) {
 385             $self->element(
 386                 {
 387                     'Name' => 'Statistics_lambda',
 388                     'Data' => $1
 389                 }
 390             );
 391         }
 392         elsif (/K=\s*(\S+)/) {
 393             $self->element(
 394                 {
 395                     'Name' => 'Statistics_kappa',
 396                     'Data' => $1
 397                 }
 398             );
 399         }
 400         elsif (/^\s*(Smith-Waterman).+(\S+)\s*matrix [^\]]*?(xS)?\]/) {
 401             $self->element(
 402                 {
 403                     'Name' => 'Parameters_matrix',
 404                     'Data' => $2
 405                 }
 406             );
 407             $self->element(
 408                 {
 409                     'Name' => 'Parameters_filter',
 410                     'Data' => defined $3 ? 1 : 0,
 411                 }
 412             );
 413             $self->{'_reporttype'} = $1;
 414
 415             $self->element(
 416                 {
 417                     'Name' => 'FastaOutput_program',
 418                     'Data' => $self->{'_reporttype'}
 419                 }
 420             );
 421         }
 422         elsif (/The best( related| unrelated)? scores are:/) {
 423             my $rel    = $1;
 424             my @labels = split;
 425             @labels = map {
 426                 if ( $_ =~ m/^E\((\d+)\)$/o )
 427                 {
 428                     $self->element(
 429                         { 'Name' => 'Statistics_eff-space', 'Data' => $1 } );
 430                     "evalue";
 431                 }
 432                 else {
 433                     $_;
 434                 }
 435             } @labels[ $rel ? 5 : 4 .. $#labels ];
 436
 437             while ( defined( $_ = $self->_readline() )
 438                 && !/^\s+$/ )
 439             {
 440                 my @line = split;
 441
 442                 if ( $line[-1] =~ m/\=/o && $labels[-1] eq 'fs' ) {
 443
 444                     # unlabelled alignment hit;
 445                     push @labels, "aln_code";
 446                 }
 447
 448                 my %data;
 449                 @data{@labels} = splice( @line, @line - @labels );
 450                 if ( $line[-1] =~ m/\[([1-6rf])\]/o ) {
 451                     my $fr = $1;
 452                     $data{lframe} = (
 453                         $fr =~ /\d/o
 454                         ? ( $fr <= 3 ? "+$fr" : "-@{[$fr-3]}" )
 455                         : ( $fr eq 'f' ? '+1' : '-1' )
 456                     );
 457                     pop @line;
 458                 }
 459                 else {
 460                     $data{lframe} = '0';
 461                 }
 462
 463                 if ( $line[-1] =~ m/^\(?(\d+)\)$/ ) {
 464                     $data{hit_len} = $1;
 465                     pop @line;
 466                     if ( $line[-1] =~ m/^\($/ ) {
 467                         pop @line;
 468                     }
 469                 }
 470                 else {
 471                     $data{hit_len} = 0;
 472                 }
 473
 474                 # rebuild the first part of the line, preserving spaces:
 475                 ($_) = m/^(\S+(?:\s+\S+){$#line})/;
 476
 477                 my ( $id, $desc ) = split( /\s+/, $_, 2 );
 478                 my @pieces = split( /\|/, $id );
 479                 my $acc = pop @pieces;
 480                 $acc =~ s/\.\d+$//;
 481
 482                 @data{qw(id desc acc)} = ( $id, $desc, $acc );
 483
 484                 push @hit_signifs, \%data;
 485             }
 486         }
 487         elsif (
 488 /^\s*([T]?FAST[XYAF]).+,\s*(\S+)\s*matrix[^\]]+?(xS)?\]\s*ktup:\s*(\d+)/
 489           )
 490         {
 491
 492             $self->element(
 493                 {
 494                     'Name' => 'Parameters_matrix',
 495                     'Data' => $2
 496                 }
 497             );
 498             $self->element(
 499                 {
 500                     'Name' => 'Parameters_filter',
 501                     'Data' => defined $3 ? 1 : 0,
 502                 }
 503             );
 504             $self->element(
 505                 {
 506                     'Name' => 'Parameters_ktup',
 507                     'Data' => $4
 508                 }
 509             );
 510             $self->{'_reporttype'} = $1
 511               if ( $self->{'_reporttype'} !~ /FAST[PN]/i );
 512
 513             $self->element(
 514                 {
 515                     'Name' => 'FastaOutput_program',
 516                     'Data' => $self->{'_reporttype'}
 517                 }
 518             );
 519         }
 520         elsif (/^Algorithm:\s+(\S+)\s+\(([^)]+)\)\s+(\S+)/) {
 521             $self->{'_reporttype'} = $1
 522               if ( $self->{'_reporttype'} !~ /FAST[PN]/i );
 523         }
 524         elsif (
 525             /^Parameters:\s+(\S+)\s*matrix\s*(?:\(([^(]+?)\))?\s*ktup:\s*(\d+)/)
 526         {    # FASTA 35.04
 527             $self->element(
 528                 {
 529                     'Name' => 'Parameters_matrix',
 530                     'Data' => $1
 531                 }
 532             );
 533             $self->element(
 534                 {
 535                     'Name' => 'Parameters_filter',
 536                     'Data' => defined $2 ? $2 : 0,
 537                 }
 538             );
 539             $self->element(
 540                 {
 541                     'Name' => 'Parameters_ktup',
 542                     'Data' => $3
 543                 }
 544             );
 545         }
 546         elsif (
 547 /(?:gap\-pen|open\/ext):\s+([\-\+]?\d+)\s*\/\s*([\-\+]?\d+).+width:\s+(\d+)/
 548           )
 549         {
 550             $self->element(
 551                 {
 552                     'Name' => 'Parameters_gap-open',
 553                     'Data' => $1
 554                 }
 555             );
 556             $self->element(
 557                 {
 558                     'Name' => 'Parameters_gap-ext',
 559                     'Data' => $2
 560                 }
 561             );
 562             $self->element(
 563                 {
 564                     'Name' => 'Parameters_word-size',
 565                     'Data' => $3
 566                 }
 567             );
 568         }
 569         elsif (/^>>(?!>)(.+?)\s+(?:\((\d+)\s*(aa|nt)\))?$/) {
 570             my ($hit_id, $len, $alphabet) = ($1, $2, $3);
 571             if (!$len || !$alphabet) {
 572                 WRAPPED:
 573                 while (defined($_ = $self->_readline)) {
 574                     if (/(.*?)\s+\((\d+)\s*(aa|nt)\)/) {
 575                         ($len, $alphabet) = ($2, $3);
 576                         $hit_id .= $1 ? " ".$1 : '';
 577                         last WRAPPED;
 578                     }
 579                     if (/^>>(?!>)/) { # too far, throw
 580                         $self->throw("Couldn't find length, bailing");
 581                     }
 582                 }
 583             }
 584             if ( $self->in_element('hsp') ) {
 585                 $self->end_element( { 'Name' => 'Hsp' } );
 586             }
 587             if ( $self->in_element('hit') ) {
 588                 $self->end_element( { 'Name' => 'Hit' } );
 589             }
 590
 591             $self->start_element( { 'Name' => 'Hit' } );
 592             $self->element(
 593                 {
 594                     'Name' => 'Hit_len',
 595                     'Data' => $len
 596                 }
 597             );
 598             my ( $id, $desc ) = split( /\s+/, $hit_id, 2 );
 599             $self->element(
 600                 {
 601                     'Name' => 'Hit_id',
 602                     'Data' => $id
 603                 }
 604             );
 605
 606             #$self->debug("Hit ID is $id\n");
 607             my @pieces = split( /\|/, $id );
 608             my $acc = pop @pieces;
 609             $acc =~ s/\.\d+$//;
 610             $self->element(
 611                 {
 612                     'Name' => 'Hit_accession',
 613                     'Data' => $acc
 614                 }
 615             );
 616             $self->element(
 617                 {
 618                     'Name' => 'Hit_def',
 619                     'Data' => $desc
 620                 }
 621             );
 622
 623             $_ = $self->_readline();
 624             my ( $score, $bits, $e ) = /Z-score: \s* (\S+) \s*
 625                                (?: bits: \s* (\S+) \s+ )?
 626                                (?: E|expect ) \s* \(\) :? \s*(\S+)/ox;
 627             $bits = $score unless defined $bits;
 628
 629             my $v = shift @hit_signifs;
 630             if ( defined $v ) {
 631                 @{$v}{qw(evalue bits z-sc)} = ( $e, $bits, $score );
 632             }
 633             $self->element(
 634                 {
 635                     'Name' => 'Hit_signif',
 636                     'Data' => $v ? $v->{evalue} : $e
 637                 }
 638             );
 639             $self->element(
 640                 {
 641                     'Name' => 'Hit_score',
 642                     'Data' => $v ? $v->{bits} : $bits
 643                 }
 644             );
 645             $self->start_element( { 'Name' => 'Hsp' } );
 646
 647             $self->element(
 648                 {
 649                     'Name' => 'Hsp_score',
 650                     'Data' => $v ? $v->{'z-sc'} : $score
 651                 }
 652             );
 653             $self->element(
 654                 {
 655                     'Name' => 'Hsp_evalue',
 656                     'Data' => $v ? $v->{evalue} : $e
 657                 }
 658             );
 659             $self->element(
 660                 {
 661                     'Name' => 'Hsp_bit-score',
 662                     'Data' => $v ? $v->{bits} : $bits
 663                 }
 664             );
 665             $_ = $self->_readline();
 666
 667             if (s/Smith-Waterman score:\s*(\d+)\;?//) {
 668                 $self->element(
 669                     {
 670                         'Name' => 'Hsp_sw-score',
 671                         'Data' => $1
 672                     }
 673                 );
 674             }
 675             if (
 676                 / (\d*\.?\d+)\% \s* identity
 677                  (?:\s* \(\s*(\S+)\% \s* (?:ungapped|similar) \) )?
 678                  \s* in \s* (\d+) \s+ (?:aa|nt) \s+ overlap \s*
 679                  \( (\d+) \- (\d+) : (\d+) \- (\d+) \)
 680                /x
 681               )
 682             {
 683                 my ( $identper, $gapper, $len, $querystart, $queryend,
 684                     $hitstart, $hitend )
 685                   = ( $1, $2, $3, $4, $5, $6, $7 );
 686                 my $ident = sprintf( "%.0f", ( $identper / 100 ) * $len );
 687                 my $positive = sprintf( "%.0f", ( $gapper / 100 ) * $len );
 688
 689                 $self->element(
 690                     {
 691                         'Name' => 'Hsp_identity',
 692                         'Data' => $ident
 693                     }
 694                 );
 695                 $self->element(
 696                     {
 697                         'Name' => 'Hsp_positive',
 698                         'Data' => $positive
 699                     }
 700                 );
 701                 $self->element(
 702                     {
 703                         'Name' => 'Hsp_align-len',
 704                         'Data' => $len
 705                     }
 706                 );
 707
 708                 $self->element(
 709                     {
 710                         'Name' => 'Hsp_query-from',
 711                         'Data' => $querystart
 712                     }
 713                 );
 714                 $self->element(
 715                     {
 716                         'Name' => 'Hsp_query-to',
 717                         'Data' => $queryend
 718                     }
 719                 );
 720                 $self->element(
 721                     {
 722                         'Name' => 'Hsp_hit-from',
 723                         'Data' => $hitstart
 724                     }
 725                 );
 726                 $self->element(
 727                     {
 728                         'Name' => 'Hsp_hit-to',
 729                         'Data' => $hitend
 730                     }
 731                 );
 732
 733             }
 734
 735             if ($v) {
 736                 $self->element(
 737                     { 'Name' => 'Hsp_querygaps', 'Data' => $v->{qgaps} } )
 738                   if exists $v->{qgaps};
 739                 $self->element(
 740                     { 'Name' => 'Hsp_hitgaps', 'Data' => $v->{lgaps} } )
 741                   if exists $v->{lgaps};
 742
 743                 if ( $self->{'_reporttype'} =~ m/^FAST[NXY]$/o ) {
 744                     if ( 8 == scalar grep { exists $v->{$_} }
 745                         qw(an0 ax0 pn0 px0 an1 ax1 pn1 px1) )
 746                     {
 747                         if ( $v->{ax0} < $v->{an0} ) {
 748                             $self->element(
 749                                 {
 750                                     'Name' => 'Hsp_query-frame',
 751                                     'Data' =>
 752                                       "-@{[(($v->{px0} - $v->{ax0}) % 3) + 1]}"
 753                                 }
 754                             );
 755                         }
 756                         else {
 757                             $self->element(
 758                                 {
 759                                     'Name' => 'Hsp_query-frame',
 760                                     'Data' =>
 761                                       "+@{[(($v->{an0} - $v->{pn0}) % 3) + 1]}"
 762                                 }
 763                             );
 764                         }
 765                         if ( $v->{ax1} < $v->{an1} ) {
 766                             $self->element(
 767                                 {
 768                                     'Name' => 'Hsp_hit-frame',
 769                                     'Data' =>
 770                                       "-@{[(($v->{px1} - $v->{ax1}) % 3) + 1]}"
 771                                 }
 772                             );
 773                         }
 774                         else {
 775                             $self->element(
 776                                 {
 777                                     'Name' => 'Hsp_hit-frame',
 778                                     'Data' =>
 779                                       "+@{[(($v->{an1} - $v->{pn1}) % 3) + 1]}"
 780                                 }
 781                             );
 782                         }
 783                     }
 784                     else {
 785                         $self->element(
 786                             {
 787                                 'Name' => 'Hsp_query-frame',
 788                                 'Data' => $v->{lframe}
 789                             }
 790                         );
 791                         $self->element(
 792                             { 'Name' => 'Hsp_hit-frame', 'Data' => 0 } );
 793                     }
 794                 }
 795                 else {
 796                     $self->element(
 797                         { 'Name' => 'Hsp_query-frame', 'Data' => 0 } );
 798                     $self->element(
 799                         { 'Name' => 'Hsp_hit-frame', 'Data' => $v->{lframe} } );
 800                 }
 801
 802             }
 803             else {
 804                 $self->warn("unable to parse FASTA score line: $_");
 805             }
 806         }
 807         elsif (/\d+\s*residues\s*in\s*\d+\s*query\s*sequences/) {
 808             if ( $self->in_element('hsp') ) {
 809                 $self->end_element( { 'Name' => 'Hsp' } );
 810             }
 811             if ( $self->in_element('hit') ) {
 812                 $self->end_element( { 'Name' => 'Hit' } );
 813             }
 814
 815            #       $_ = $self->_readline();
 816            #       my ( $liblen,$libsize) = /(\d+)\s+residues\s*in(\d+)\s*library/;
 817            # fast forward to the end of the file as there is
 818            # nothing else left to do with this file and want to be sure and
 819            # reset it
 820             while ( defined( $_ = $self->_readline() ) ) {
 821                 last if (/^Function used was/);
 822                 if (
 823                     /(\S+)\s+searches\s+a\s+(protein\s+or\s+DNA\s+)?
 824            sequence/oxi || /(\S+)\s+compares\s+a/oi
 825                   )
 826                 {
 827                     $self->_pushback($_);
 828                 }
 829             }
 830
 831             if (@hit_signifs) {
 832
 833                 # process remaining best hits
 834                 for my $h (@hit_signifs) {
 835
 836                     # Hsp_score Hsp_evalue Hsp_bit-score
 837                     # Hsp_sw-score Hsp_gaps Hsp_identity Hsp_positive
 838                     # Hsp_align-len Hsp_query-from Hsp_query-to
 839                     # Hsp_hit-from Hsp_hit-to Hsp_qseq Hsp_midline
 840
 841                     $self->start_element( { 'Name' => 'Hit' } );
 842                     $self->element(
 843                         {
 844                             'Name' => 'Hit_len',
 845                             'Data' => $h->{hit_len}
 846                         }
 847                     ) if exists $h->{hit_len};
 848                     $self->element(
 849                         {
 850                             'Name' => 'Hit_id',
 851                             'Data' => $h->{id}
 852                         }
 853                     ) if exists $h->{id};
 854                     $self->element(
 855                         {
 856                             'Name' => 'Hit_accession',
 857                             'Data' => $h->{acc}
 858                         }
 859                     ) if exists $h->{acc};
 860                     $self->element(
 861                         {
 862                             'Name' => 'Hit_def',
 863                             'Data' => $h->{desc}
 864                         }
 865                     ) if exists $h->{desc};
 866                     $self->element(
 867                         {
 868                             'Name' => 'Hit_signif',
 869                             'Data' => $h->{evalue}
 870                         }
 871                     ) if exists $h->{evalue};
 872                     $self->element(
 873                         {
 874                             'Name' => 'Hit_score',
 875                             'Data' => $h->{bits}
 876                         }
 877                     ) if exists $h->{bits};
 878
 879                     $self->start_element( { 'Name' => 'Hsp' } );
 880                     $self->element(
 881                         { 'Name' => 'Hsp_score', 'Data' => $h->{'z-sc'} } )
 882                       if exists $h->{'z-sc'};
 883                     $self->element(
 884                         { 'Name' => 'Hsp_evalue', 'Data' => $h->{evalue} } )
 885                       if exists $h->{evalue};
 886                     $self->element(
 887                         { 'Name' => 'Hsp_bit-score', 'Data' => $h->{bits} } )
 888                       if exists $h->{bits};
 889                     $self->element(
 890                         { 'Name' => 'Hsp_sw-score', 'Data' => $h->{sw} } )
 891                       if exists $h->{sw};
 892                     $self->element(
 893                         { 'Name' => 'Hsp_gaps', 'Data' => $h->{'%_gid'} } )
 894                       if exists $h->{'%_gid'};
 895                     $self->element(
 896                         {
 897                             'Name' => 'Hsp_identity',
 898                             'Data' =>
 899                               sprintf( "%.0f", $h->{'%_id'} * $h->{alen} )
 900                         }
 901                     ) if ( exists $h->{'%_id'} && exists $h->{alen} );
 902
 903                     if ( exists $h->{'%_gid'} ) {
 904                         $self->element(
 905                             {
 906                                 'Name' => 'Hsp_positive',
 907                                 'Data' =>
 908                                   sprintf( "%.0f", $h->{'%_gid'} * $h->{alen} )
 909                             }
 910                         ) if exists $h->{'%_gid'} && exists $h->{alen};
 911                     }
 912                     else {
 913                         $self->element(
 914                             {
 915                                 'Name' => 'Hsp_positive',
 916                                 'Data' =>
 917                                   sprintf( "%.0f", $h->{'%_id'} * $h->{alen} )
 918                             }
 919                         ) if ( exists $h->{'%_id'} && exists $h->{alen} );
 920                     }
 921                     $self->element(
 922                         { 'Name' => 'Hsp_align-len', 'Data' => $h->{alen} } )
 923                       if exists $h->{alen};
 924                     $self->element(
 925                         { 'Name' => 'Hsp_query-from', 'Data' => $h->{an0} } )
 926                       if exists $h->{an0};
 927                     $self->element(
 928                         { 'Name' => 'Hsp_query-to', 'Data' => $h->{ax0} } )
 929                       if exists $h->{ax0};
 930                     $self->element(
 931                         { 'Name' => 'Hsp_hit-from', 'Data' => $h->{an1} } )
 932                       if exists $h->{an1};
 933                     $self->element(
 934                         { 'Name' => 'Hsp_hit-to', 'Data' => $h->{ax1} } )
 935                       if exists $h->{ax1};
 936
 937                     $self->element(
 938                         { 'Name' => 'Hsp_querygaps', 'Data' => $h->{qgaps} } )
 939                       if exists $h->{qgaps};
 940                     $self->element(
 941                         { 'Name' => 'Hsp_hitgaps', 'Data' => $h->{lgaps} } )
 942                       if exists $h->{lgaps};
 943
 944                     if ( $self->{'_reporttype'} =~ m/^FAST[NXY]$/o ) {
 945                         if ( 8 == scalar grep { exists $h->{$_} }
 946                             qw(an0 ax0 pn0 px0 an1 ax1 pn1 px1) )
 947                         {
 948                             if ( $h->{ax0} < $h->{an0} ) {
 949                                 $self->element(
 950                                     {
 951                                         'Name' => 'Hsp_query-frame',
 952                                         'Data' =>
 953 "-@{[(($h->{px0} - $h->{ax0}) % 3) + 1]}"
 954                                     }
 955                                 );
 956                             }
 957                             else {
 958                                 $self->element(
 959                                     {
 960                                         'Name' => 'Hsp_query-frame',
 961                                         'Data' =>
 962 "+@{[(($h->{an0} - $h->{pn0}) % 3) + 1]}"
 963                                     }
 964                                 );
 965                             }
 966                             if ( $h->{ax1} < $h->{an1} ) {
 967                                 $self->element(
 968                                     {
 969                                         'Name' => 'Hsp_hit-frame',
 970                                         'Data' =>
 971 "-@{[(($h->{px1} - $h->{ax1}) % 3) + 1]}"
 972                                     }
 973                                 );
 974                             }
 975                             else {
 976                                 $self->element(
 977                                     {
 978                                         'Name' => 'Hsp_hit-frame',
 979                                         'Data' =>
 980 "+@{[(($h->{an1} - $h->{pn1}) % 3) + 1]}"
 981                                     }
 982                                 );
 983                             }
 984                         }
 985                         else {
 986                             $self->element(
 987                                 {
 988                                     'Name' => 'Hsp_query-frame',
 989                                     'Data' => $h->{lframe}
 990                                 }
 991                             );
 992                             $self->element(
 993                                 { 'Name' => 'Hsp_hit-frame', 'Data' => 0 } );
 994                         }
 995                     }
 996                     else {
 997                         $self->element(
 998                             { 'Name' => 'Hsp_query-frame', 'Data' => 0 } );
 999                         $self->element(
1000                             {
1001                                 'Name' => 'Hsp_hit-frame',
1002                                 'Data' => $h->{lframe}
1003                             }
1004                         );
1005                     }
1006
1007                     $self->end_element( { 'Name' => 'Hsp' } );
1008                     $self->end_element( { 'Name' => 'Hit' } );
1009                 }
1010             }
1011             $self->end_element( { 'Name' => 'FastaOutput' } );
1012             return $self->end_document();
1013         }
1014         elsif (/^\s*\d+\s*>>>/) {
1015             if ( $self->within_element('FastaOutput') ) {
1016                 if ( $self->in_element('hsp') ) {
1017                     $self->end_element( { 'Name' => 'Hsp' } );
1018                 }
1019                 if ( $self->in_element('hit') ) {
1020                     $self->end_element( { 'Name' => 'Hit' } );
1021                 }
1022
1023                 if (@hit_signifs) {
1024
1025                     # process remaining best hits
1026                     for my $h (@hit_signifs) {
1027                         $self->start_element( { 'Name' => 'Hit' } );
1028                         $self->element(
1029                             {
1030                                 'Name' => 'Hit_len',
1031                                 'Data' => $h->{hit_len}
1032                             }
1033                         ) if exists $h->{hit_len};
1034                         $self->element(
1035                             {
1036                                 'Name' => 'Hit_id',
1037                                 'Data' => $h->{id}
1038                             }
1039                         ) if exists $h->{id};
1040                         $self->element(
1041                             {
1042                                 'Name' => 'Hit_accession',
1043                                 'Data' => $h->{acc}
1044                             }
1045                         ) if exists $h->{acc};
1046                         $self->element(
1047                             {
1048                                 'Name' => 'Hit_def',
1049                                 'Data' => $h->{desc}
1050                             }
1051                         ) if exists $h->{desc};
1052                         $self->element(
1053                             {
1054                                 'Name' => 'Hit_signif',
1055                                 'Data' => $h->{evalue}
1056                             }
1057                         ) if exists $h->{evalue};
1058                         $self->element(
1059                             {
1060                                 'Name' => 'Hit_score',
1061                                 'Data' => $h->{bits}
1062                             }
1063                         ) if exists $h->{bits};
1064
1065                         $self->start_element( { 'Name' => 'Hsp' } );
1066                         $self->element(
1067                             { 'Name' => 'Hsp_score', 'Data' => $h->{'z-sc'} } )
1068                           if exists $h->{'z-sc'};
1069                         $self->element(
1070                             { 'Name' => 'Hsp_evalue', 'Data' => $h->{evalue} } )
1071                           if exists $h->{evalue};
1072                         $self->element(
1073                             { 'Name' => 'Hsp_bit-score', 'Data' => $h->{bits} }
1074                         ) if exists $h->{bits};
1075                         $self->element(
1076                             { 'Name' => 'Hsp_sw-score', 'Data' => $h->{sw} } )
1077                           if exists $h->{sw};
1078                         $self->element(
1079                             { 'Name' => 'Hsp_gaps', 'Data' => $h->{'%_gid'} } )
1080                           if exists $h->{'%_gid'};
1081                         $self->element(
1082                             {
1083                                 'Name' => 'Hsp_identity',
1084                                 'Data' =>
1085                                   sprintf( "%.0f", $h->{'%_id'} * $h->{alen} )
1086                             }
1087                         ) if ( exists $h->{'%_id'} && exists $h->{alen} );
1088
1089                         if ( exists $h->{'%_gid'} ) {
1090                             $self->element(
1091                                 {
1092                                     'Name' => 'Hsp_positive',
1093                                     'Data' => sprintf( "%.0f",
1094                                         $h->{'%_gid'} * $h->{alen} )
1095                                 }
1096                             ) if exists $h->{'%_gid'} && exists $h->{alen};
1097                         }
1098                         else {
1099                             $self->element(
1100                                 {
1101                                     'Name' => 'Hsp_positive',
1102                                     'Data' => sprintf( "%.0f",
1103                                         $h->{'%_id'} * $h->{alen} )
1104                                 }
1105                             ) if ( exists $h->{'%_id'} && exists $h->{alen} );
1106                         }
1107                         $self->element(
1108                             { 'Name' => 'Hsp_align-len', 'Data' => $h->{alen} }
1109                         ) if exists $h->{alen};
1110                         $self->element(
1111                             { 'Name' => 'Hsp_query-from', 'Data' => $h->{an0} }
1112                         ) if exists $h->{an0};
1113                         $self->element(
1114                             { 'Name' => 'Hsp_query-to', 'Data' => $h->{ax0} } )
1115                           if exists $h->{ax0};
1116                         $self->element(
1117                             { 'Name' => 'Hsp_hit-from', 'Data' => $h->{an1} } )
1118                           if exists $h->{an1};
1119                         $self->element(
1120                             { 'Name' => 'Hsp_hit-to', 'Data' => $h->{ax1} } )
1121                           if exists $h->{ax1};
1122
1123                         $self->element(
1124                             {
1125                                 'Name' => 'Hsp_querygaps',
1126                                 'Data' => $h->{qgaps}
1127                             }
1128                         ) if exists $h->{qgaps};
1129                         $self->element(
1130                             { 'Name' => 'Hsp_hitgaps', 'Data' => $h->{lgaps} } )
1131                           if exists $h->{lgaps};
1132
1133                         if ( $self->{'_reporttype'} =~ m/^FAST[NXY]$/o ) {
1134                             if ( 8 == scalar grep { exists $h->{$_} }
1135                                 qw(an0 ax0 pn0 px0 an1 ax1 pn1 px1) )
1136                             {
1137                                 if ( $h->{ax0} < $h->{an0} ) {
1138                                     $self->element(
1139                                         {
1140                                             'Name' => 'Hsp_query-frame',
1141                                             'Data' => "-@{[(($h->{px0} - $h->{ax0}) % 3) + 1]}"
1142                                         }
1143                                     );
1144                                 }
1145                                 else {
1146                                     $self->element(
1147                                         {
1148                                             'Name' => 'Hsp_query-frame',
1149                                             'Data' => "+@{[(($h->{an0} - $h->{pn0}) % 3) + 1]}"
1150                                         }
1151                                     );
1152                                 }
1153                                 if ( $h->{ax1} < $h->{an1} ) {
1154                                     $self->element(
1155                                         {
1156                                             'Name' => 'Hsp_hit-frame',
1157                                             'Data' => "-@{[(($h->{px1} - $h->{ax1}) % 3) + 1]}"
1158                                         }
1159                                     );
1160                                 }
1161                                 else {
1162                                     $self->element(
1163                                         {
1164                                             'Name' => 'Hsp_hit-frame',
1165                                             'Data' => "+@{[(($h->{an1} - $h->{pn1}) % 3) + 1]}"
1166                                         }
1167                                     );
1168                                 }
1169                             }
1170                             else {
1171                                 $self->element(
1172                                     {
1173                                         'Name' => 'Hsp_query-frame',
1174                                         'Data' => $h->{lframe}
1175                                     }
1176                                 );
1177                                 $self->element(
1178                                     { 'Name' => 'Hsp_hit-frame', 'Data' => 0 }
1179                                 );
1180                             }
1181                         }
1182                         else {
1183                             $self->element(
1184                                 { 'Name' => 'Hsp_query-frame', 'Data' => 0 } );
1185                             $self->element(
1186                                 {
1187                                     'Name' => 'Hsp_hit-frame',
1188                                     'Data' => $h->{lframe}
1189                                 }
1190                             );
1191                         }
1192
1193                         $self->end_element( { 'Name' => 'Hsp' } );
1194                         $self->end_element( { 'Name' => 'Hit' } );
1195                     }
1196                 }
1197                 $self->end_element( { 'Name' => 'FastaOutput' } );
1198                 $self->_pushback($_);
1199                 return $self->end_document();
1200             }
1201             else {
1202                 $self->start_element( { 'Name' => 'FastaOutput' } );
1203                 $self->{'_result_count'}++;
1204                 $seentop = 1;
1205                 $self->element(
1206                     {
1207                         'Name' => 'FastaOutput_program',
1208                         'Data' => $self->{'_reporttype'}
1209                     }
1210                 );
1211                 $self->element(
1212                     {
1213                         'Name' => 'FastaOutput_version',
1214                         'Data' => $self->{'_version'}
1215                     }
1216                 );
1217
1218                 my ( $type, $querylen, $querytype, $querydef );
1219
1220                 if (/^\s*\d+\s*>>>(.*)/) {
1221                     $querydef = $1;
1222                     if ( $querydef =~ /^(.*?)\s+(?:\-\s+)?(\d+)\s+(aa|nt).*$/o )
1223                     {
1224                         ( $querydef, $querylen, $querytype ) = ( $1, $2, $3 );
1225                     }
1226                 }
1227
1228                 if (   $self->{'_reporttype'}
1229                     && $self->{'_reporttype'} eq 'FASTA' )
1230                 {
1231                     if ( $querytype eq 'nt' ) {
1232                         $self->{'_reporttype'} = 'FASTN';
1233                     }
1234                     elsif ( $querytype eq 'aa' ) {
1235                         $self->{'_reporttype'} = 'FASTP';
1236                     }
1237                 }
1238                 my ( $name, $descr ) =
1239                   ( $querydef =~ m/^(\S+)(?:\s+(.*))?\s*$/o );
1240                 $self->element(
1241                     {
1242                         'Name' => 'FastaOutput_query-def',
1243                         'Data' => $name
1244                     }
1245                 );
1246                 $self->element(
1247                     {
1248                         'Name' => 'FastaOutput_querydesc',
1249                         'Data' => $descr
1250                     }
1251                 );
1252                 if ($querylen) {
1253                     $self->element(
1254                         {
1255                             'Name' => 'FastaOutput_query-len',
1256                             'Data' => $querylen
1257                         }
1258                     );
1259                 }
1260                 else {
1261                     $self->warn("unable to find and set query length");
1262                 }
1263                 if ( defined( $_ = $self->_readline() )
1264                     && ( /^\s*vs\s+(\S+)/ || /^Library:\s+(\S+)/ ) )
1265                 {
1266                     $self->element(
1267                         {
1268                             'Name' => 'FastaOutput_db',
1269                             'Data' => $1
1270                         }
1271                     );
1272                 }
1273
1274             }
1275         }
1276         elsif ( $self->in_element('hsp') ) {
1277             my @data  = ( [], [], [] );
1278             my $count = 0;
1279             my $len   = $self->idlength + 1;
1280             my ($seq1_id);
1281             while ( defined($_) ) {
1282                 chomp;
1283                 #$self->debug("$count $_\n");
1284                 if (/residues in \d+\s+query\s+sequences/o) {
1285                     $self->_pushback($_);
1286                     last;
1287                 }
1288                 elsif (/^>>>\*\*\*/o) {
1289                     $self->end_element( { Name => "Hsp" } );
1290                     last;
1291                 }
1292                 elsif (/^>>/o) {
1293                     $self->_pushback($_);
1294                     last;
1295                 }
1296                 elsif (/^\s*\d+\s*>>>/o) {
1297                     $self->_pushback($_);
1298                     last;
1299                 }
1300                 if ( $count == 0 ) {
1301                     if (/^(\S+)\s+/) {
1302                         $self->_pushback($_);
1303                         $count = 2;
1304                     }
1305                     elsif ( /^\s+\d+/ || /^\s+$/ ) {
1306
1307                         # do nothing, this is really a 0 line
1308                     }
1309                     elsif ( length($_) == 0 ) {
1310                         $count = -1;
1311                     }
1312                     else {
1313                         $self->_pushback($_);
1314                         $count = 0;
1315                     }
1316                 }
1317                 elsif ( $count == 1 || $count == 3 ) {
1318                     if (/^(\S+)\s+/) {
1319                         $len = CORE::length($1) if $len < CORE::length($1);
1320                         s/\s+$//;    # trim trailing spaces,we don't want them
1321                         push @{ $data[ $count - 1 ] }, substr( $_, $len );
1322                     }
1323                     elsif (/^\s+(\d+)/) {
1324                         $count = -1;
1325                         $self->_pushback($_);
1326                     }
1327                     elsif ( /^\s+$/ || length($_) == 0 ) {
1328                         $count = 5;
1329
1330                         # going to skip these
1331                     }
1332                     else {
1333                         $self->throw(
1334                             "Unrecognized alignment line ($count) '$_'");
1335                     }
1336                 }
1337                 elsif ( $count == 2 ) {
1338                     if (/^\s+\d+\s+/) {
1339                         $self->warn("$_\n") if $self->verbose > 0;
1340
1341                         # we are on a Subject part of the alignment
1342                         # but we THOUGHT we were on the Query
1343                         # move that last line to the proper place
1344                         push @{ $data[2] }, pop @{ $data[0] };
1345                         $count = 4;
1346                     }
1347                     else {
1348
1349                         # toss the first IDLENGTH characters of the line
1350                         if ( length($_) >= $len ) {
1351                             push @{ $data[ $count - 1 ] }, substr( $_, $len );
1352                         }
1353                     }
1354                 }
1355                 last if ( $count++ >= 5 );
1356                 $_ = $self->_readline();
1357             }
1358             if ( @{ $data[0] } || @{ $data[2] } ) {
1359                 $self->characters(
1360                     {
1361                         'Name' => 'Hsp_qseq',
1362                         'Data' => join( '', @{ $data[0] } )
1363                     }
1364                 );
1365                 $self->characters(
1366                     {
1367                         'Name' => 'Hsp_midline',
1368                         'Data' => join( '', @{ $data[1] } )
1369                     }
1370                 );
1371                 $self->characters(
1372                     {
1373                         'Name' => 'Hsp_hseq',
1374                         'Data' => join( '', @{ $data[2] } )
1375                     }
1376                 );
1377             }
1378         }
1379         else {
1380             if ( !$seentop ) {
1381                 $self->debug($_);
1382                 #$self->warn("unrecognized FASTA Family report file!");
1383                 #return;
1384             }
1385         }
1386     }
1387     if ( $self->in_element('result') ) {
1388         if ( $self->in_element('hsp') ) {
1389             $self->end_element( { 'Name' => 'Hsp' } );
1390         }
1391         if ( $self->in_element('hit') ) {
1392             $self->end_element( { 'Name' => 'Hit' } );
1393         }
1394         $self->end_element( { 'Name' => 'FastaOutput' } );
1395     }
1396     return $self->end_document();
1397 }
1398
1399 =head2 start_element
1400
1401  Title   : start_element
1402  Usage   : $eventgenerator->start_element
1403  Function: Handles a start element event
1404  Returns : none
1405  Args    : hashref with at least 2 keys 'Data' and 'Name'
1406
1407
1408 =cut
1409
1410 sub start_element {
1411     my ( $self, $data ) = @_;
1412
1413     # we currently don't care about attributes
1414     my $nm = $data->{'Name'};
1415     if ( my $type = $MODEMAP{$nm} ) {
1416         $self->_mode($type);
1417         if ( my $handler = $self->_will_handle($type) ) {
1418             my $func = sprintf( "start_%s", lc $type );
1419             $handler->$func( $data->{'Attributes'} );
1420         }
1421         unshift @{ $self->{'_elements'} }, $type;
1422     }
1423     if ( $nm eq 'FastaOutput' ) {
1424         $self->{'_values'} = {};
1425         $self->{'_result'} = undef;
1426         $self->{'_mode'}   = '';
1427     }
1428
1429 }
1430
1431 =head2 end_element
1432
1433  Title   : start_element
1434  Usage   : $eventgenerator->end_element
1435  Function: Handles an end element event
1436  Returns : none
1437  Args    : hashref with at least 2 keys 'Data' and 'Name'
1438
1439
1440 =cut
1441
1442 sub end_element {
1443     my ( $self, $data ) = @_;
1444     my $nm = $data->{'Name'};
1445     my $rc;
1446
1447     # Hsp are sort of weird, in that they end when another
1448     # object begins so have to detect this in end_element for now
1449     if ( $nm eq 'Hsp' ) {
1450         foreach (qw(Hsp_qseq Hsp_midline Hsp_hseq)) {
1451             $self->element(
1452                 {
1453                     'Name' => $_,
1454                     'Data' => $self->{'_last_hspdata'}->{$_}
1455                 }
1456             );
1457         }
1458         $self->{'_last_hspdata'} = {};
1459     }
1460
1461     if ( my $type = $MODEMAP{$nm} ) {
1462         if ( my $handler = $self->_will_handle($type) ) {
1463             my $func = sprintf( "end_%s", lc $type );
1464             $rc = $handler->$func( $self->{'_reporttype'}, $self->{'_values'} );
1465         }
1466         shift @{ $self->{'_elements'} };
1467
1468     }
1469     elsif ( $MAPPING{$nm} ) {
1470         if ( ref( $MAPPING{$nm} ) =~ /hash/i ) {
1471             my $key = ( keys %{ $MAPPING{$nm} } )[0];
1472             $self->{'_values'}->{$key}->{ $MAPPING{$nm}->{$key} } =
1473               $self->{'_last_data'};
1474         }
1475         else {
1476             $self->{'_values'}->{ $MAPPING{$nm} } = $self->{'_last_data'};
1477         }
1478     }
1479     else {
1480         $self->warn("unknown nm $nm, ignoring\n");
1481     }
1482     $self->{'_last_data'} = '';    # remove read data if we are at
1483                                    # end of an element
1484     $self->{'_result'} = $rc if ( $nm eq 'FastaOutput' );
1485     return $rc;
1486
1487 }
1488
1489 =head2 element
1490
1491  Title   : element
1492  Usage   : $eventhandler->element({'Name' => $name, 'Data' => $str});
1493  Function: Convience method that calls start_element, characters, end_element
1494  Returns : none
1495  Args    : Hash ref with the keys 'Name' and 'Data'
1496
1497
1498 =cut
1499
1500 sub element {
1501     my ( $self, $data ) = @_;
1502     $self->start_element($data);
1503     $self->characters($data);
1504     $self->end_element($data);
1505 }
1506
1507 =head2 characters
1508
1509  Title   : characters
1510  Usage   : $eventgenerator->characters($str)
1511  Function: Send a character events
1512  Returns : none
1513  Args    : string
1514
1515
1516 =cut
1517
1518 sub characters {
1519     my ( $self, $data ) = @_;
1520
1521     return unless ( defined $data->{'Data'} );
1522     if ( $data->{'Data'} =~ /^\s+$/ ) {
1523         return unless $data->{'Name'} =~ /Hsp\_(midline|qseq|hseq)/;
1524     }
1525
1526     if (   $self->in_element('hsp')
1527         && $data->{'Name'} =~ /Hsp\_(qseq|hseq|midline)/ )
1528     {
1529
1530         $self->{'_last_hspdata'}->{ $data->{'Name'} } .= $data->{'Data'};
1531     }
1532
1533     $self->{'_last_data'} = $data->{'Data'};
1534 }
1535
1536 =head2 _mode
1537
1538  Title   : _mode
1539  Usage   : $obj->_mode($newval)
1540  Function:
1541  Example :
1542  Returns : value of _mode
1543  Args    : newvalue (optional)
1544
1545
1546 =cut
1547
1548 sub _mode {
1549     my ( $self, $value ) = @_;
1550     if ( defined $value ) {
1551         $self->{'_mode'} = $value;
1552     }
1553     return $self->{'_mode'};
1554 }
1555
1556 =head2 within_element
1557
1558  Title   : within_element
1559  Usage   : if( $eventgenerator->within_element($element) ) {}
1560  Function: Test if we are within a particular element
1561            This is different than 'in' because within can be tested
1562            for a whole block.
1563  Returns : boolean
1564  Args    : string element name
1565
1566
1567 =cut
1568
1569 sub within_element {
1570     my ( $self, $name ) = @_;
1571     return 0
1572       if (!defined $name && !defined $self->{'_elements'}
1573         || scalar @{ $self->{'_elements'} } == 0 );
1574     foreach ( @{ $self->{'_elements'} } ) {
1575         if ( $_ eq $name || $_ eq $MODEMAP{$name} ) {
1576             return 1;
1577         }
1578     }
1579     return 0;
1580 }
1581
1582 =head2 in_element
1583
1584  Title   : in_element
1585  Usage   : if( $eventgenerator->in_element($element) ) {}
1586  Function: Test if we are in a particular element
1587            This is different than 'in' because within can be tested
1588            for a whole block.
1589  Returns : boolean
1590  Args    : string element name
1591
1592
1593 =cut
1594
1595 sub in_element {
1596     my ( $self, $name ) = @_;
1597     return 0 if !defined $self->{'_elements'}->[0];
1598     return (
1599         $self->{'_elements'}->[0] eq $name
1600           || ( exists $MODEMAP{$name}
1601             && $self->{'_elements'}->[0] eq $MODEMAP{$name} )
1602     );
1603 }
1604
1605 =head2 start_document
1606
1607  Title   : start_document
1608  Usage   : $eventgenerator->start_document
1609  Function: Handles a start document event
1610  Returns : none
1611  Args    : none
1612
1613
1614 =cut
1615
1616 sub start_document {
1617     my ($self) = @_;
1618     $self->{'_lasttype'} = '';
1619     $self->{'_values'}   = {};
1620     $self->{'_result'}   = undef;
1621     $self->{'_mode'}     = '';
1622     $self->{'_elements'} = [];
1623 }
1624
1625 =head2 end_document
1626
1627  Title   : end_document
1628  Usage   : $eventgenerator->end_document
1629  Function: Handles an end document event
1630  Returns : Bio::Search::Result::ResultI object
1631  Args    : none
1632
1633
1634 =cut
1635
1636 sub end_document {
1637     my ( $self, @args ) = @_;
1638     return $self->{'_result'};
1639 }
1640
1641 =head2 idlength
1642
1643  Title   : idlength
1644  Usage   : $obj->idlength($newval)
1645  Function: Internal storage of the length of the ID desc
1646            in the HSP alignment blocks.  Defaults to
1647            $IDLENGTH class variable value
1648  Returns : value of idlength
1649  Args    : newvalue (optional)
1650
1651
1652 =cut
1653
1654 sub idlength {
1655     my ( $self, $value ) = @_;
1656     if ( defined $value ) {
1657         $self->{'_idlength'} = $value;
1658     }
1659     return $self->{'_idlength'} || $IDLENGTH;
1660 }
1661
1662 =head2 result_count
1663
1664  Title   : result_count
1665  Usage   : my $count = $searchio->result_count
1666  Function: Returns the number of results we have processed
1667  Returns : integer
1668  Args    : none
1669
1670 =cut
1671
1672 sub result_count {
1673     my $self = shift;
1674     return $self->{'_result_count'};
1675 }
1676
1677 sub attach_EventHandler {
1678     my ( $self, $handler ) = @_;
1679
1680     $self->SUPER::attach_EventHandler($handler);
1681
1682     # Optimization: caching the EventHandler since it is used a lot
1683     # during the parse.
1684
1685     $self->{'_handler_cache'} = $handler;
1686     return;
1687 }
1688
1689 =head2 _will_handle
1690
1691  Title   : _will_handle
1692  Usage   : Private method. For internal use only.
1693               if( $self->_will_handle($type) ) { ... }
1694  Function: Provides an optimized way to check whether or not an element of a
1695            given type is to be handled.
1696  Returns : Reference to EventHandler object if the element type is to be handled.
1697            undef if the element type is not to be handled.
1698  Args    : string containing type of element.
1699
1700 Optimizations:
1701
1702 =over 2
1703
1704 =item 1
1705
1706 Using the cached pointer to the EventHandler to minimize repeated
1707 lookups.
1708
1709 =item 2
1710
1711 Caching the will_handle status for each type that is encountered so
1712 that it only need be checked by calling
1713 handler-E<gt>will_handle($type) once.
1714
1715 =back
1716
1717 This does not lead to a major savings by itself (only 5-10%).  In
1718 combination with other optimizations, or for large parse jobs, the
1719 savings good be significant.
1720
1721 To test against the unoptimized version, remove the parentheses from
1722 around the third term in the ternary " ? : " operator and add two
1723 calls to $self-E<gt>_eventHandler().
1724
1725 =cut
1726
1727 sub _will_handle {
1728     my ( $self, $type ) = @_;
1729     my $handler = $self->{'_handler_cache'};
1730     my $will_handle =
1731       defined( $self->{'_will_handle_cache'}->{$type} )
1732       ? $self->{'_will_handle_cache'}->{$type}
1733       : ( $self->{'_will_handle_cache'}->{$type} =
1734           $handler->will_handle($type) );
1735
1736     return $will_handle ? $handler : undef;
1737 }
1738
1739 1;
1740