File Coverage

Bio/SearchIO/hmmer3.pm
Criterion Covered Total %
statement 362 385 94.0
branch 148 178 83.1
condition 129 154 83.7
subroutine 17 18 94.4
pod 11 11 100.0
total 667 746 89.4


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   5 use strict;
  1         2  
  1         27  
96 1     1   4 use Data::Dumper;
  1         1  
  1         54  
97 1     1   3 use Bio::Factory::ObjectFactory;
  1         1  
  1         15  
98 1     1   3 use Bio::Tools::IUPAC;
  1         1  
  1         19  
99 1     1   4 use vars qw(%MAPPING %MODEMAP);
  1         1  
  1         45  
100 1     1   3 use base qw(Bio::SearchIO::hmmer);
  1         1  
  1         160  
101              
102             BEGIN {
103              
104             # mapping of HMMER items to Bioperl hash keys
105 1     1   3 %MODEMAP = (
106             'HMMER_Output' => 'result',
107             'Hit' => 'hit',
108             'Hsp' => 'hsp'
109             );
110              
111 1         3771 %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 1389 my ($self) = @_;
166 25         34 my ( $buffer, $last, @hit_list, @hsp_list, %hspinfo, %hitinfo, %domaincounter );
167 25         91 local $/ = "\n";
168              
169 25         152 my @ambiguous_nt = keys %Bio::Tools::IUPAC::IUB;
170 25         84 my $ambiguous_nt = join '', @ambiguous_nt;
171              
172 25         67 my $verbose = $self->verbose; # cache for speed? JES's idea in hmmer.pm
173 25         73 $self->start_document();
174              
175             # This is here to ensure that next_result doesn't produce infinite loop
176 25 100       67 if ( !defined( $buffer = $self->_readline ) ) {
177 5         27 return undef;
178             }
179             else {
180 20         52 $self->_pushback($buffer);
181             }
182              
183 20         30 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         41 while ( defined( $buffer = $self->_readline ) ) {
188 245         235 my $lineorig = $buffer;
189 245         241 chomp $buffer;
190              
191             # Grab the program name
192 245 100 66     2001 if ( $buffer =~ m/^\#\s(\S+)\s\:\:\s/ ) {
    100 33        
    100          
    50          
    100          
    100          
    100          
    100          
    50          
193 14         32 my $prog = $1;
194              
195             # TO DO: customize the above regex to adapt to other
196             # program types (hmmscan, etc)
197 14         64 $self->start_element( { 'Name' => 'HMMER_Output' } );
198 14         26 $self->{'_result_count'}++; #Might need to move to another block
199 14         63 $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         20 my $version = $1;
209 14         16 my $versiondate = $2;
210 14         40 $self->{'_hmmidline'} = $buffer;
211 14         57 $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     98 if ( $self->{'_reporttype'} eq 'HMMSEARCH'
    50 100        
221             || $self->{'_reporttype'} eq 'PHMMER'
222             || $self->{'_reporttype'} eq 'NHMMER' )
223             {
224 7         14 $self->{'_hmmfileline'} = $lineorig;
225 7         34 $self->element(
226             { 'Name' => 'HMMER_hmm',
227             'Data' => $1
228             }
229             );
230             }
231             elsif ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
232 7         10 $self->{'_hmmseqline'} = $lineorig;
233 7         34 $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     109 if ( $self->{'_reporttype'} eq 'HMMSEARCH'
    50 100        
250             || $self->{'_reporttype'} eq 'PHMMER'
251             || $self->{'_reporttype'} eq 'NHMMER' )
252             {
253 7         16 $self->{'_hmmseqline'} = $lineorig;
254 7         32 $self->element(
255             { 'Name' => 'HMMER_seqfile',
256             'Data' => $1
257             }
258             );
259             }
260             elsif ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
261 7         14 $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     116 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         37 my ($version, $versiondate) = $self->{_hmmidline} =~ m/^\#\sHMMER\s+(\S+)\s+\((.+)\)/;
279             $self->element(
280             { 'Name' => 'HMMER_program',
281             'Data' => $self->{_reporttype}
282             }
283 6         35 );
284 6         27 $self->element(
285             { 'Name' => 'HMMER_version',
286             'Data' => $version
287             }
288             );
289             }
290 20 50 66     131 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     49 if ( $self->{'_reporttype'} eq 'HMMSEARCH'
    50 66        
298             or $self->{'_reporttype'} eq 'PHMMER'
299             or $self->{'_reporttype'} eq 'NHMMER'
300             ) {
301 4         25 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         17 $self->element(
304             { 'Name' => 'HMMER_hmm',
305             'Data' => $qry_file
306             }
307             );
308 4         16 $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         10 my ($target_file) = $self->{_hmmfileline} =~ m/^\#\starget\s\S+\sdatabase\:\s+(\S+)/;
317 2         9 $self->element(
318             { 'Name' => 'HMMER_seqfile',
319             'Data' => $qry_file
320             }
321             );
322 2         6 $self->element(
323             { 'Name' => 'HMMER_hmm',
324             'Data' => $target_file
325             }
326             );
327             }
328             }
329              
330 20 50       108 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         37 my $querylen = $1;
335 20         76 $self->element(
336             { 'Name' => 'HMMER_query-len',
337             'Data' => $querylen
338             }
339             );
340 20         72 $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         12 $buffer =~ s/\s+$//;
350 6         19 $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         28 $buffer =~ s/\s+$//;
360 9         29 $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     1004 if ( $buffer =~ m/Scores for complete sequence/ ) {
    100 100        
    100          
    100          
    100          
379 19         43 while ( defined( $buffer = $self->_readline ) ) {
380 125 100 100     1154 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         37 $self->_pushback($buffer);
386 19         22 last;
387             }
388             elsif ( $buffer =~ m/^\s+E-value\s+score/
389             || $buffer =~ m/\-\-\-/
390             || $buffer =~ m/^$/
391             )
392             {
393 76         160 next;
394             }
395              
396             # Grab table data
397 30         26 $hit_counter++;
398 30         25 my ($eval_full, $score_full, $bias_full, $eval_best,
399             $score_best, $bias_best, $exp, $n,
400             $hitid, $desc, @hitline
401             );
402 30         115 @hitline = split( " ", $buffer );
403 30         42 $eval_full = shift @hitline;
404 30         30 $score_full = shift @hitline;
405 30         34 $bias_full = shift @hitline;
406 30         32 $eval_best = shift @hitline;
407 30         26 $score_best = shift @hitline;
408 30         27 $bias_best = shift @hitline;
409 30         31 $exp = shift @hitline;
410 30         25 $n = shift @hitline;
411 30         21 $hitid = shift @hitline;
412 30         47 $desc = join " ", @hitline;
413              
414 30 50       50 $desc = '' if ( !defined($desc) );
415              
416 30         57 push @hit_list,
417             [ $hitid, $desc, $eval_full, $score_full ];
418 30         118 $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     87 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         4 $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         10 next;
439             }
440              
441             # Grab table data
442 2         4 $hit_counter++;
443 2         4 my ($eval, $score, $bias, $hitid,
444             $start, $end, $desc, @hitline
445             );
446 2         11 @hitline = split( " ", $buffer );
447 2         6 $eval = shift @hitline;
448 2         2 $score = shift @hitline;
449 2         4 $bias = shift @hitline;
450 2         4 $hitid = shift @hitline;
451 2         2 $start = shift @hitline;
452 2         4 $end = shift @hitline;
453 2         6 $desc = join ' ', @hitline;
454              
455 2 50       6 $desc = '' if ( !defined($desc) );
456              
457 2         7 push @hit_list, [ $hitid, $desc, $eval, $score ];
458 2         8 $hitinfo{"$hitid.$hit_counter"} = $#hit_list;
459             }
460             }
461              
462             # Complete sequence table data below inclusion threshold
463             elsif ( $buffer =~ /inclusion threshold/ ) {
464 5         13 while ( defined( $buffer = $self->_readline ) ) {
465 35 100 66     275 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         8 last;
472             }
473             elsif ( $buffer =~ m/inclusion threshold/
474             || $buffer =~ m/^$/
475             )
476             {
477 10         22 next;
478             }
479              
480             # Grab table data
481 20         17 $hit_counter++;
482 20         15 my ($eval_full, $score_full, $bias_full, $eval_best,
483             $score_best, $bias_best, $exp, $n,
484             $hitid, $desc, @hitline
485             );
486 20         71 @hitline = split( " ", $buffer );
487 20         23 $eval_full = shift @hitline;
488 20         18 $score_full = shift @hitline;
489 20         15 $bias_full = shift @hitline;
490 20         20 $eval_best = shift @hitline;
491 20         17 $score_best = shift @hitline;
492 20         12 $bias_best = shift @hitline;
493 20         16 $exp = shift @hitline;
494 20         15 $n = shift @hitline;
495 20         14 $hitid = shift @hitline;
496 20         32 $desc = join " ", @hitline;
497              
498 20 50       30 $desc = '' if ( !defined($desc) );
499              
500 20         30 push @hit_list,
501             [ $hitid, $desc, $eval_full, $score_full ];
502 20         70 $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         31 @hsp_list = (); # Here for multi-query reports
512 17         15 my $name;
513 17         20 my $annot_counter = 0;
514              
515 17         31 while ( defined( $buffer = $self->_readline ) ) {
516 111 100 100     380 if ( $buffer =~ /\[No targets detected/
517             || $buffer =~ /Internal pipeline statistics/ )
518             {
519 17         38 $self->_pushback($buffer);
520 17         28 last;
521             }
522              
523 94 100       330 if ( $buffer =~ m/^\>\>\s(\S*)\s+(.*)/ ) {
    100          
524 46         88 $name = $1;
525 46         86 my $desc = $2;
526 46         39 $annot_counter++;
527 46         92 $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       123 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         80 while ( defined( $buffer = $self->_readline ) ) {
540 263 100 66     3028 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         82 $self->_pushback($buffer);
546 46         86 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         266 next;
556             }
557              
558             # Grab hsp data from table, push into @hsp;
559 79 50       311 if ($self->{'_reporttype'} =~ m/(?:HMMSCAN|HMMSEARCH|PHMMER|NHMMER)/) {
560 79         87 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 0         0 my @vals;
567              
568 79 100       809 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         74 $hitlength = 0;
590 77 100 100     283 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       49 if ( $seq_cov =~ m/\]$/ ) {
595 2         4 $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       110 if ( $hmm_cov =~ m/\]$/ ) {
603 5         7 $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         161 my $info = $hit_list[ $hitinfo{"$name.$annot_counter"} ];
631 79 50       101 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         94 $domaincounter{"$name.$annot_counter"}++;
639             my $hsp_key
640 79         125 = $name . "_" . $domaincounter{"$name.$annot_counter"};
641              
642             # Keep it simple for now. let's customize later
643 79         195 @vals = (
644             $hmm_start, $hmm_stop,
645             $seq_start, $seq_stop,
646             $score, $ceval,
647             $hitlength, '',
648             '', '',
649             '', ''
650             );
651 79         226 push @hsp_list, [ $name, @vals ];
652 79         317 $hspinfo{"$hsp_key.$annot_counter"} = $#hsp_list;
653             }
654             }
655             }
656             elsif ( $buffer =~ /Alignment(?:s for each domain)?:/ ) {
657             #line counter
658 46         60 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         29 my $max_count = 3;
663 46         43 my $lastdomain;
664             my $hsp;
665 0         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         42 my $align_offset = 0;
672 46         31 my $align_length = 0;
673              
674 46         78 while ( defined( $buffer = $self->_readline ) ) {
675 806 100 100     3052 if ( $buffer =~ m/^\>\>/
    100          
676             || $buffer =~ m/Internal pipeline statistics/ )
677             {
678 46         81 $self->_pushback($buffer);
679 46         110 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         112 $align_offset = 0;
688 149         115 $align_length = 0;
689 149         214 next;
690             }
691              
692 611 100 100     5106 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     190 my $domainnum = $1 || 1;
696 79         58 $count = 0;
697 79         104 my $key = $name . "_" . $domainnum;
698 79         125 $hsp = $hsp_list[ $hspinfo{"$key.$annot_counter"} ];
699 79         90 $csline = $$hsp[-5];
700 79         78 $hline = $$hsp[-4];
701 79         72 $midline = $$hsp[-3];
702 79         61 $qline = $$hsp[-2];
703 79         65 $pline = $$hsp[-1];
704 79         144 $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         106 my @data = split( " ", $buffer );
712 56         64 $csline .= $data[-2];
713 56         45 $max_count++;
714 56         41 $count++;
715 56         125 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         515 my @data = split( " ", $buffer );
723              
724 238         201 my $line_offset = 0;
725             # Use \Q\E on match to avoid errors on alignments
726             # that include stop codons (*)
727 238         2423 while ($buffer =~ m/\Q$data[-2]\E/g) {
728 238         562 $line_offset = pos $buffer;
729             }
730 238 50       331 if ($line_offset != 0) {
731 238         148 $align_length = length $data[-2];
732 238         210 $align_offset = $line_offset - $align_length;
733             }
734              
735 238 100       341 if ($self->{'_reporttype'} eq 'HMMSCAN') {
736             # hit sequence
737 132 100       215 $hline .= $data[-2] if ($count == $max_count - 3);
738             # query sequence
739 132 100       226 $qline .= $data[-2] if ($count == $max_count - 1);
740             }
741             else { # hmmsearch & nhmmer
742             # hit sequence
743 106 100       181 $hline .= $data[-2] if ($count == $max_count - 1);
744             # query sequence
745 106 100       161 $qline .= $data[-2] if ($count == $max_count - 3);
746             }
747              
748 238         161 $count++;
749 238         582 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         193 $midline .= substr $buffer, $align_offset, $align_length;
757 119         102 $count++;
758 119         199 next;
759             }
760             # posterior probability track
761             elsif ( $count == $max_count ) {
762 119         269 my @data = split(" ", $buffer);
763 119         123 $pline .= $data[-2];
764 119         92 $count = 0;
765 119         106 $max_count = 3;
766 119         127 $$hsp[-5] = $csline;
767 119         123 $$hsp[-4] = $hline;
768 119         136 $$hsp[-3] = $midline;
769 119         104 $$hsp[-2] = $qline;
770 119         97 $$hsp[-1] = $pline;
771 119         270 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       53 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         46 while ( defined( $buffer = $self->_readline ) ) {
793 203 100       441 last if ( $buffer =~ m/^\/\/$/ );
794             }
795              
796             # Do a lot of processing of hits and hsps here
797 20         23 my $index = 0;
798 20         51 while ( my $hit = shift @hit_list ) {
799 52         48 $index++;
800 52         57 my $hit_name = shift @$hit;
801 52         59 my $hit_desc = shift @$hit;
802 52         56 my $hit_signif = shift @$hit;
803 52         47 my $hit_score = shift @$hit;
804 52   100     146 my $num_domains = $domaincounter{"$hit_name.$index"} || 0;
805              
806 52         133 $self->start_element( { 'Name' => 'Hit' } );
807 52         165 $self->element(
808             { 'Name' => 'Hit_id',
809             'Data' => $hit_name
810             }
811             );
812 52         142 $self->element(
813             { 'Name' => 'Hit_desc',
814             'Data' => $hit_desc
815             }
816             );
817 52         129 $self->element(
818             { 'Name' => 'Hit_signif',
819             'Data' => $hit_signif
820             }
821             );
822 52         132 $self->element(
823             { 'Name' => 'Hit_score',
824             'Data' => $hit_score
825             }
826             );
827              
828 52         130 for my $i ( 1 .. $num_domains ) {
829 79         132 my $key = $hit_name . "_" . $i;
830 79         132 my $hsp = $hsp_list[ $hspinfo{"$key.$index"} ];
831 79 50       119 if ( defined $hsp ) {
832 79         89 my $hsp_name = shift @$hsp;
833 79         176 $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       161 if ($$hsp[-3] ne '') {
837 79         89 my $length = length $$hsp[-3];
838 79         100 my $identical = ($$hsp[-3] =~ tr/a-zA-Z//);
839 79         100 my $positive = ($$hsp[-3] =~ tr/+//) + $identical;
840 79         201 $self->element(
841             {
842             'Name' => 'Hsp_align-len',
843             'Data' => $length
844             }
845             );
846 79         208 $self->element(
847             { 'Name' => 'Hsp_identity',
848             'Data' => $identical
849             }
850             );
851 79         214 $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     224 if ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
    100          
870 55         125 $self->element(
871             { 'Name' => 'Hsp_hit-from',
872             'Data' => shift @$hsp
873             }
874             );
875 55         130 $self->element(
876             { 'Name' => 'Hsp_hit-to',
877             'Data' => shift @$hsp
878             }
879             );
880 55         125 $self->element(
881             { 'Name' => 'Hsp_query-from',
882             'Data' => shift @$hsp
883             }
884             );
885 55         128 $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         40 $self->element(
895             { 'Name' => 'Hsp_query-from',
896             'Data' => shift @$hsp
897             }
898             );
899 14         46 $self->element(
900             { 'Name' => 'Hsp_query-to',
901             'Data' => shift @$hsp
902             }
903             );
904 14         41 $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         195 { 'Name' => 'Hsp_score',
917             'Data' => shift @$hsp
918             }
919             );
920 79         211 $self->element(
921             { 'Name' => 'Hsp_evalue',
922             'Data' => shift @$hsp
923             }
924             );
925 79         111 my $hitlength = shift @$hsp;
926 79 100       161 if ( $hitlength != 0 ) {
927 17         41 $self->element(
928             { 'Name' => 'Hit_len',
929             'Data' => $hitlength
930             }
931             );
932             }
933             $self->element(
934 79         174 { 'Name' => 'Hsp_csline',
935             'Data' => shift @$hsp
936             }
937             );
938 79         209 $self->element(
939             { 'Name' => 'Hsp_hseq',
940             'Data' => shift @$hsp
941             }
942             );
943 79         220 $self->element(
944             { 'Name' => 'Hsp_midline',
945             'Data' => shift @$hsp
946             }
947             );
948 79         186 $self->element(
949             { 'Name' => 'Hsp_qseq',
950             'Data' => shift @$hsp
951             }
952             );
953 79         206 $self->element(
954             { 'Name' => 'Hsp_pline',
955             'Data' => shift @$hsp
956             }
957             );
958              
959             # Only nhmmer output has strand information
960 79 100       178 if ( $self->{'_reporttype'} eq 'NHMMER' ) {
961 2         6 my $hstart = $self->get_from_element('HSP-hit_start');
962 2         3 my $hend = $self->get_from_element('HSP-hit_end');
963 2 100       5 my $hstrand = ( $hstart < $hend ) ? 1 : -1;
964              
965 2         3 my $qstart = $self->get_from_element('HSP-query_start');
966 2         6 my $qend = $self->get_from_element('HSP-query_end');
967 2 50       5 my $qstrand = ( $qstart < $qend ) ? 1 : -1;
968              
969 2         8 $self->element(
970             { 'Name' => 'Hsp_query-strand',
971             'Data' => $qstrand
972             }
973             );
974 2         8 $self->element(
975             { 'Name' => 'Hsp_hit-strand',
976             'Data' => $hstrand
977             }
978             );
979             }
980              
981 79         154 $self->end_element( { 'Name' => 'Hsp' } );
982             }
983             }
984 52         124 $self->end_element( { 'Name' => 'Hit' } );
985             }
986 20         27 @hit_list = ();
987 20         36 %hitinfo = ();
988 20         33 last;
989             }
990             }
991             else {
992 0         0 print STDERR "Missed this line: $buffer\n";
993 0         0 $self->debug($buffer);
994             }
995 225         466 $last = $buffer;
996             }
997 20         57 $self->end_element( { 'Name' => 'HMMER_Output' } );
998 20         72 my $result = $self->end_document();
999 20         184 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 1299 my ( $self, $data ) = @_;
1015              
1016             # we currently don't care about attributes
1017 1970         1467 my $nm = $data->{'Name'};
1018 1970         1522 my $type = $MODEMAP{$nm};
1019 1970 100       2234 if ($type) {
1020 145 50       295 if ( $self->_eventHandler->will_handle($type) ) {
1021 145         336 my $func = sprintf( "start_%s", lc $type );
1022 145         209 $self->_eventHandler->$func( $data->{'Attributes'} );
1023             }
1024 145         193 unshift @{ $self->{'_elements'} }, $type;
  145         219  
1025             }
1026 1970 100 100     3319 if ( defined $type
1027             && $type eq 'result' )
1028             {
1029 14         26 $self->{'_values'} = {};
1030 14         30 $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 1435 my ( $self, $data ) = @_;
1047 1976         1458 my $nm = $data->{'Name'};
1048 1976         1446 my $type = $MODEMAP{$nm};
1049 1976         1199 my $rc;
1050              
1051 1976 100       2411 if ( $nm eq 'HMMER_program' ) {
1052 20 50       96 if ( $self->{'_last_data'} =~ /([NP]?HMM\S+)/i ) {
1053 20         63 $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       2348 if ( $nm eq 'Hsp' ) {
1060 79         120 foreach my $line (qw(Hsp_csline Hsp_qseq Hsp_midline Hsp_hseq Hsp_pline)) {
1061 395         441 my $data = $self->{'_last_hspdata'}->{$line};
1062 395 100 100     998 if ( $data && $line eq 'Hsp_hseq' ) {
1063              
1064             # replace hmm '.' gap symbol by '-'
1065 79         156 $data =~ s/\./-/g;
1066             }
1067             $self->element(
1068 395         761 { 'Name' => $line,
1069             'Data' => $data
1070             }
1071             );
1072             }
1073 79         95 $self->{'_last_hspdata'} = {};
1074             }
1075 1976 100       2919 if ($type) {
    50          
1076 151 50       323 if ( $self->_eventHandler->will_handle($type) ) {
1077 151         339 my $func = sprintf( "end_%s", lc $type );
1078             $rc = $self->_eventHandler->$func( $self->{'_reporttype'},
1079 151         223 $self->{'_values'} );
1080             }
1081 151         145 my $lastelem = shift @{ $self->{'_elements'} };
  151         232  
1082              
1083             # Flush corresponding values from the {_values} buffer
1084 151         178 my $name = uc $type;
1085 151         114 foreach my $key (keys %{ $self->{_values} }) {
  151         470  
1086 2902 100       7203 delete $self->{_values}->{$key} if ($key =~ m/^$name-/);
1087             }
1088             }
1089             elsif ( $MAPPING{$nm} ) {
1090 1825 50       2097 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         3105 $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         1597 $self->{'_last_data'} = ''; # remove read data if we are at
1105             # end of an element
1106 1976 100 100     3041 $self->{'_result'} = $rc if ( defined $type && $type eq 'result' );
1107 1976         2487 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 1563 my ( $self, $data ) = @_;
1122 1825         1984 $self->start_element($data);
1123 1825         1832 $self->characters($data);
1124 1825         2038 $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 8 my ($self,$key) = @_;
1139 8         8 my $values = $self->{_values};
1140 8         13 $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 1270 my ( $self, $data ) = @_;
1155              
1156 1825 100 100     1788 if ( $self->in_element('hsp')
      66        
1157             && $data->{'Name'} =~ /Hsp\_(?:qseq|hseq|csline|pline|midline)/o
1158             && defined $data->{'Data'} )
1159             {
1160 790         1405 $self->{'_last_hspdata'}->{ $data->{'Name'} } .= $data->{'Data'};
1161             }
1162 1825 50 33     6053 return unless ( defined $data->{'Data'} && $data->{'Data'} !~ /^\s+$/o );
1163              
1164 1825         1785 $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 27 my ( $self, $name ) = @_;
1181             return 0
1182             if ( !defined $name
1183             || !defined $self->{'_elements'}
1184 20 100 33     94 || scalar @{ $self->{'_elements'} } == 0 );
  20   66     85  
1185 14         17 foreach my $element ( @{ $self->{'_elements'} } ) {
  14         31  
1186 14 50       36 return 1 if ( $element eq $name );
1187             }
1188 14         35 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 1304 my ( $self, $name ) = @_;
1205 1825 100       2469 return 0 if !defined $self->{'_elements'}->[0];
1206 1779         8058 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 35 my ($self) = @_;
1221 25         49 $self->{'_lasttype'} = '';
1222 25         46 $self->{'_values'} = {};
1223 25         50 $self->{'_result'} = undef;
1224 25         45 $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 27 my ($self) = @_;
1239 20         29 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 : interger
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;