File Coverage

Bio/SearchIO/fasta.pm
Criterion Covered Total %
statement 326 488 66.8
branch 174 356 48.8
condition 63 147 42.8
subroutine 18 21 85.7
pod 12 12 100.0
total 593 1024 57.9


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