File Coverage

Bio/SearchIO/fasta.pm
Criterion Covered Total %
statement 326 488 66.8
branch 174 356 48.8
condition 64 147 43.5
subroutine 18 21 85.7
pod 12 12 100.0
total 594 1024 58.0


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   6 use vars qw(%MODEMAP %MAPPING $IDLENGTH);
  1         2  
  1         65  
85 1     1   5 use strict;
  1         2  
  1         21  
86              
87             # Object preamble - inherits from Bio::Root::RootI
88              
89 1     1   4 use Bio::Factory::ObjectFactory;
  1         1  
  1         141  
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   2 $IDLENGTH = 6;
98              
99             # mapping of NCBI Blast terms to Bioperl hash keys
100 1         3 %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         38 %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   5 use base qw(Bio::SearchIO);
  1         1  
  1         6113  
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   29 my ( $self, @args ) = @_;
185 8         51 $self->SUPER::_initialize(@args);
186 8 50       31 return unless @args;
187 8         31 my ($idlength) = $self->_rearrange( [qw(IDLENGTH)], @args );
188 8   33     63 $self->idlength( $idlength || $IDLENGTH );
189 8         35 $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         37 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 952 my ($self) = @_;
211 11         62 local $/ = "\n";
212 11         25 local $_;
213              
214 11         24 my $data = '';
215 11         20 my $seentop = 0;
216 11         14 my $current_hsp;
217 11         17 my $m9HSP = 0;
218 11         42 $self->start_document();
219 11         24 my @hit_signifs;
220 11         55 while ( defined( $_ = $self->_readline ) ) {
221 1172 100 100     2254 next if ( !$self->in_element('hsp')
222             && /^\s+$/ ); # skip empty lines
223 1151 100 100     24640 if (
    100 66        
    100 66        
    50 33        
    50 66        
    100 66        
    100 66        
    100 66        
    100 33        
    50 33        
    100 66        
    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       25 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         30 $self->{'_reporttype'} = $1;
245 8         54 $self->start_element( { 'Name' => 'FastaOutput' } );
246 8         24 $self->{'_result_count'}++;
247 8         13 $seentop = 1;
248             #$self->debug( "reporttype is " . $self->{'_reporttype'} . "\n" );
249             $self->element(
250             {
251             'Name' => 'FastaOutput_program',
252 8         62 'Data' => $self->{'_reporttype'}
253             }
254             );
255 8         21 my $version;
256             # version 35 version string on same line
257 8 100       33 if (/version/) {
258 1         5 ($version) = (/version\s+(\S+)/);
259             }
260             # earlier versions, it's on the next line
261             else {
262 7         26 $_ = $self->_readline();
263 7         45 ($version) = (/version\s+(\S+)/);
264             }
265 8 50       25 $version = '' unless defined $version;
266 8         24 $self->{'_version'} = $version;
267 8         45 $self->element(
268             {
269             'Name' => 'FastaOutput_version',
270             'Data' => $version
271             }
272             );
273              
274 8         25 my ( $last, $leadin, $type, $querylen, $querytype, $querydef );
275              
276 8         35 while ( defined( $_ = $self->_readline() ) ) {
277 42 100       176 if (
    100          
278             /^ (
279             (?:\s+>) | # fa33 lead-in
280             (?:\s*\d+\s*>>>) # fa34 mlib lead-in
281             )
282             (.*)
283             /x
284             )
285             {
286 6         30 ( $leadin, $querydef ) = ( $1, $2 );
287 6 100       31 if ( $leadin =~ m/>>>/ ) {
288 4 50       50 if ( $querydef =~
289             /^(.*?)\s+(?:\-\s+)?(\d+)\s+(aa|nt).*$/o )
290             {
291 4         17 ( $querydef, $querylen, $querytype ) =
292             ( $1, $2, $3 );
293 4         11 last;
294             }
295             }
296             else {
297 2 50       16 if ( $last =~ /(\S+)[:,]\s*(\d+)\s+(aa|nt)/ ) {
298 2         15 ( $querylen, $querytype ) = ( $2, $3 );
299 2   33     12 $querydef ||= $1;
300 2         6 last;
301             }
302             }
303             }
304             elsif (m/^\s*vs\s+\S+/o) {
305 2 50       17 if ( $last =~ /(\S+)[,:]\s+(\d+)\s+(aa|nt)/o ) {
306 2         10 ( $querydef, $querylen, $querytype ) = ( $1, $2, $3 );
307 2         8 last;
308             }
309             }
310 34         77 $last = $_;
311             }
312 8 100 66     56 if ( $self->{'_reporttype'}
313             && $self->{'_reporttype'} eq 'FASTA' )
314             {
315 7 100       28 if ( $querytype eq 'nt' ) {
    50          
316 4         12 $self->{'_reporttype'} = 'FASTN';
317             }
318             elsif ( $querytype eq 'aa' ) {
319 3         8 $self->{'_reporttype'} = 'FASTP';
320             }
321             }
322 8         53 my ( $name, $descr ) = $querydef =~ m/^(\S+)\s*(.*?)\s*$/o;
323 8         57 $self->element(
324             {
325             'Name' => 'FastaOutput_query-def',
326             'Data' => $name
327             }
328             );
329 8         43 $self->element(
330             {
331             'Name' => 'FastaOutput_querydesc',
332             'Data' => $descr
333             }
334             );
335 8 50       22 if ($querylen) {
336 8         40 $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     146 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         49 $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         65 $self->element(
376             {
377             'Name' => 'FastaOutput_db-let',
378             'Data' => $1
379             }
380             );
381 8         52 $self->element(
382             {
383             'Name' => 'FastaOutput_db-len',
384             'Data' => $2
385             }
386             );
387 8         47 $self->element(
388             {
389             'Name' => 'Statistics_db-len',
390             'Data' => $1
391             }
392             );
393 8         41 $self->element(
394             {
395             'Name' => 'Statistics_db-num',
396             'Data' => $2
397             }
398             );
399             }
400             elsif (/Lambda=\s*(\S+)/) {
401 8         51 $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         37 my $rel = $1;
474 8         60 my @labels = split;
475             @labels = map {
476 8 100       65 if ( $_ =~ m/^E\((\d+)\)$/o )
  39 50       79  
477             {
478 8         53 $self->element(
479             { 'Name' => 'Statistics_eff-space', 'Data' => $1 } );
480 8         42 "evalue";
481             }
482             else {
483             # canonicalize changed column headers
484 31 100       88 if ($_ eq "gapl") {
    100          
    50          
485 1         2 $_ = "lgaps";
486             } elsif ($_ eq "gapq") {
487 1         2 $_ = "qgaps";
488             } elsif ($_ eq "E2()") {
489 0         0 $_ = "evalue2";
490             }
491              
492 31         64 $_;
493             }
494             } @labels[ $rel ? 5 : 4 .. $#labels ];
495              
496 8   66     29 while ( defined( $_ = $self->_readline() )
497             && !/^\s+$/ )
498             {
499 180         686 my @line = split;
500              
501 180 50 33     384 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       348 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         217 my (%data, %hspData);
525 180         855 @data{@labels} = @hspData{@labels} = splice( @line, @line - @labels );
526 180 100       506 if ( $line[-1] =~ m/\[([1-6rf])\]/o ) {
527 150         279 my $fr = $1;
528             $hspData{lframe} = $data{lframe} = (
529 150 0       418 $fr =~ /\d/o
    100          
    50          
530 0         0 ? ( $fr <= 3 ? "+$fr" : "-@{[$fr-3]}" )
531             : ( $fr eq 'f' ? '+1' : '-1' )
532             );
533 150         189 pop @line;
534             }
535             else {
536 30         51 $hspData{lframe} = $data{lframe} = '0';
537             }
538              
539 180 50       473 if ( $line[-1] =~ m/^\(?(\d+)\)$/ ) {
540 180         378 $data{hit_len} = $1;
541 180         202 pop @line;
542 180 100       386 if ( $line[-1] =~ m/^\($/ ) {
543 81         115 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         1448 ($_) = m/^(\S+(?:\s+\S+){$#line})/;
552              
553 180         625 my ( $id, $desc ) = split( /\s+/, $_, 2 );
554 180         386 my @pieces = split( /\|/, $id );
555 180         234 my $acc = pop @pieces;
556 180         262 $acc =~ s/\.\d+$//;
557              
558 180         541 @data{qw(id desc acc)} = ( $id, $desc, $acc );
559 180         361 $data{HSPs} = [ \%hspData ];
560              
561 180         655 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         35 $self->element(
570             {
571             'Name' => 'Parameters_matrix',
572             'Data' => $2
573             }
574             );
575 5 50       34 $self->element(
576             {
577             'Name' => 'Parameters_filter',
578             'Data' => defined $3 ? 1 : 0,
579             }
580             );
581 5         41 $self->element(
582             {
583             'Name' => 'Parameters_ktup',
584             'Data' => $4
585             }
586             );
587             $self->{'_reporttype'} = $1
588 5 100       32 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         19 $_ = $self->_readline();
597 5 50       41 if (/(?:gap\-pen|open\/ext):\s+([\-\+]?\d+)\s*\/\s*([\-\+]?\d+)/) {
598 5         30 $self->element(
599             {
600             'Name' => 'Parameters_gap-open',
601             'Data' => $1
602             }
603             );
604 5         26 $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         26 'Data' => $self->{'_reporttype'}
616             }
617             );
618              
619             }
620             elsif (/^Algorithm:\s+(\S+)\s+.*\s*\(([^)]+)\)\s+(\S+)/) {
621             $self->{'_reporttype'} = $1
622 3 50       24 if ( $self->{'_reporttype'} !~ /FAST[PN]/i );
623             }
624             elsif ( /^Parameters:/ ) { # FASTA 35.04/FASTA 36
625 3         23 m/Parameters:\s+(\S+)\s+matrix\s+\([^\)]+\)(xS)?,?\s/;
626 3         23 $self->element(
627             {
628             'Name' => 'Parameters_matrix',
629             'Data' => $1
630             }
631             );
632 3 50       28 $self->element(
633             {
634             'Name' => 'Parameters_filter',
635             'Data' => defined $2 ? $2 : 0,
636             }
637             );
638 3 50       23 if (/ktup:\s(\d+)/) {
639 3         22 $self->element(
640             {
641             'Name' => 'Parameters_ktup',
642             'Data' => $1
643             }
644             );
645 3 50       23 if (/ktup:\s\d+$/) {
646 3         13 $_ = $self->_readline();
647             }
648              
649             }
650 3 50       27 if (/(?:gap\-pen|open\/ext):\s+([\-\+]?\d+)\s*\/\s*([\-\+]?\d+)/) {
651 3         21 $self->element(
652             {
653             'Name' => 'Parameters_gap-open',
654             'Data' => $1
655             }
656             );
657 3         20 $self->element(
658             {
659             'Name' => 'Parameters_gap-ext',
660             'Data' => $2
661             }
662             );
663             }
664             $self->element(
665             {
666             'Name' => 'FastaOutput_program',
667 3         20 '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       461 if ( $self->in_element('hsp') ) {
684 172         434 $self->end_element( { 'Name' => 'Hsp' } );
685             }
686              
687 180         332 my $firstHSP = 0;
688 180 50       560 if ($1 ne ">--") {
689 180         215 $firstHSP = 1;
690              
691 180         478 my ($hit_id, $len, $alphabet) = ($1, $2, $3);
692 180 50 33     599 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       366 if ( $self->in_element('hit') ) {
706 172         473 $self->end_element( { 'Name' => 'Hit' } );
707 172 50       401 shift @hit_signifs if @hit_signifs;
708             }
709              
710 180         1017 $self->start_element( { 'Name' => 'Hit' } );
711 180         667 $self->element(
712             {
713             'Name' => 'Hit_len',
714             'Data' => $len
715             }
716             );
717 180         899 my ( $id, $desc ) = split( /\s+/, $hit_id, 2 );
718 180         535 $self->element(
719             {
720             'Name' => 'Hit_id',
721             'Data' => $id
722             }
723             );
724              
725             #$self->debug("Hit ID is $id\n");
726 180         504 my @pieces = split( /\|/, $id );
727 180         311 my $acc = pop @pieces;
728 180         343 $acc =~ s/\.\d+$//;
729 180         494 $self->element(
730             {
731             'Name' => 'Hit_accession',
732             'Data' => $acc
733             }
734             );
735 180         512 $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         528 $_ = $self->_readline();
748 180         1437 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       417 $bits = $score unless defined $bits;
754              
755 180         194 my ($v);
756              
757 180 50 33     482 if ($firstHSP && !$m9HSP) {
758 180         318 $v = shift @{$hit_signifs[0]->{HSPs}}
759 180 50 33     382 if (@hit_signifs && @{$hit_signifs[0]->{HSPs}});
  180         607  
760 180         414 $current_hsp = $v;
761             }
762             else {
763 0         0 $v = $current_hsp;
764             }
765              
766 180 50       297 if ( defined $v ) {
767 180         262 @{$v}{qw(evalue evalue2 bits z-sc)} = ( $e, $e2, $bits, $score );
  180         538  
768             }
769              
770 180 50       310 if ($firstHSP) {
771             $self->element(
772             {
773             'Name' => 'Hit_signif',
774 180 50       673 'Data' => $v ? $v->{evalue} : $e
775             }
776             );
777             $self->element(
778             {
779             'Name' => 'Hit_score',
780 180 50       644 'Data' => $v ? $v->{bits} : $bits
781             }
782             );
783             }
784              
785 180         500 $self->start_element( { 'Name' => 'Hsp' } );
786              
787             $self->element(
788             {
789             'Name' => 'Hsp_score',
790 180 50       691 'Data' => $v ? $v->{'z-sc'} : $score
791             }
792             );
793             $self->element(
794             {
795             'Name' => 'Hsp_evalue',
796 180 50       743 '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     1268 ) if (($v && exists($v->{evalue2})) || defined $e2);
    50 33        
      33        
805              
806             $self->element(
807             {
808             'Name' => 'Hsp_bit-score',
809 180 50       661 'Data' => $v ? $v->{bits} : $bits
810             }
811             );
812 180         497 $_ = $self->_readline();
813              
814 180 50       427 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       639 if (s/Smith-Waterman score:\s*(\d+)\;?//) {
823 91         377 $self->element(
824             {
825             'Name' => 'Hsp_sw-score',
826             'Data' => $1
827             }
828             );
829             }
830 180 50       1463 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         832 my ( $identper, $gapper, $len, $querystart, $queryend,
839             $hitstart, $hitend )
840             = ( $1, $2, $3, $4, $5, $6, $7 );
841 180         969 my $ident = sprintf( "%.0f", ( $identper / 100 ) * $len );
842 180         379 my $positive = sprintf( "%.0f", ( $gapper / 100 ) * $len );
843              
844 180         593 $self->element(
845             {
846             'Name' => 'Hsp_identity',
847             'Data' => $ident
848             }
849             );
850 180         622 $self->element(
851             {
852             'Name' => 'Hsp_positive',
853             'Data' => $positive
854             }
855             );
856 180         615 $self->element(
857             {
858             'Name' => 'Hsp_align-len',
859             'Data' => $len
860             }
861             );
862              
863 180         579 $self->element(
864             {
865             'Name' => 'Hsp_query-from',
866             'Data' => $querystart
867             }
868             );
869 180         589 $self->element(
870             {
871             'Name' => 'Hsp_query-to',
872             'Data' => $queryend
873             }
874             );
875 180         594 $self->element(
876             {
877             'Name' => 'Hsp_hit-from',
878             'Data' => $hitstart
879             }
880             );
881 180         537 $self->element(
882             {
883             'Name' => 'Hsp_hit-to',
884             'Data' => $hitend
885             }
886             );
887              
888             }
889              
890 180 50       345 if ($v) {
891             $self->element(
892             { 'Name' => 'Hsp_querygaps', 'Data' => $v->{qgaps} } )
893 180 100       333 if exists $v->{qgaps};
894             $self->element(
895             { 'Name' => 'Hsp_hitgaps', 'Data' => $v->{lgaps} } )
896 180 100       307 if exists $v->{lgaps};
897              
898 180 100       490 if ( $self->{'_reporttype'} =~ m/^FAST[NXY]$/o ) {
899 150 100       278 if ( 8 == scalar grep { exists $v->{$_} }
  1200         1830  
900             qw(an0 ax0 pn0 px0 an1 ax1 pn1 px1) )
901             {
902 1 50       5 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         3 $self->element(
913             {
914             'Name' => 'Hsp_query-frame',
915             'Data' =>
916 1         11 "+@{[(($v->{an0} - $v->{pn0}) % 3) + 1]}"
917             }
918             );
919             }
920 1 50       6 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         4 $self->element(
931             {
932             'Name' => 'Hsp_hit-frame',
933             'Data' =>
934 1         8 "+@{[(($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         465 );
946 149         435 $self->element(
947             { 'Name' => 'Hsp_hit-frame', 'Data' => 0 } );
948             }
949             }
950             else {
951 30         96 $self->element(
952             { 'Name' => 'Hsp_query-frame', 'Data' => 0 } );
953             $self->element(
954 30         104 { '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       31 if ( $self->in_element('hsp') ) {
964 8         326 $self->end_element( { 'Name' => 'Hsp' } );
965             }
966 8 50       38 if ( $self->in_element('hit') ) {
967 8         38 $self->end_element( { 'Name' => 'Hit' } );
968 8 50       48 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         61 while ( defined( $_ = $self->_readline() ) ) {
978 48 100       108 last if (/^Function used was/);
979 40 50 33     323 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       29 $self->_processHits(@hit_signifs) if @hit_signifs;
989              
990 8         42 $self->end_element( { 'Name' => 'FastaOutput' } );
991 8         40 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         1272 my @data = ( [], [], [] );
1087 682         733 my $count = 0;
1088 682         969 my $len = $self->idlength + 1;
1089 682         1014 my ($seq1_id);
1090 682         897 while ( defined($_) ) {
1091 4236         4495 chomp;
1092             #$self->debug("$count $_\n");
1093 4236 100       10848 if (/residues in \d+\s+query\s+sequences/o) {
    50          
    100          
    50          
1094 8         46 $self->_pushback($_);
1095 8         14 last;
1096             }
1097             elsif (/^>>>(\*\*\*|\/\/\/|<<<)/o) {
1098 0         0 $self->end_element( { Name => "Hsp" } );
1099 0         0 last;
1100             }
1101             elsif (/^>>/o) {
1102 7         33 $self->_pushback($_);
1103 7         16 last;
1104             }
1105             elsif (/^\s*\d+\s*>>>/o) {
1106 0         0 $self->_pushback($_);
1107 0         0 last;
1108             }
1109 4221 100 100     9135 if ( $count == 0 ) {
    100          
    100          
1110 872 50 100     3067 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         271 $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     2947 if (/^(\S+)\s+/) {
    0          
    0          
    0          
1128 1341 50       2733 $len = CORE::length($1) if $len < CORE::length($1);
1129 1341         2525 s/\s+$//; # trim trailing spaces,we don't want them
1130 1341         1281 push @{ $data[ $count - 1 ] }, substr( $_, $len );
  1341         3042  
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       1803 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       988 if ( length($_) >= $len ) {
1166 667         580 push @{ $data[ $count - 1 ] }, substr( $_, $len );
  667         1474  
1167             }
1168             }
1169             }
1170 4221 100       6055 last if ( $count++ >= 5 );
1171 3554         5523 $_ = $self->_readline();
1172             }
1173 682 100 66     721 if ( @{ $data[0] } || @{ $data[2] } ) {
  682         1349  
  8         43  
1174             $self->characters(
1175             {
1176             'Name' => 'Hsp_qseq',
1177 674         705 'Data' => join( '', @{ $data[0] } )
  674         2426  
1178             }
1179             );
1180             $self->characters(
1181             {
1182             'Name' => 'Hsp_midline',
1183 674         987 'Data' => join( '', @{ $data[1] } )
  674         1881  
1184             }
1185             );
1186             $self->characters(
1187             {
1188             'Name' => 'Hsp_hseq',
1189 674         977 'Data' => join( '', @{ $data[2] } )
  674         1618  
1190             }
1191             );
1192             }
1193             }
1194             else {
1195 238 100       597 if ( !$seentop ) {
1196 1         14 $self->debug($_);
1197             #$self->warn("unrecognized FASTA Family report file!");
1198             #return;
1199             }
1200             }
1201             }
1202 3 50       11 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         13 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 4603 my ( $self, $data ) = @_;
1228              
1229             # we currently don't care about attributes
1230 4565         4818 my $nm = $data->{'Name'};
1231 4565 100       7019 if ( my $type = $MODEMAP{$nm} ) {
1232 368         673 $self->_mode($type);
1233 368 50       548 if ( my $handler = $self->_will_handle($type) ) {
1234 368         1046 my $func = sprintf( "start_%s", lc $type );
1235 368         1549 $handler->$func( $data->{'Attributes'} );
1236             }
1237 368         573 unshift @{ $self->{'_elements'} }, $type;
  368         748  
1238             }
1239 4565 100       7205 if ( $nm eq 'FastaOutput' ) {
1240 8         21 $self->{'_values'} = {};
1241 8         16 $self->{'_result'} = undef;
1242 8         20 $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 5158 my ( $self, $data ) = @_;
1260 4565         4827 my $nm = $data->{'Name'};
1261 4565         3868 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       6323 if ( $nm eq 'Hsp' ) {
1266 180         359 foreach (qw(Hsp_qseq Hsp_midline Hsp_hseq)) {
1267             $self->element(
1268             {
1269             'Name' => $_,
1270 540         1388 'Data' => $self->{'_last_hspdata'}->{$_}
1271             }
1272             );
1273             }
1274 180         493 $self->{'_last_hspdata'} = {};
1275             }
1276              
1277 4565 100       8318 if ( my $type = $MODEMAP{$nm} ) {
    50          
1278 368 50       584 if ( my $handler = $self->_will_handle($type) ) {
1279 368         1139 my $func = sprintf( "end_%s", lc $type );
1280 368         1389 $rc = $handler->$func( $self->{'_reporttype'}, $self->{'_values'} );
1281             }
1282 368         422 shift @{ $self->{'_elements'} };
  368         630  
1283              
1284             }
1285             elsif ( $MAPPING{$nm} ) {
1286 4197 100       5421 if ( ref( $MAPPING{$nm} ) =~ /hash/i ) {
1287 72         100 my $key = ( keys %{ $MAPPING{$nm} } )[0];
  72         203  
1288             $self->{'_values'}->{$key}->{ $MAPPING{$nm}->{$key} } =
1289 72         243 $self->{'_last_data'};
1290             }
1291             else {
1292 4125         6678 $self->{'_values'}->{ $MAPPING{$nm} } = $self->{'_last_data'};
1293             }
1294             }
1295             else {
1296 0         0 $self->warn("unknown nm $nm, ignoring\n");
1297             }
1298 4565         5109 $self->{'_last_data'} = ''; # remove read data if we are at
1299             # end of an element
1300 4565 100       6088 $self->{'_result'} = $rc if ( $nm eq 'FastaOutput' );
1301 4565         6368 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 5099 my ( $self, $data ) = @_;
1318 4197         6053 $self->start_element($data);
1319 4197         6365 $self->characters($data);
1320 4197         5633 $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 6977 my ( $self, $data ) = @_;
1336              
1337 6219 100       9008 return unless ( defined $data->{'Data'} );
1338 6037 100       11917 if ( $data->{'Data'} =~ /^\s+$/ ) {
1339 64 50       186 return unless $data->{'Name'} =~ /Hsp\_(midline|qseq|hseq)/;
1340             }
1341              
1342 6037 100 100     7729 if ( $self->in_element('hsp')
1343             && $data->{'Name'} =~ /Hsp\_(qseq|hseq|midline)/ )
1344             {
1345              
1346 2562         6543 $self->{'_last_hspdata'}->{ $data->{'Name'} } .= $data->{'Data'};
1347             }
1348              
1349 6037         11248 $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   458 my ( $self, $value ) = @_;
1366 368 50       526 if ( defined $value ) {
1367 368         480 $self->{'_mode'} = $value;
1368             }
1369 368         426 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 10776 my ( $self, $name ) = @_;
1413 8508 100       12734 return 0 if !defined $self->{'_elements'}->[0];
1414             return (
1415             $self->{'_elements'}->[0] eq $name
1416             || ( exists $MODEMAP{$name}
1417 8494   66     32739 && $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 34 my ($self) = @_;
1434 11         45 $self->{'_lasttype'} = '';
1435 11         94 $self->{'_values'} = {};
1436 11         43 $self->{'_result'} = undef;
1437 11         23 $self->{'_mode'} = '';
1438 11         27 $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 26 my ( $self, @args ) = @_;
1454 11         160 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 1008 my ( $self, $value ) = @_;
1472 690 100       1014 if ( defined $value ) {
1473 8         18 $self->{'_idlength'} = $value;
1474             }
1475 690   33     1355 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 22 my ( $self, $handler ) = @_;
1495              
1496 8         55 $self->SUPER::attach_EventHandler($handler);
1497              
1498             # Optimization: caching the EventHandler since it is used a lot
1499             # during the parse.
1500              
1501 8         28 $self->{'_handler_cache'} = $handler;
1502 8         15 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   946 my ( $self, $type ) = @_;
1545 736         928 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       1596 : ( $self->{'_will_handle_cache'}->{$type} =
1550             $handler->will_handle($type) );
1551              
1552 736 50       1795 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