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   4 use strict;
  1         1  
  1         33  
96 1     1   3 use Data::Dumper;
  1         1  
  1         56  
97 1     1   5 use Bio::Factory::ObjectFactory;
  1         1  
  1         16  
98 1     1   3 use Bio::Tools::IUPAC;
  1         1  
  1         21  
99 1     1   3 use vars qw(%MAPPING %MODEMAP);
  1         1  
  1         47  
100 1     1   3 use base qw(Bio::SearchIO::hmmer);
  1         1  
  1         166  
101              
102             BEGIN {
103              
104             # mapping of HMMER items to Bioperl hash keys
105 1     1   4 %MODEMAP = (
106             'HMMER_Output' => 'result',
107             'Hit' => 'hit',
108             'Hsp' => 'hsp'
109             );
110              
111 1         3935 %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 1575 my ($self) = @_;
166 25         57 my ( $buffer, $last, @hit_list, @hsp_list, %hspinfo, %hitinfo, %domaincounter );
167 25         159 local $/ = "\n";
168              
169 25         230 my @ambiguous_nt = keys %Bio::Tools::IUPAC::IUB;
170 25         100 my $ambiguous_nt = join '', @ambiguous_nt;
171              
172 25         113 my $verbose = $self->verbose; # cache for speed? JES's idea in hmmer.pm
173 25         99 $self->start_document();
174              
175             # This is here to ensure that next_result doesn't produce infinite loop
176 25 100       132 if ( !defined( $buffer = $self->_readline ) ) {
177 5         33 return undef;
178             }
179             else {
180 20         61 $self->_pushback($buffer);
181             }
182              
183 20         32 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         254 my $lineorig = $buffer;
189 245         237 chomp $buffer;
190              
191             # Grab the program name
192 245 100 66     2129 if ( $buffer =~ m/^\#\s(\S+)\s\:\:\s/ ) {
    100 33        
    100          
    50          
    100          
    100          
    100          
    100          
    50          
193 14         34 my $prog = $1;
194              
195             # TO DO: customize the above regex to adapt to other
196             # program types (hmmscan, etc)
197 14         83 $self->start_element( { 'Name' => 'HMMER_Output' } );
198 14         38 $self->{'_result_count'}++; #Might need to move to another block
199 14         79 $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         24 my $version = $1;
209 14         27 my $versiondate = $2;
210 14         48 $self->{'_hmmidline'} = $buffer;
211 14         60 $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     125 if ( $self->{'_reporttype'} eq 'HMMSEARCH'
    50 100        
221             || $self->{'_reporttype'} eq 'PHMMER'
222             || $self->{'_reporttype'} eq 'NHMMER' )
223             {
224 7         19 $self->{'_hmmfileline'} = $lineorig;
225 7         37 $self->element(
226             { 'Name' => 'HMMER_hmm',
227             'Data' => $1
228             }
229             );
230             }
231             elsif ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
232 7         13 $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     124 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         36 $self->element(
255             { 'Name' => 'HMMER_seqfile',
256             'Data' => $1
257             }
258             );
259             }
260             elsif ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
261 7         13 $self->{'_hmmfileline'} = $lineorig;
262 7         37 $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     137 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         41 );
284 6         34 $self->element(
285             { 'Name' => 'HMMER_version',
286             'Data' => $version
287             }
288             );
289             }
290 20 50 66     134 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     51 if ( $self->{'_reporttype'} eq 'HMMSEARCH'
    50 66        
298             or $self->{'_reporttype'} eq 'PHMMER'
299             or $self->{'_reporttype'} eq 'NHMMER'
300             ) {
301 4         26 my ($qry_file) = $self->{_hmmfileline} =~ m/^\#\squery (?:\w+ )?file\:\s+(\S+)/;
302 4         19 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         13 $self->element(
309             { 'Name' => 'HMMER_seqfile',
310             'Data' => $target_file
311             }
312             );
313             }
314             elsif ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
315 2         18 my ($qry_file) = $self->{_hmmseqline} =~ m/^\#\squery \w+ file\:\s+(\S+)/;
316 2         15 my ($target_file) = $self->{_hmmfileline} =~ m/^\#\starget\s\S+\sdatabase\:\s+(\S+)/;
317 2         12 $self->element(
318             { 'Name' => 'HMMER_seqfile',
319             'Data' => $qry_file
320             }
321             );
322 2         9 $self->element(
323             { 'Name' => 'HMMER_hmm',
324             'Data' => $target_file
325             }
326             );
327             }
328             }
329              
330 20 50       120 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         46 my $querylen = $1;
335 20         71 $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         13 $buffer =~ s/\s+$//;
350 6         23 $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         30 $buffer =~ s/\s+$//;
360 9         33 $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     1154 if ( $buffer =~ m/Scores for complete sequence/ ) {
    100 100        
    100          
    100          
    100          
379 19         62 while ( defined( $buffer = $self->_readline ) ) {
380 125 100 100     1452 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         54 $self->_pushback($buffer);
386 19         35 last;
387             }
388             elsif ( $buffer =~ m/^\s+E-value\s+score/
389             || $buffer =~ m/\-\-\-/
390             || $buffer =~ m/^$/
391             )
392             {
393 76         148 next;
394             }
395              
396             # Grab table data
397 30         36 $hit_counter++;
398 30         29 my ($eval_full, $score_full, $bias_full, $eval_best,
399             $score_best, $bias_best, $exp, $n,
400             $hitid, $desc, @hitline
401             );
402 30         129 @hitline = split( " ", $buffer );
403 30         41 $eval_full = shift @hitline;
404 30         36 $score_full = shift @hitline;
405 30         39 $bias_full = shift @hitline;
406 30         29 $eval_best = shift @hitline;
407 30         31 $score_best = shift @hitline;
408 30         31 $bias_best = shift @hitline;
409 30         64 $exp = shift @hitline;
410 30         31 $n = shift @hitline;
411 30         31 $hitid = shift @hitline;
412 30         54 $desc = join " ", @hitline;
413              
414 30 50       53 $desc = '' if ( !defined($desc) );
415              
416 30         63 push @hit_list,
417             [ $hitid, $desc, $eval_full, $score_full ];
418 30         126 $hitinfo{"$hitid.$hit_counter"} = $#hit_list;
419             }
420             }
421              
422             # nhmmer
423             elsif ( $buffer =~ /Scores for complete hits/ ) {
424 1         4 while ( defined( $buffer = $self->_readline ) ) {
425 7 100 66     93 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         5 $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         11 next;
439             }
440              
441             # Grab table data
442 2         5 $hit_counter++;
443 2         5 my ($eval, $score, $bias, $hitid,
444             $start, $end, $desc, @hitline
445             );
446 2         13 @hitline = split( " ", $buffer );
447 2         4 $eval = shift @hitline;
448 2         2 $score = shift @hitline;
449 2         3 $bias = shift @hitline;
450 2         16 $hitid = shift @hitline;
451 2         3 $start = shift @hitline;
452 2         3 $end = shift @hitline;
453 2         6 $desc = join ' ', @hitline;
454              
455 2 50       7 $desc = '' if ( !defined($desc) );
456              
457 2         6 push @hit_list, [ $hitid, $desc, $eval, $score ];
458 2         10 $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     262 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         11 $self->_pushback($buffer);
471 5         7 last;
472             }
473             elsif ( $buffer =~ m/inclusion threshold/
474             || $buffer =~ m/^$/
475             )
476             {
477 10         17 next;
478             }
479              
480             # Grab table data
481 20         15 $hit_counter++;
482 20         16 my ($eval_full, $score_full, $bias_full, $eval_best,
483             $score_best, $bias_best, $exp, $n,
484             $hitid, $desc, @hitline
485             );
486 20         67 @hitline = split( " ", $buffer );
487 20         21 $eval_full = shift @hitline;
488 20         18 $score_full = shift @hitline;
489 20         13 $bias_full = shift @hitline;
490 20         22 $eval_best = shift @hitline;
491 20         19 $score_best = shift @hitline;
492 20         13 $bias_best = shift @hitline;
493 20         19 $exp = shift @hitline;
494 20         17 $n = shift @hitline;
495 20         14 $hitid = shift @hitline;
496 20         31 $desc = join " ", @hitline;
497              
498 20 50       31 $desc = '' if ( !defined($desc) );
499              
500 20         31 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         36 @hsp_list = (); # Here for multi-query reports
512 17         18 my $name;
513 17         28 my $annot_counter = 0;
514              
515 17         48 while ( defined( $buffer = $self->_readline ) ) {
516 111 100 100     459 if ( $buffer =~ /\[No targets detected/
517             || $buffer =~ /Internal pipeline statistics/ )
518             {
519 17         44 $self->_pushback($buffer);
520 17         35 last;
521             }
522              
523 94 100       470 if ( $buffer =~ m/^\>\>\s(\S*)\s+(.*)/ ) {
    100          
524 46         85 $name = $1;
525 46         68 my $desc = $2;
526 46         48 $annot_counter++;
527 46         94 $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       150 if (length $hit_list[
532             $hitinfo{"$name.$annot_counter"}
533             ]
534             [1] < length $desc
535             ) {
536 6         22 $hit_list[ $hitinfo{"$name.$annot_counter"} ][1] = $desc;
537             }
538              
539 46         88 while ( defined( $buffer = $self->_readline ) ) {
540 263 100 66     3154 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         77 $self->_pushback($buffer);
546 46         95 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         249 next;
556             }
557              
558             # Grab hsp data from table, push into @hsp;
559 79 50       336 if ($self->{'_reporttype'} =~ m/(?:HMMSCAN|HMMSEARCH|PHMMER|NHMMER)/) {
560 79         128 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       866 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         81 $hitlength = 0;
590 77 100 100     321 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         5 $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       134 if ( $hmm_cov =~ m/\]$/ ) {
603 5         9 $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         166 my $info = $hit_list[ $hitinfo{"$name.$annot_counter"} ];
631 79 50       117 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         104 $domaincounter{"$name.$annot_counter"}++;
639             my $hsp_key
640 79         154 = $name . "_" . $domaincounter{"$name.$annot_counter"};
641              
642             # Keep it simple for now. let's customize later
643 79         205 @vals = (
644             $hmm_start, $hmm_stop,
645             $seq_start, $seq_stop,
646             $score, $ceval,
647             $hitlength, '',
648             '', '',
649             '', ''
650             );
651 79         261 push @hsp_list, [ $name, @vals ];
652 79         378 $hspinfo{"$hsp_key.$annot_counter"} = $#hsp_list;
653             }
654             }
655             }
656             elsif ( $buffer =~ /Alignment(?:s for each domain)?:/ ) {
657             #line counter
658 46         57 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         39 my $max_count = 3;
663 46         47 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         44 my $align_offset = 0;
672 46         36 my $align_length = 0;
673              
674 46         91 while ( defined( $buffer = $self->_readline ) ) {
675 806 100 100     3103 if ( $buffer =~ m/^\>\>/
    100          
676             || $buffer =~ m/Internal pipeline statistics/ )
677             {
678 46         87 $self->_pushback($buffer);
679 46         122 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         123 $align_offset = 0;
688 149         142 $align_length = 0;
689 149         254 next;
690             }
691              
692 611 100 100     5177 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     215 my $domainnum = $1 || 1;
696 79         56 $count = 0;
697 79         102 my $key = $name . "_" . $domainnum;
698 79         133 $hsp = $hsp_list[ $hspinfo{"$key.$annot_counter"} ];
699 79         92 $csline = $$hsp[-5];
700 79         72 $hline = $$hsp[-4];
701 79         58 $midline = $$hsp[-3];
702 79         82 $qline = $$hsp[-2];
703 79         63 $pline = $$hsp[-1];
704 79         148 $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         120 my @data = split( " ", $buffer );
712 56         66 $csline .= $data[-2];
713 56         39 $max_count++;
714 56         33 $count++;
715 56         127 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         528 my @data = split( " ", $buffer );
723              
724 238         198 my $line_offset = 0;
725             # Use \Q\E on match to avoid errors on alignments
726             # that include stop codons (*)
727 238         2507 while ($buffer =~ m/\Q$data[-2]\E/g) {
728 238         581 $line_offset = pos $buffer;
729             }
730 238 50       348 if ($line_offset != 0) {
731 238         192 $align_length = length $data[-2];
732 238         216 $align_offset = $line_offset - $align_length;
733             }
734              
735 238 100       386 if ($self->{'_reporttype'} eq 'HMMSCAN') {
736             # hit sequence
737 132 100       198 $hline .= $data[-2] if ($count == $max_count - 3);
738             # query sequence
739 132 100       214 $qline .= $data[-2] if ($count == $max_count - 1);
740             }
741             else { # hmmsearch & nhmmer
742             # hit sequence
743 106 100       188 $hline .= $data[-2] if ($count == $max_count - 1);
744             # query sequence
745 106 100       204 $qline .= $data[-2] if ($count == $max_count - 3);
746             }
747              
748 238         172 $count++;
749 238         542 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         172 $midline .= substr $buffer, $align_offset, $align_length;
757 119         83 $count++;
758 119         229 next;
759             }
760             # posterior probability track
761             elsif ( $count == $max_count ) {
762 119         225 my @data = split(" ", $buffer);
763 119         132 $pline .= $data[-2];
764 119         105 $count = 0;
765 119         90 $max_count = 3;
766 119         151 $$hsp[-5] = $csline;
767 119         117 $$hsp[-4] = $hline;
768 119         101 $$hsp[-3] = $midline;
769 119         117 $$hsp[-2] = $qline;
770 119         115 $$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       70 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       493 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         62 while ( my $hit = shift @hit_list ) {
799 52         55 $index++;
800 52         76 my $hit_name = shift @$hit;
801 52         67 my $hit_desc = shift @$hit;
802 52         63 my $hit_signif = shift @$hit;
803 52         76 my $hit_score = shift @$hit;
804 52   100     167 my $num_domains = $domaincounter{"$hit_name.$index"} || 0;
805              
806 52         186 $self->start_element( { 'Name' => 'Hit' } );
807 52         185 $self->element(
808             { 'Name' => 'Hit_id',
809             'Data' => $hit_name
810             }
811             );
812 52         179 $self->element(
813             { 'Name' => 'Hit_desc',
814             'Data' => $hit_desc
815             }
816             );
817 52         172 $self->element(
818             { 'Name' => 'Hit_signif',
819             'Data' => $hit_signif
820             }
821             );
822 52         160 $self->element(
823             { 'Name' => 'Hit_score',
824             'Data' => $hit_score
825             }
826             );
827              
828 52         151 for my $i ( 1 .. $num_domains ) {
829 79         138 my $key = $hit_name . "_" . $i;
830 79         156 my $hsp = $hsp_list[ $hspinfo{"$key.$index"} ];
831 79 50       165 if ( defined $hsp ) {
832 79         129 my $hsp_name = shift @$hsp;
833 79         211 $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       180 if ($$hsp[-3] ne '') {
837 79         105 my $length = length $$hsp[-3];
838 79         122 my $identical = ($$hsp[-3] =~ tr/a-zA-Z//);
839 79         105 my $positive = ($$hsp[-3] =~ tr/+//) + $identical;
840 79         201 $self->element(
841             {
842             'Name' => 'Hsp_align-len',
843             'Data' => $length
844             }
845             );
846 79         225 $self->element(
847             { 'Name' => 'Hsp_identity',
848             'Data' => $identical
849             }
850             );
851 79         203 $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     232 if ( $self->{'_reporttype'} eq 'HMMSCAN' ) {
    100          
870 55         136 $self->element(
871             { 'Name' => 'Hsp_hit-from',
872             'Data' => shift @$hsp
873             }
874             );
875 55         157 $self->element(
876             { 'Name' => 'Hsp_hit-to',
877             'Data' => shift @$hsp
878             }
879             );
880 55         149 $self->element(
881             { 'Name' => 'Hsp_query-from',
882             'Data' => shift @$hsp
883             }
884             );
885 55         148 $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         42 $self->element(
895             { 'Name' => 'Hsp_query-from',
896             'Data' => shift @$hsp
897             }
898             );
899 14         42 $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         41 $self->element(
910             { 'Name' => 'Hsp_hit-to',
911             'Data' => shift @$hsp
912             }
913             );
914             }
915             $self->element(
916 79         263 { 'Name' => 'Hsp_score',
917             'Data' => shift @$hsp
918             }
919             );
920 79         240 $self->element(
921             { 'Name' => 'Hsp_evalue',
922             'Data' => shift @$hsp
923             }
924             );
925 79         141 my $hitlength = shift @$hsp;
926 79 100       140 if ( $hitlength != 0 ) {
927 17         48 $self->element(
928             { 'Name' => 'Hit_len',
929             'Data' => $hitlength
930             }
931             );
932             }
933             $self->element(
934 79         192 { 'Name' => 'Hsp_csline',
935             'Data' => shift @$hsp
936             }
937             );
938 79         216 $self->element(
939             { 'Name' => 'Hsp_hseq',
940             'Data' => shift @$hsp
941             }
942             );
943 79         265 $self->element(
944             { 'Name' => 'Hsp_midline',
945             'Data' => shift @$hsp
946             }
947             );
948 79         216 $self->element(
949             { 'Name' => 'Hsp_qseq',
950             'Data' => shift @$hsp
951             }
952             );
953 79         241 $self->element(
954             { 'Name' => 'Hsp_pline',
955             'Data' => shift @$hsp
956             }
957             );
958              
959             # Only nhmmer output has strand information
960 79 100       204 if ( $self->{'_reporttype'} eq 'NHMMER' ) {
961 2         18 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       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         9 $self->element(
975             { 'Name' => 'Hsp_hit-strand',
976             'Data' => $hstrand
977             }
978             );
979             }
980              
981 79         160 $self->end_element( { 'Name' => 'Hsp' } );
982             }
983             }
984 52         156 $self->end_element( { 'Name' => 'Hit' } );
985             }
986 20         39 @hit_list = ();
987 20         53 %hitinfo = ();
988 20         48 last;
989             }
990             }
991             else {
992 0         0 print STDERR "Missed this line: $buffer\n";
993 0         0 $self->debug($buffer);
994             }
995 225         499 $last = $buffer;
996             }
997 20         70 $self->end_element( { 'Name' => 'HMMER_Output' } );
998 20         68 my $result = $self->end_document();
999 20         255 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 1342 my ( $self, $data ) = @_;
1015              
1016             # we currently don't care about attributes
1017 1970         1468 my $nm = $data->{'Name'};
1018 1970         1647 my $type = $MODEMAP{$nm};
1019 1970 100       2385 if ($type) {
1020 145 50       305 if ( $self->_eventHandler->will_handle($type) ) {
1021 145         378 my $func = sprintf( "start_%s", lc $type );
1022 145         241 $self->_eventHandler->$func( $data->{'Attributes'} );
1023             }
1024 145         206 unshift @{ $self->{'_elements'} }, $type;
  145         244  
1025             }
1026 1970 100 100     3659 if ( defined $type
1027             && $type eq 'result' )
1028             {
1029 14         27 $self->{'_values'} = {};
1030 14         41 $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 1556 my ( $self, $data ) = @_;
1047 1976         1473 my $nm = $data->{'Name'};
1048 1976         1488 my $type = $MODEMAP{$nm};
1049 1976         1176 my $rc;
1050              
1051 1976 100       2596 if ( $nm eq 'HMMER_program' ) {
1052 20 50       174 if ( $self->{'_last_data'} =~ /([NP]?HMM\S+)/i ) {
1053 20         92 $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       2174 if ( $nm eq 'Hsp' ) {
1060 79         115 foreach my $line (qw(Hsp_csline Hsp_qseq Hsp_midline Hsp_hseq Hsp_pline)) {
1061 395         480 my $data = $self->{'_last_hspdata'}->{$line};
1062 395 100 100     1006 if ( $data && $line eq 'Hsp_hseq' ) {
1063              
1064             # replace hmm '.' gap symbol by '-'
1065 79         190 $data =~ s/\./-/g;
1066             }
1067             $self->element(
1068 395         768 { 'Name' => $line,
1069             'Data' => $data
1070             }
1071             );
1072             }
1073 79         98 $self->{'_last_hspdata'} = {};
1074             }
1075 1976 100       3089 if ($type) {
    50          
1076 151 50       341 if ( $self->_eventHandler->will_handle($type) ) {
1077 151         394 my $func = sprintf( "end_%s", lc $type );
1078             $rc = $self->_eventHandler->$func( $self->{'_reporttype'},
1079 151         212 $self->{'_values'} );
1080             }
1081 151         184 my $lastelem = shift @{ $self->{'_elements'} };
  151         250  
1082              
1083             # Flush corresponding values from the {_values} buffer
1084 151         172 my $name = uc $type;
1085 151         121 foreach my $key (keys %{ $self->{_values} }) {
  151         589  
1086 2902 100       7452 delete $self->{_values}->{$key} if ($key =~ m/^$name-/);
1087             }
1088             }
1089             elsif ( $MAPPING{$nm} ) {
1090 1825 50       2074 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         3191 $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         1654 $self->{'_last_data'} = ''; # remove read data if we are at
1105             # end of an element
1106 1976 100 100     3510 $self->{'_result'} = $rc if ( defined $type && $type eq 'result' );
1107 1976         2495 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 1473 my ( $self, $data ) = @_;
1122 1825         1835 $self->start_element($data);
1123 1825         1948 $self->characters($data);
1124 1825         2295 $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 10 my ($self,$key) = @_;
1139 8         7 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 1261 my ( $self, $data ) = @_;
1155              
1156 1825 100 100     2023 if ( $self->in_element('hsp')
      66        
1157             && $data->{'Name'} =~ /Hsp\_(?:qseq|hseq|csline|pline|midline)/o
1158             && defined $data->{'Data'} )
1159             {
1160 790         1475 $self->{'_last_hspdata'}->{ $data->{'Name'} } .= $data->{'Data'};
1161             }
1162 1825 50 33     6490 return unless ( defined $data->{'Data'} && $data->{'Data'} !~ /^\s+$/o );
1163              
1164 1825         2019 $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 37 my ( $self, $name ) = @_;
1181             return 0
1182             if ( !defined $name
1183             || !defined $self->{'_elements'}
1184 20 100 33     120 || scalar @{ $self->{'_elements'} } == 0 );
  20   66     99  
1185 14         17 foreach my $element ( @{ $self->{'_elements'} } ) {
  14         39  
1186 14 50       42 return 1 if ( $element eq $name );
1187             }
1188 14         37 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 1349 my ( $self, $name ) = @_;
1205 1825 100       2690 return 0 if !defined $self->{'_elements'}->[0];
1206 1779         8578 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 39 my ($self) = @_;
1221 25         69 $self->{'_lasttype'} = '';
1222 25         74 $self->{'_values'} = {};
1223 25         61 $self->{'_result'} = undef;
1224 25         58 $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 29 my ($self) = @_;
1239 20         37 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;