File Coverage

Bio/SearchIO/hmmer3.pm
Criterion Covered Total %
statement 364 385 94.5
branch 148 178 83.1
condition 129 154 83.7
subroutine 17 18 94.4
pod 11 11 100.0
total 669 746 89.6


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::SearchIO::hmmer3
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Thomas Sharpton
7             #
8             # Copyright Thomas Sharpton
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::hmmer3
17              
18             =head1 SYNOPSIS
19              
20             use Bio::SearchIO;
21              
22             my $searchio = Bio::SearchIO->new(
23             -format => 'hmmer',
24             -version => 3,
25             -file => 'hmmsearch.out'
26             );
27              
28             my $result = $searchio->next_result;
29             my $hit = $result->next_hit;
30             print $hit->name, $hit->description, $hit->significance,
31             $hit->score, "\n";
32              
33             my $hsp = $hit->next_hsp;
34             print $hsp->start('hit'), $hsp->end('hit'), $hsp->start('query'),
35             $hsp->end('query'), "\n";
36              
37             =head1 DESCRIPTION
38              
39             Code to parse output from hmmsearch, hmmscan, phmmer and nhmmer, compatible with
40             both version 2 and version 3 of the HMMER package from L.
41              
42             =head1 FEEDBACK
43              
44             =head2 Mailing Lists
45              
46             User feedback is an integral part of the evolution of this and other
47             Bioperl modules. Send your comments and suggestions preferably to
48             the Bioperl mailing list. Your participation is much appreciated.
49              
50             bioperl-l@bioperl.org - General discussion
51             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
52              
53             =head2 Support
54              
55             Please direct usage questions or support issues to the mailing list:
56              
57             L
58              
59             rather than to the module maintainer directly. Many experienced and
60             reponsive experts will be able look at the problem and quickly
61             address it. Please include a thorough description of the problem
62             with code and data examples if at all possible.
63              
64             =head2 Reporting Bugs
65              
66             Report bugs to the Bioperl bug tracking system to help us keep track
67             of the bugs and their resolution. Bug reports can be submitted via
68             the web:
69              
70             https://github.com/bioperl/bioperl-live/issues
71              
72             =head1 AUTHOR - Thomas Sharpton
73              
74             Email thomas.sharpton@gmail.com
75              
76             Describe contact details here
77              
78             =head1 CONTRIBUTORS
79              
80             Additional contributors names and emails here
81              
82             briano at bioteam.net
83              
84             =head1 APPENDIX
85              
86             The rest of the documentation details each of the object methods.
87             Internal methods are usually preceded with a _
88              
89             =cut
90              
91             # Let the code begin...
92              
93             package Bio::SearchIO::hmmer3;
94              
95 1     1   6 use strict;
  1         3  
  1         32  
96 1     1   4 use Data::Dumper;
  1         2  
  1         56  
97 1     1   5 use Bio::Factory::ObjectFactory;
  1         2  
  1         17  
98 1     1   5 use Bio::Tools::IUPAC;
  1         1  
  1         24  
99 1     1   4 use vars qw(%MAPPING %MODEMAP);
  1         2  
  1         47  
100 1     1   5 use base qw(Bio::SearchIO::hmmer);
  1         1  
  1         167  
101              
102             BEGIN {
103              
104             # mapping of HMMER items to Bioperl hash keys
105 1     1   6 %MODEMAP = (
106             'HMMER_Output' => 'result',
107             'Hit' => 'hit',
108             'Hsp' => 'hsp'
109             );
110              
111 1         4050 %MAPPING = (
112             'Hsp_bit-score' => 'HSP-bits',
113             'Hsp_score' => 'HSP-score',
114             'Hsp_evalue' => 'HSP-evalue',
115             'Hsp_query-from' => 'HSP-query_start',
116             'Hsp_query-to' => 'HSP-query_end',
117             'Hsp_query-strand' => 'HSP-query_strand',
118             'Hsp_hit-from' => 'HSP-hit_start',
119             'Hsp_hit-to' => 'HSP-hit_end',
120             'Hsp_hit-strand' => 'HSP-hit_strand',
121             'Hsp_positive' => 'HSP-conserved',
122             'Hsp_identity' => 'HSP-identical',
123             'Hsp_gaps' => 'HSP-hsp_gaps',
124             'Hsp_hitgaps' => 'HSP-hit_gaps',
125             'Hsp_querygaps' => 'HSP-query_gaps',
126             'Hsp_qseq' => 'HSP-query_seq',
127             'Hsp_csline' => 'HSP-cs_seq',
128             'Hsp_hseq' => 'HSP-hit_seq',
129             'Hsp_midline' => 'HSP-homology_seq',
130             'Hsp_pline' => 'HSP-pp_seq',
131             'Hsp_align-len' => 'HSP-hsp_length',
132             'Hsp_query-frame' => 'HSP-query_frame',
133             'Hsp_hit-frame' => 'HSP-hit_frame',
134              
135             'Hit_id' => 'HIT-name',
136             'Hit_len' => 'HIT-length',
137             'Hit_accession' => 'HIT-accession',
138             'Hit_desc' => 'HIT-description',
139             'Hit_signif' => 'HIT-significance',
140             'Hit_score' => 'HIT-score',
141              
142             'HMMER_program' => 'RESULT-algorithm_name',
143             'HMMER_version' => 'RESULT-algorithm_version',
144             'HMMER_query-def' => 'RESULT-query_name',
145             'HMMER_query-len' => 'RESULT-query_length',
146             'HMMER_query-acc' => 'RESULT-query_accession',
147             'HMMER_querydesc' => 'RESULT-query_description',
148             'HMMER_hmm' => 'RESULT-hmm_name',
149             'HMMER_seqfile' => 'RESULT-sequence_file',
150             'HMMER_db' => 'RESULT-database_name',
151             );
152             }
153              
154             =head2 next_result
155              
156             Title : next_result
157             Usage : my $hit = $searchio->next_result;
158             Function: Returns the next Result from a search
159             Returns : Bio::Search::Result::ResultI object
160             Args : none
161              
162             =cut
163              
164             sub next_result {
165 25     25 1 7907 my ($self) = @_;
166 25         65 my ( $buffer, $last, @hit_list, @hsp_list, %hspinfo, %hitinfo, %domaincounter );
167 25         113 local $/ = "\n";
168              
169 25         182 my @ambiguous_nt = keys %Bio::Tools::IUPAC::IUB;
170 25         87 my $ambiguous_nt = join '', @ambiguous_nt;
171              
172 25         103 my $verbose = $self->verbose; # cache for speed? JES's idea in hmmer.pm
173 25         91 $self->start_document();
174              
175             # This is here to ensure that next_result doesn't produce infinite loop
176 25 100       97 if ( !defined( $buffer = $self->_readline ) ) {
177 5         35 return undef;
178             }
179             else {
180 20         62 $self->_pushback($buffer);
181             }
182              
183 20         43 my $hit_counter = 0; # helper variable for non-unique hit IDs
184              
185             # Regex goes here for HMMER3
186             # Start with hmmsearch processing
187 20         44 while ( defined( $buffer = $self->_readline ) ) {
188 245         307 my $lineorig = $buffer;
189 245         290 chomp $buffer;
190              
191             # Grab the program name
192 245 100 66     2018 if ( $buffer =~ m/^\#\s(\S+)\s\:\:\s/ ) {
    100 33        
    100          
    50          
    100          
    100          
    100          
    100          
    50          
193 14         35 my $prog = $1;
194              
195             # TO DO: customize the above regex to adapt to other
196             # program types (hmmscan, etc)
197 14         76 $self->start_element( { 'Name' => 'HMMER_Output' } );
198 14         42 $self->{'_result_count'}++; #Might need to move to another block
199 14         81 $self->element(
200             { 'Name' => 'HMMER_program',
201             'Data' => uc($prog)
202             }
203             );
204             }
205              
206             # Get the HMMER package version and release date
207             elsif ( $buffer =~ m/^\#\sHMMER\s+(\S+)\s+\((.+)\)/ ) {
208 14         32 my $version = $1;
209 14         31 my $versiondate = $2;
210 14         54 $self->{'_hmmidline'} = $buffer;
211 14         61 $self->element(
212             { 'Name' => 'HMMER_version',
213             'Data' => $version
214             }
215             );
216             }
217              
218             # Get the query info
219             elsif ( $buffer =~ /^\#\squery (?:\w+ )?file\:\s+(\S+)/ ) {
220 14 100 100     116 if ( $self->{'_reporttype'} eq 'HMMSEARCH'
    50 100        
221             || $self->{'_reporttype'} eq 'PHMMER'
222             || $self->{'_reporttype'} eq 'NHMMER' )
223             {
224 7         21 $self->{'_hmmfileline'} = $lineorig;
225 7         39 $self->element(
226             { 'Name' => 'HMMER_hmm',
227             'Data' => $1
228             }
229             );
230             }
231             elsif ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
232 7         16 $self->{'_hmmseqline'} = $lineorig;
233 7         38 $self->element(
234             { 'Name' => 'HMMER_seqfile',
235             'Data' => $1
236             }
237             );
238             }
239             }
240              
241             # If this is a report without alignments
242             elsif ( $buffer =~ m/^\#\sshow\salignments\sin\soutput/ ) {
243 0         0 $self->{'_alnreport'} = 0;
244             }
245              
246             # Get the database info
247             elsif ( $buffer =~ m/^\#\starget\s\S+\sdatabase\:\s+(\S+)/ ) {
248              
249 14 100 100     112 if ( $self->{'_reporttype'} eq 'HMMSEARCH'
    50 100        
250             || $self->{'_reporttype'} eq 'PHMMER'
251             || $self->{'_reporttype'} eq 'NHMMER' )
252             {
253 7         17 $self->{'_hmmseqline'} = $lineorig;
254 7         41 $self->element(
255             { 'Name' => 'HMMER_seqfile',
256             'Data' => $1
257             }
258             );
259             }
260             elsif ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
261 7         15 $self->{'_hmmfileline'} = $lineorig;
262 7         28 $self->element(
263             { 'Name' => 'HMMER_hmm',
264             'Data' => $1
265             }
266             );
267             }
268             }
269              
270             # Get query data
271             elsif ( $buffer =~ s/^Query:\s+// ) {
272             # For multi-query reports
273 20 50 66     126 if ( ( not exists $self->{_values}->{"RESULT-algorithm_name"}
      66        
274             or not exists $self->{_values}->{"RESULT-algorithm_version"}
275             )
276             and exists $self->{_hmmidline}
277             ) {
278 6         52 my ($version, $versiondate) = $self->{_hmmidline} =~ m/^\#\sHMMER\s+(\S+)\s+\((.+)\)/;
279             $self->element(
280             { 'Name' => 'HMMER_program',
281             'Data' => $self->{_reporttype}
282             }
283 6         48 );
284 6         30 $self->element(
285             { 'Name' => 'HMMER_version',
286             'Data' => $version
287             }
288             );
289             }
290 20 50 66     132 if ( ( not exists $self->{_values}->{"RESULT-hmm_name"}
      33        
      66        
291             or not exists $self->{_values}->{"RESULT-sequence_file"}
292             )
293             and ( exists $self->{_hmmfileline}
294             or exists $self->{_hmmseqline}
295             )
296             ) {
297 6 100 66     43 if ( $self->{'_reporttype'} eq 'HMMSEARCH'
    50 66        
298             or $self->{'_reporttype'} eq 'PHMMER'
299             or $self->{'_reporttype'} eq 'NHMMER'
300             ) {
301 4         27 my ($qry_file) = $self->{_hmmfileline} =~ m/^\#\squery (?:\w+ )?file\:\s+(\S+)/;
302 4         21 my ($target_file) = $self->{_hmmseqline} =~ m/^\#\starget\s\S+\sdatabase\:\s+(\S+)/;
303 4         19 $self->element(
304             { 'Name' => 'HMMER_hmm',
305             'Data' => $qry_file
306             }
307             );
308 4         18 $self->element(
309             { 'Name' => 'HMMER_seqfile',
310             'Data' => $target_file
311             }
312             );
313             }
314             elsif ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
315 2         13 my ($qry_file) = $self->{_hmmseqline} =~ m/^\#\squery \w+ file\:\s+(\S+)/;
316 2         13 my ($target_file) = $self->{_hmmfileline} =~ m/^\#\starget\s\S+\sdatabase\:\s+(\S+)/;
317 2         10 $self->element(
318             { 'Name' => 'HMMER_seqfile',
319             'Data' => $qry_file
320             }
321             );
322 2         8 $self->element(
323             { 'Name' => 'HMMER_hmm',
324             'Data' => $target_file
325             }
326             );
327             }
328             }
329              
330 20 50       131 unless ($buffer =~ s/\s+\[[L|M]\=(\d+)\]$//) {
331 0         0 warn "Error parsing length for query, offending line $buffer\n";
332 0         0 exit(0);
333             }
334 20         62 my $querylen = $1;
335 20         81 $self->element(
336             { 'Name' => 'HMMER_query-len',
337             'Data' => $querylen
338             }
339             );
340 20         80 $self->element(
341             { 'Name' => 'HMMER_query-def',
342             'Data' => $buffer
343             }
344             );
345             }
346              
347             # Get Accession data
348             elsif ( $buffer =~ s/^Accession:\s+// ) {
349 6         16 $buffer =~ s/\s+$//;
350 6         28 $self->element(
351             { 'Name' => 'HMMER_query-acc',
352             'Data' => $buffer
353             }
354             );
355             }
356              
357             # Get description data
358             elsif ( $buffer =~ s/^Description:\s+// ) {
359 9         36 $buffer =~ s/\s+$//;
360 9         42 $self->element(
361             { 'Name' => 'HMMER_querydesc',
362             'Data' => $buffer
363             }
364             );
365             }
366              
367             # hmmsearch, nhmmer, and hmmscan-specific formatting here
368             elsif (
369             defined $self->{'_reporttype'}
370             && ( $self->{'_reporttype'} eq 'HMMSEARCH'
371             || $self->{'_reporttype'} eq 'HMMSCAN'
372             || $self->{'_reporttype'} eq 'PHMMER'
373             || $self->{'_reporttype'} eq 'NHMMER' )
374             )
375             {
376             # Complete sequence table data above inclusion threshold,
377             # hmmsearch or hmmscan
378 154 100 100     950 if ( $buffer =~ m/Scores for complete sequence/ ) {
    100 100        
    100          
    100          
    100          
379 19         45 while ( defined( $buffer = $self->_readline ) ) {
380 125 100 100     1041 if ( $buffer =~ m/inclusion threshold/
    100 100        
      100        
      100        
      100        
381             || $buffer =~ m/Domain( and alignment)? annotation for each/
382             || $buffer =~ m/\[No hits detected/
383             || $buffer =~ m!^//! )
384             {
385 19         60 $self->_pushback($buffer);
386 19         28 last;
387             }
388             elsif ( $buffer =~ m/^\s+E-value\s+score/
389             || $buffer =~ m/\-\-\-/
390             || $buffer =~ m/^$/
391             )
392             {
393 76         150 next;
394             }
395              
396             # Grab table data
397 30         42 $hit_counter++;
398 30         48 my ($eval_full, $score_full, $bias_full, $eval_best,
399             $score_best, $bias_best, $exp, $n,
400             $hitid, $desc, @hitline
401             );
402 30         131 @hitline = split( " ", $buffer );
403 30         52 $eval_full = shift @hitline;
404 30         44 $score_full = shift @hitline;
405 30         41 $bias_full = shift @hitline;
406 30         41 $eval_best = shift @hitline;
407 30         35 $score_best = shift @hitline;
408 30         36 $bias_best = shift @hitline;
409 30         35 $exp = shift @hitline;
410 30         33 $n = shift @hitline;
411 30         35 $hitid = shift @hitline;
412 30         74 $desc = join " ", @hitline;
413              
414 30 50       50 $desc = '' if ( !defined($desc) );
415              
416 30         77 push @hit_list,
417             [ $hitid, $desc, $eval_full, $score_full ];
418 30         122 $hitinfo{"$hitid.$hit_counter"} = $#hit_list;
419             }
420             }
421              
422             # nhmmer
423             elsif ( $buffer =~ /Scores for complete hits/ ) {
424 1         5 while ( defined( $buffer = $self->_readline ) ) {
425 7 100 66     85 if ( $buffer =~ /inclusion threshold/
    100 66        
      66        
      100        
      100        
426             || $buffer =~ /Annotation for each hit/
427             || $buffer =~ /\[No hits detected/
428             || $buffer =~ m!^//! )
429             {
430 1         3 $self->_pushback($buffer);
431 1         3 last;
432             }
433             elsif ( $buffer =~ m/^\s+E-value\s+score/
434             || $buffer =~ m/\-\-\-/
435             || $buffer =~ m/^$/
436             )
437             {
438 4         38 next;
439             }
440              
441             # Grab table data
442 2         4 $hit_counter++;
443 2         3 my ($eval, $score, $bias, $hitid,
444             $start, $end, $desc, @hitline
445             );
446 2         14 @hitline = split( " ", $buffer );
447 2         5 $eval = shift @hitline;
448 2         5 $score = shift @hitline;
449 2         5 $bias = shift @hitline;
450 2         3 $hitid = shift @hitline;
451 2         4 $start = shift @hitline;
452 2         3 $end = shift @hitline;
453 2         7 $desc = join ' ', @hitline;
454              
455 2 50       6 $desc = '' if ( !defined($desc) );
456              
457 2         8 push @hit_list, [ $hitid, $desc, $eval, $score ];
458 2         12 $hitinfo{"$hitid.$hit_counter"} = $#hit_list;
459             }
460             }
461              
462             # Complete sequence table data below inclusion threshold
463             elsif ( $buffer =~ /inclusion threshold/ ) {
464 5         15 while ( defined( $buffer = $self->_readline ) ) {
465 35 100 66     215 if ( $buffer =~ /Domain( and alignment)? annotation for each/
    100 66        
      66        
466             || $buffer =~ /Internal pipeline statistics summary/
467             || $buffer =~ /Annotation for each hit\s+\(and alignments\)/
468             )
469             {
470 5         12 $self->_pushback($buffer);
471 5         5 last;
472             }
473             elsif ( $buffer =~ m/inclusion threshold/
474             || $buffer =~ m/^$/
475             )
476             {
477 10         18 next;
478             }
479              
480             # Grab table data
481 20         26 $hit_counter++;
482 20         25 my ($eval_full, $score_full, $bias_full, $eval_best,
483             $score_best, $bias_best, $exp, $n,
484             $hitid, $desc, @hitline
485             );
486 20         79 @hitline = split( " ", $buffer );
487 20         28 $eval_full = shift @hitline;
488 20         27 $score_full = shift @hitline;
489 20         20 $bias_full = shift @hitline;
490 20         19 $eval_best = shift @hitline;
491 20         27 $score_best = shift @hitline;
492 20         21 $bias_best = shift @hitline;
493 20         22 $exp = shift @hitline;
494 20         24 $n = shift @hitline;
495 20         19 $hitid = shift @hitline;
496 20         43 $desc = join " ", @hitline;
497              
498 20 50       29 $desc = '' if ( !defined($desc) );
499              
500 20         39 push @hit_list,
501             [ $hitid, $desc, $eval_full, $score_full ];
502 20         67 $hitinfo{"$hitid.$hit_counter"} = $#hit_list;
503             }
504             }
505              
506             # Domain annotation for each sequence table data,
507             # for hmmscan, hmmsearch & nhmmer
508             elsif ( $buffer =~ /Domain( and alignment)? annotation for each/
509             or $buffer =~ /Annotation for each hit\s+\(and alignments\)/
510             ) {
511 17         26 @hsp_list = (); # Here for multi-query reports
512 17         25 my $name;
513 17         26 my $annot_counter = 0;
514              
515 17         41 while ( defined( $buffer = $self->_readline ) ) {
516 111 100 100     376 if ( $buffer =~ /\[No targets detected/
517             || $buffer =~ /Internal pipeline statistics/ )
518             {
519 17         52 $self->_pushback($buffer);
520 17         28 last;
521             }
522              
523 94 100       382 if ( $buffer =~ m/^\>\>\s(\S*)\s+(.*)/ ) {
    100          
524 46         100 $name = $1;
525 46         83 my $desc = $2;
526 46         59 $annot_counter++;
527 46         109 $domaincounter{"$name.$annot_counter"} = 0;
528              
529             # The Hit Description from the Scores table can be truncated if
530             # its too long, so use the '>>' line description when its longer
531 46 100       148 if (length $hit_list[
532             $hitinfo{"$name.$annot_counter"}
533             ]
534             [1] < length $desc
535             ) {
536 6         17 $hit_list[ $hitinfo{"$name.$annot_counter"} ][1] = $desc;
537             }
538              
539 46         92 while ( defined( $buffer = $self->_readline ) ) {
540 263 100 66     2322 if ( $buffer =~ m/Internal pipeline statistics/
    100 100        
      66        
      100        
      100        
      100        
      100        
541             || $buffer =~ m/Alignments for each domain/
542             || $buffer =~ m/^\s+Alignment:/
543             || $buffer =~ m/^\>\>/ )
544             {
545 46         102 $self->_pushback($buffer);
546 46         98 last;
547             }
548             elsif ( $buffer =~ m/^\s+score\s+bias/
549             || $buffer =~ m/^\s+\#\s+score/
550             || $buffer =~ m/^\s+------\s+/
551             || $buffer =~ m/^\s\-\-\-\s+/
552             || $buffer =~ m/^$/
553             )
554             {
555 138         296 next;
556             }
557              
558             # Grab hsp data from table, push into @hsp;
559 79 50       350 if ($self->{'_reporttype'} =~ m/(?:HMMSCAN|HMMSEARCH|PHMMER|NHMMER)/) {
560 79         160 my ( $domain_num, $score, $bias,
561             $ceval, $ieval,
562             $hmm_start, $hmm_stop, $hmm_cov,
563             $seq_start, $seq_stop, $seq_cov,
564             $env_start, $env_stop, $env_cov,
565             $hitlength, $acc );
566 79         0 my @vals;
567              
568 79 100       929 if ( # HMMSCAN & HMMSEARCH
    50          
569             ( $domain_num, $score, $bias,
570             $ceval, $ieval,
571             $hmm_start, $hmm_stop, $hmm_cov,
572             $seq_start, $seq_stop, $seq_cov,
573             $env_start, $env_stop, $env_cov,
574             $acc )
575             = ( $buffer =~
576             m|^\s+(\d+)\s\!*\?*\s+ # domain number
577             (\S+)\s+(\S+)\s+ # score, bias
578             (\S+)\s+(\S+)\s+ # c-eval, i-eval
579             (\d+)\s+(\d+)\s+(\S+)\s+ # hmm start, stop, coverage
580             (\d+)\s+(\d+)\s+(\S+)\s+ # seq start, stop, coverage
581             (\d+)\s+(\d+)\s+(\S+)\s+ # env start, stop, coverage
582             (\S+) # posterior probability accuracy
583             \s*$|ox
584             )
585             ) {
586             # Values assigned when IF succeeded
587              
588             # Try to get the Hit length from the alignment information
589 77         108 $hitlength = 0;
590 77 100 100     267 if ($self->{'_reporttype'} eq 'HMMSEARCH' || $self->{'_reporttype'} eq 'PHMMER') {
    50          
591             # For Hmmsearch, if seq coverage ends in ']' it means that the alignment
592             # runs until the end. In that case add the END coordinate to @hitinfo
593             # to use it as Hit Length
594 22 100       94 if ( $seq_cov =~ m/\]$/ ) {
595 2         9 $hitlength = $seq_stop;
596             }
597             }
598             elsif ($self->{'_reporttype'} eq 'HMMSCAN') {
599             # For Hmmscan, if hmm coverage ends in ']' it means that the alignment
600             # runs until the end. In that case add the END coordinate to @hitinfo
601             # to use it as Hit Length
602 55 100       107 if ( $hmm_cov =~ m/\]$/ ) {
603 5         8 $hitlength = $hmm_stop;
604             }
605             }
606             }
607             elsif ( # NHMMER
608             ( $score, $bias, $ceval,
609             $hmm_start, $hmm_stop, $hmm_cov,
610             $seq_start, $seq_stop, $seq_cov,
611             $env_start, $env_stop, $env_cov,
612             $hitlength, $acc )
613             = ( $buffer =~
614             m|^\s+[!?]\s+
615             (\S+)\s+(\S+)\s+(\S+)\s+ # score, bias, evalue
616             (\d+)\s+(\d+)\s+(\S+)\s+ # hmm start, stop, coverage
617             (\d+)\s+(\d+)\s+(\S+)\s+ # seq start, stop, coverage
618             (\d+)\s+(\d+)\s+(\S+)\s+ # env start, stop, coverage
619             (\d+)\s+(\S+) # target length, pp accuracy
620             .*$|ox
621             )
622             ) {
623             # Values assigned when IF succeeded
624             }
625             else {
626 0         0 print STDERR "Missed this line: $buffer\n";
627 0         0 next;
628             }
629              
630 79         184 my $info = $hit_list[ $hitinfo{"$name.$annot_counter"} ];
631 79 50       135 if ( !defined $info ) {
632 0         0 $self->warn(
633             "Incomplete information: can't find HSP $name in list of hits\n"
634             );
635 0         0 next;
636             }
637              
638 79         123 $domaincounter{"$name.$annot_counter"}++;
639             my $hsp_key
640 79         155 = $name . "_" . $domaincounter{"$name.$annot_counter"};
641              
642             # Keep it simple for now. let's customize later
643 79         236 @vals = (
644             $hmm_start, $hmm_stop,
645             $seq_start, $seq_stop,
646             $score, $ceval,
647             $hitlength, '',
648             '', '',
649             '', ''
650             );
651 79         265 push @hsp_list, [ $name, @vals ];
652 79         362 $hspinfo{"$hsp_key.$annot_counter"} = $#hsp_list;
653             }
654             }
655             }
656             elsif ( $buffer =~ /Alignment(?:s for each domain)?:/ ) {
657             #line counter
658 46         74 my $count = 0;
659              
660             # There's an optional block, so we sometimes need to
661             # count to 3, and sometimes to 4.
662 46         49 my $max_count = 3;
663 46         95 my $lastdomain;
664             my $hsp;
665 46         0 my ( $csline, $hline, $midline, $qline, $pline );
666              
667             # To avoid deleting whitespaces from the homology line,
668             # keep track of the position and length of the alignment
669             # in each individual hline/qline, to take them as reference
670             # and use them in the homology line
671 46         46 my $align_offset = 0;
672 46         57 my $align_length = 0;
673              
674 46         89 while ( defined( $buffer = $self->_readline ) ) {
675 806 100 100     2714 if ( $buffer =~ m/^\>\>/
    100          
676             || $buffer =~ m/Internal pipeline statistics/ )
677             {
678 46         119 $self->_pushback($buffer);
679 46         99 last;
680             }
681             elsif ($buffer =~ m/^$/ )
682             {
683             # Reset these scalars on empty lines to help
684             # distinguish between the consensus structure/reference
685             # tracks (CS|RF lines) and homology lines ending in
686             # CS or RF aminoacids
687 149         158 $align_offset = 0;
688 149         149 $align_length = 0;
689 149         276 next;
690             }
691              
692 611 100 100     4507 if ( $buffer =~ /\s\s\=\=\sdomain\s(\d+)\s+/
    100 100        
    100 100        
    100          
    50          
693             or $buffer =~ /\s\sscore:\s\S+\s+/
694             ) {
695 79   100     232 my $domainnum = $1 || 1;
696 79         92 $count = 0;
697 79         128 my $key = $name . "_" . $domainnum;
698 79         148 $hsp = $hsp_list[ $hspinfo{"$key.$annot_counter"} ];
699 79         117 $csline = $$hsp[-5];
700 79         86 $hline = $$hsp[-4];
701 79         92 $midline = $$hsp[-3];
702 79         92 $qline = $$hsp[-2];
703 79         93 $pline = $$hsp[-1];
704 79         153 $lastdomain = $name;
705             }
706             # Consensus Structure or Reference track, some reports
707             # don't have it. Since it appears on top of the alignment,
708             # the reset of $align_length to 0 between alignment blocks
709             # avoid confusing homology lines with it.
710             elsif ( $buffer =~ m/\s+\S+\s(?:CS|RF)$/ and $align_length == 0 ) {
711 56         129 my @data = split( " ", $buffer );
712 56         94 $csline .= $data[-2];
713 56         46 $max_count++;
714 56         52 $count++;
715 56         124 next;
716             }
717             # Query line and Hit line swaps positions
718             # depending of the program
719             elsif ( $count == $max_count - 3
720             or $count == $max_count - 1
721             ) {
722 238         607 my @data = split( " ", $buffer );
723              
724 238         289 my $line_offset = 0;
725             # Use \Q\E on match to avoid errors on alignments
726             # that include stop codons (*)
727 238         2811 while ($buffer =~ m/\Q$data[-2]\E/g) {
728 238         706 $line_offset = pos $buffer;
729             }
730 238 50       372 if ($line_offset != 0) {
731 238         264 $align_length = length $data[-2];
732 238         258 $align_offset = $line_offset - $align_length;
733             }
734              
735 238 100       391 if ($self->{'_reporttype'} eq 'HMMSCAN') {
736             # hit sequence
737 132 100       219 $hline .= $data[-2] if ($count == $max_count - 3);
738             # query sequence
739 132 100       207 $qline .= $data[-2] if ($count == $max_count - 1);
740             }
741             else { # hmmsearch & nhmmer
742             # hit sequence
743 106 100       219 $hline .= $data[-2] if ($count == $max_count - 1);
744             # query sequence
745 106 100       203 $qline .= $data[-2] if ($count == $max_count - 3);
746             }
747              
748 238         239 $count++;
749 238         606 next;
750             }
751             # conservation track
752             # storage isn't quite right - need to remove
753             # leading/lagging whitespace while preserving
754             # gap data (latter isn't done, former is)
755             elsif ( $count == $max_count - 2 ) {
756 119         231 $midline .= substr $buffer, $align_offset, $align_length;
757 119         126 $count++;
758 119         229 next;
759             }
760             # posterior probability track
761             elsif ( $count == $max_count ) {
762 119         265 my @data = split(" ", $buffer);
763 119         186 $pline .= $data[-2];
764 119         132 $count = 0;
765 119         114 $max_count = 3;
766 119         174 $$hsp[-5] = $csline;
767 119         169 $$hsp[-4] = $hline;
768 119         139 $$hsp[-3] = $midline;
769 119         151 $$hsp[-2] = $qline;
770 119         139 $$hsp[-1] = $pline;
771 119         259 next;
772             }
773             else {
774 0         0 print STDERR "Missed this line: $buffer\n";
775             }
776             }
777             }
778             }
779             }
780              
781             # End of report
782             elsif ( $buffer =~ m/Internal pipeline statistics/ || $buffer =~ m!^//! ) {
783             # If within hit, hsp close;
784 20 50       78 if ( $self->within_element('hit') ) {
785 0 0       0 if ( $self->within_element('hsp') ) {
786 0         0 $self->end_element( { 'Name' => 'Hsp' } );
787             }
788 0         0 $self->end_element( { 'Name' => 'Hit' } );
789             }
790              
791             # Grab summary statistics of run
792 20         58 while ( defined( $buffer = $self->_readline ) ) {
793 203 100       444 last if ( $buffer =~ m/^\/\/$/ );
794             }
795              
796             # Do a lot of processing of hits and hsps here
797 20         34 my $index = 0;
798 20         60 while ( my $hit = shift @hit_list ) {
799 52         74 $index++;
800 52         84 my $hit_name = shift @$hit;
801 52         83 my $hit_desc = shift @$hit;
802 52         74 my $hit_signif = shift @$hit;
803 52         112 my $hit_score = shift @$hit;
804 52   100     165 my $num_domains = $domaincounter{"$hit_name.$index"} || 0;
805              
806 52         185 $self->start_element( { 'Name' => 'Hit' } );
807 52         201 $self->element(
808             { 'Name' => 'Hit_id',
809             'Data' => $hit_name
810             }
811             );
812 52         185 $self->element(
813             { 'Name' => 'Hit_desc',
814             'Data' => $hit_desc
815             }
816             );
817 52         156 $self->element(
818             { 'Name' => 'Hit_signif',
819             'Data' => $hit_signif
820             }
821             );
822 52         150 $self->element(
823             { 'Name' => 'Hit_score',
824             'Data' => $hit_score
825             }
826             );
827              
828 52         133 for my $i ( 1 .. $num_domains ) {
829 79         160 my $key = $hit_name . "_" . $i;
830 79         161 my $hsp = $hsp_list[ $hspinfo{"$key.$index"} ];
831 79 50       145 if ( defined $hsp ) {
832 79         111 my $hsp_name = shift @$hsp;
833 79         215 $self->start_element( { 'Name' => 'Hsp' } );
834             # Since HMMER doesn't print some data explicitly,
835             # calculate it from the homology line (midline)
836 79 50       181 if ($$hsp[-3] ne '') {
837 79         120 my $length = length $$hsp[-3];
838 79         140 my $identical = ($$hsp[-3] =~ tr/a-zA-Z//);
839 79         121 my $positive = ($$hsp[-3] =~ tr/+//) + $identical;
840 79         243 $self->element(
841             {
842             'Name' => 'Hsp_align-len',
843             'Data' => $length
844             }
845             );
846 79         241 $self->element(
847             { 'Name' => 'Hsp_identity',
848             'Data' => $identical
849             }
850             );
851 79         222 $self->element(
852             { 'Name' => 'Hsp_positive',
853             'Data' => $positive
854             }
855             );
856             }
857             else {
858 0         0 $self->element(
859             { 'Name' => 'Hsp_identity',
860             'Data' => 0
861             }
862             );
863 0         0 $self->element(
864             { 'Name' => 'Hsp_positive',
865             'Data' => 0
866             }
867             );
868             }
869 79 100 100     241 if ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
    100          
870 55         146 $self->element(
871             { 'Name' => 'Hsp_hit-from',
872             'Data' => shift @$hsp
873             }
874             );
875 55         166 $self->element(
876             { 'Name' => 'Hsp_hit-to',
877             'Data' => shift @$hsp
878             }
879             );
880 55         166 $self->element(
881             { 'Name' => 'Hsp_query-from',
882             'Data' => shift @$hsp
883             }
884             );
885 55         151 $self->element(
886             { 'Name' => 'Hsp_query-to',
887             'Data' => shift @$hsp
888             }
889             );
890             }
891             elsif ( $self->{'_reporttype'} eq 'HMMSEARCH'
892             or $self->{'_reporttype'} eq 'NHMMER'
893             ) {
894 14         49 $self->element(
895             { 'Name' => 'Hsp_query-from',
896             'Data' => shift @$hsp
897             }
898             );
899 14         52 $self->element(
900             { 'Name' => 'Hsp_query-to',
901             'Data' => shift @$hsp
902             }
903             );
904 14         47 $self->element(
905             { 'Name' => 'Hsp_hit-from',
906             'Data' => shift @$hsp
907             }
908             );
909 14         44 $self->element(
910             { 'Name' => 'Hsp_hit-to',
911             'Data' => shift @$hsp
912             }
913             );
914             }
915             $self->element(
916 79         247 { 'Name' => 'Hsp_score',
917             'Data' => shift @$hsp
918             }
919             );
920 79         258 $self->element(
921             { 'Name' => 'Hsp_evalue',
922             'Data' => shift @$hsp
923             }
924             );
925 79         161 my $hitlength = shift @$hsp;
926 79 100       162 if ( $hitlength != 0 ) {
927 17         53 $self->element(
928             { 'Name' => 'Hit_len',
929             'Data' => $hitlength
930             }
931             );
932             }
933             $self->element(
934 79         215 { 'Name' => 'Hsp_csline',
935             'Data' => shift @$hsp
936             }
937             );
938 79         266 $self->element(
939             { 'Name' => 'Hsp_hseq',
940             'Data' => shift @$hsp
941             }
942             );
943 79         244 $self->element(
944             { 'Name' => 'Hsp_midline',
945             'Data' => shift @$hsp
946             }
947             );
948 79         261 $self->element(
949             { 'Name' => 'Hsp_qseq',
950             'Data' => shift @$hsp
951             }
952             );
953 79         257 $self->element(
954             { 'Name' => 'Hsp_pline',
955             'Data' => shift @$hsp
956             }
957             );
958              
959             # Only nhmmer output has strand information
960 79 100       180 if ( $self->{'_reporttype'} eq 'NHMMER' ) {
961 2         9 my $hstart = $self->get_from_element('HSP-hit_start');
962 2         5 my $hend = $self->get_from_element('HSP-hit_end');
963 2 100       8 my $hstrand = ( $hstart < $hend ) ? 1 : -1;
964              
965 2         4 my $qstart = $self->get_from_element('HSP-query_start');
966 2         5 my $qend = $self->get_from_element('HSP-query_end');
967 2 50       6 my $qstrand = ( $qstart < $qend ) ? 1 : -1;
968              
969 2         7 $self->element(
970             { 'Name' => 'Hsp_query-strand',
971             'Data' => $qstrand
972             }
973             );
974 2         10 $self->element(
975             { 'Name' => 'Hsp_hit-strand',
976             'Data' => $hstrand
977             }
978             );
979             }
980              
981 79         175 $self->end_element( { 'Name' => 'Hsp' } );
982             }
983             }
984 52         153 $self->end_element( { 'Name' => 'Hit' } );
985             }
986 20         39 @hit_list = ();
987 20         47 %hitinfo = ();
988 20         43 last;
989             }
990             }
991             else {
992 0         0 print STDERR "Missed this line: $buffer\n";
993 0         0 $self->debug($buffer);
994             }
995 225         521 $last = $buffer;
996             }
997 20         74 $self->end_element( { 'Name' => 'HMMER_Output' } );
998 20         77 my $result = $self->end_document();
999 20         512 return $result;
1000             }
1001              
1002             =head2 start_element
1003              
1004             Title : start_element
1005             Usage : $eventgenerator->start_element
1006             Function: Handles a start event
1007             Returns : none
1008             Args : hashref with at least 2 keys 'Data' and 'Name'
1009              
1010             =cut
1011              
1012             sub start_element {
1013              
1014 1970     1970 1 2123 my ( $self, $data ) = @_;
1015              
1016             # we currently don't care about attributes
1017 1970         2021 my $nm = $data->{'Name'};
1018 1970         2302 my $type = $MODEMAP{$nm};
1019 1970 100       2581 if ($type) {
1020 145 50       355 if ( $self->_eventHandler->will_handle($type) ) {
1021 145         411 my $func = sprintf( "start_%s", lc $type );
1022 145         222 $self->_eventHandler->$func( $data->{'Attributes'} );
1023             }
1024 145         212 unshift @{ $self->{'_elements'} }, $type;
  145         284  
1025             }
1026 1970 100 100     3281 if ( defined $type
1027             && $type eq 'result' )
1028             {
1029 14         50 $self->{'_values'} = {};
1030 14         34 $self->{'_result'} = undef;
1031             }
1032             }
1033              
1034             =head2 end_element
1035              
1036             Title : end_element
1037             Usage : $eventgeneartor->end_element
1038             Function: Handles and end element event
1039             Returns : none
1040             Args : hashref with at least 2 keys 'Data' and 'Name'
1041              
1042             =cut
1043              
1044             sub end_element {
1045              
1046 1976     1976 1 2202 my ( $self, $data ) = @_;
1047 1976         2069 my $nm = $data->{'Name'};
1048 1976         1990 my $type = $MODEMAP{$nm};
1049 1976         1665 my $rc;
1050              
1051 1976 100       2463 if ( $nm eq 'HMMER_program' ) {
1052 20 50       107 if ( $self->{'_last_data'} =~ /([NP]?HMM\S+)/i ) {
1053 20         78 $self->{'_reporttype'} = uc $1;
1054             }
1055             }
1056              
1057             # Hsp are sort of weird, in that they end when another
1058             # object begins so have to detect this in end_element for now
1059 1976 100       2232 if ( $nm eq 'Hsp' ) {
1060 79         117 foreach my $line (qw(Hsp_csline Hsp_qseq Hsp_midline Hsp_hseq Hsp_pline)) {
1061 395         539 my $data = $self->{'_last_hspdata'}->{$line};
1062 395 100 100     849 if ( $data && $line eq 'Hsp_hseq' ) {
1063              
1064             # replace hmm '.' gap symbol by '-'
1065 79         201 $data =~ s/\./-/g;
1066             }
1067             $self->element(
1068 395         811 { 'Name' => $line,
1069             'Data' => $data
1070             }
1071             );
1072             }
1073 79         172 $self->{'_last_hspdata'} = {};
1074             }
1075 1976 100       2923 if ($type) {
    50          
1076 151 50       344 if ( $self->_eventHandler->will_handle($type) ) {
1077 151         445 my $func = sprintf( "end_%s", lc $type );
1078             $rc = $self->_eventHandler->$func( $self->{'_reporttype'},
1079 151         237 $self->{'_values'} );
1080             }
1081 151         183 my $lastelem = shift @{ $self->{'_elements'} };
  151         257  
1082              
1083             # Flush corresponding values from the {_values} buffer
1084 151         210 my $name = uc $type;
1085 151         167 foreach my $key (keys %{ $self->{_values} }) {
  151         493  
1086 2902 100       8124 delete $self->{_values}->{$key} if ($key =~ m/^$name-/);
1087             }
1088             }
1089             elsif ( $MAPPING{$nm} ) {
1090 1825 50       2299 if ( ref( $MAPPING{$nm} ) =~ /hash/i ) {
1091 0         0 my $key = ( keys %{ $MAPPING{$nm} } )[0];
  0         0  
1092             $self->{'_values'}->{$key}->{ $MAPPING{$nm}->{$key} }
1093 0         0 = $self->{'_last_data'};
1094             }
1095             else {
1096 1825         3340 $self->{'_values'}->{ $MAPPING{$nm} } = $self->{'_last_data'};
1097              
1098             # print "lastdata is " . $self->{'_last_data'} . "\n";
1099             }
1100             }
1101             else {
1102 0         0 $self->debug("unknown nm $nm, ignoring\n");
1103             }
1104 1976         2120 $self->{'_last_data'} = ''; # remove read data if we are at
1105             # end of an element
1106 1976 100 100     2855 $self->{'_result'} = $rc if ( defined $type && $type eq 'result' );
1107 1976         2692 return $rc;
1108             }
1109              
1110             =head2 element
1111              
1112             Title : element
1113             Usage : $eventhandler->element({'Name' => $name, 'Data' => $str});
1114             Function: Convenience method that calls start_element, characters, end_element
1115             Returns : none
1116             Args : Hash ref with the keys 'Name' and 'Data'
1117              
1118             =cut
1119              
1120             sub element {
1121 1825     1825 1 2079 my ( $self, $data ) = @_;
1122 1825         2651 $self->start_element($data);
1123 1825         2736 $self->characters($data);
1124 1825         2591 $self->end_element($data);
1125             }
1126              
1127             =head2 get_from_element
1128              
1129             Title : get_from_element
1130             Usage : $self->get_from_element('HSP-hit_start');
1131             Function: Convenience method to retrieve data from '_values' hash
1132             Returns : string
1133             Args : key
1134              
1135             =cut
1136              
1137             sub get_from_element {
1138 8     8 1 11 my ($self,$key) = @_;
1139 8         9 my $values = $self->{_values};
1140 8         15 $values->{$key};
1141             }
1142              
1143             =head2 characters
1144              
1145             Title : characters
1146             Usage : $eventgenerator->characters($str)
1147             Function: Send a character events
1148             Returns : none
1149             Args : string
1150              
1151             =cut
1152              
1153             sub characters {
1154 1825     1825 1 1949 my ( $self, $data ) = @_;
1155              
1156 1825 100 100     2093 if ( $self->in_element('hsp')
      66        
1157             && $data->{'Name'} =~ /Hsp\_(?:qseq|hseq|csline|pline|midline)/o
1158             && defined $data->{'Data'} )
1159             {
1160 790         1687 $self->{'_last_hspdata'}->{ $data->{'Name'} } .= $data->{'Data'};
1161             }
1162 1825 50 33     5394 return unless ( defined $data->{'Data'} && $data->{'Data'} !~ /^\s+$/o );
1163              
1164 1825         2400 $self->{'_last_data'} = $data->{'Data'};
1165             }
1166              
1167             =head2 within_element
1168              
1169             Title : within_element
1170             Usage : if( $eventgenerator->within_element( $element ) ) {}
1171             Function: Test if we are within a particular element
1172             This is different than 'in' because within can be tested for
1173             a whole block
1174             Returns : boolean
1175             Args : string element name
1176              
1177             =cut
1178              
1179             sub within_element {
1180 20     20 1 43 my ( $self, $name ) = @_;
1181             return 0
1182             if ( !defined $name
1183             || !defined $self->{'_elements'}
1184 20 100 33     132 || scalar @{ $self->{'_elements'} } == 0 );
  20   66     84  
1185 14         18 foreach my $element ( @{ $self->{'_elements'} } ) {
  14         40  
1186 14 50       43 return 1 if ( $element eq $name );
1187             }
1188 14         45 return 0;
1189             }
1190              
1191             =head2 in_element
1192              
1193             Title : in_element
1194             Usage : if( $eventgenerator->in_element( $element ) ) {}
1195             Function: Test if we are in a particular element
1196             This is different than 'within' because 'in' only
1197             tests its immediate parent
1198             Returns : boolean
1199             Args : string element name
1200              
1201             =cut
1202              
1203             sub in_element {
1204 1825     1825 1 1919 my ( $self, $name ) = @_;
1205 1825 100       2636 return 0 if !defined $self->{'_elements'}->[0];
1206 1779         7276 return ( $self->{'_elements'}->[0] eq $name );
1207             }
1208              
1209             =head2 start_document
1210              
1211             Title : start_document
1212             Usage : $eventgenerator->start_document
1213             Function: Handle a start document event
1214             Returns : none
1215             Args : none
1216              
1217             =cut
1218              
1219             sub start_document {
1220 25     25 1 68 my ($self) = @_;
1221 25         63 $self->{'_lasttype'} = '';
1222 25         60 $self->{'_values'} = {};
1223 25         49 $self->{'_result'} = undef;
1224 25         73 $self->{'_elements'} = [];
1225             }
1226              
1227             =head2 end_document
1228              
1229             Title : end_document
1230             Usage : $eventgenerator->end_document
1231             Function: Handles an end document event
1232             Returns : Bio::Search::Result::ResultI object
1233             Args : none
1234              
1235             =cut
1236              
1237             sub end_document {
1238 20     20 1 50 my ($self) = @_;
1239 20         41 return $self->{'_result'};
1240             }
1241              
1242             =head2 result_count
1243              
1244             Title : result_count
1245             Usage : my $count = $searchio->result_count
1246             Function: Returns the number of results processed
1247             Returns : integer
1248             Args : none
1249              
1250             =cut
1251              
1252             sub result_count {
1253 0     0 1   my $self = shift;
1254 0           return $self->{'_result_count'};
1255             }
1256              
1257             1;