~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to Bio/SearchIO/hmmer3.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2011-06-17 13:51:18 UTC
  • mfrom: (3.1.6 sid)
  • Revision ID: james.westby@ubuntu.com-20110617135118-hncy38e0134j8oi5
Tags: 1.6.901-1
* New upstream release.
* Point debian/watch to search.cpan.org.
* Build using dh and overrides:
  - Use Debhelper 8 (debian/rules, debian/control).
  - Simplified debian/rules.
* Split into libbio-perl-perl, as discussed with the Debian Perl team.
  (debian/control, debian/bioperl.install, debian libbio-perl-perl.install)
* debian/control:
  - Incremented Standards-Version to reflect conformance with Policy 3.9.2.
    No other changes needed.
  - Vcs-Browser URL made redirectable to viewvc.
  - Removed useless ‘svn’ in the Vcs-Svn URL.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# $Id: bioperl.lisp 15559 2009-02-23 12:11:20Z maj $
 
2
#
 
3
# BioPerl module for Bio::SearchIO::hmmer3
 
4
#
 
5
# Please direct questions and support issues to <bioperl-l@bioperl.org>
 
6
#
 
7
# Cared for by Thomas Sharpton <thomas.sharpton@gmail.com>
 
8
#
 
9
# Copyright Thomas Sharpton
 
10
#
 
11
# You may distribute this module under the same terms as perl itself
 
12
 
 
13
# POD documentation - main docs before the code
 
14
 
 
15
=head1 NAME
 
16
 
 
17
Bio::SearchIO::hmmer3 - DESCRIPTION of Object
 
18
 
 
19
=head1 SYNOPSIS
 
20
 
 
21
Give standard usage here
 
22
 
 
23
=head1 DESCRIPTION
 
24
 
 
25
Describe the object here
 
26
 
 
27
=head1 FEEDBACK
 
28
 
 
29
=head2 Mailing Lists
 
30
 
 
31
User feedback is an integral part of the evolution of this and other
 
32
Bioperl modules. Send your comments and suggestions preferably to
 
33
the Bioperl mailing list.  Your participation is much appreciated.
 
34
 
 
35
  bioperl-l@bioperl.org                  - General discussion
 
36
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 
37
 
 
38
=head2 Support
 
39
 
 
40
Please direct usage questions or support issues to the mailing list:
 
41
 
 
42
L<bioperl-l@bioperl.org>
 
43
 
 
44
rather than to the module maintainer directly. Many experienced and
 
45
reponsive experts will be able look at the problem and quickly
 
46
address it. Please include a thorough description of the problem
 
47
with code and data examples if at all possible.
 
48
 
 
49
=head2 Reporting Bugs
 
50
 
 
51
Report bugs to the Bioperl bug tracking system to help us keep track
 
52
of the bugs and their resolution. Bug reports can be submitted via
 
53
the web:
 
54
 
 
55
  https://redmine.open-bio.org/projects/bioperl/
 
56
 
 
57
=head1 AUTHOR - Thomas Sharpton
 
58
 
 
59
Email thomas.sharpton@gmail.com
 
60
 
 
61
Describe contact details here
 
62
 
 
63
=head1 CONTRIBUTORS
 
64
 
 
65
Additional contributors names and emails here
 
66
 
 
67
=head1 APPENDIX
 
68
 
 
69
The rest of the documentation details each of the object methods.
 
70
Internal methods are usually preceded with a _
 
71
 
 
72
=cut
 
73
 
 
74
 
 
75
# Let the code begin...
 
76
 
 
77
package Bio::SearchIO::hmmer3;
 
78
 
 
79
use strict;
 
80
use Data::Dumper;
 
81
use Bio::Factory::ObjectFactory;
 
82
use vars qw(%MAPPING %MODEMAP);
 
83
use base qw(Bio::SearchIO::hmmer);
 
84
 
 
85
BEGIN {
 
86
 
 
87
    # mapping of HMMER items to Bioperl hash keys
 
88
    %MODEMAP = (
 
89
        'HMMER_Output' => 'result',
 
90
        'Hit'          => 'hit',
 
91
        'Hsp'          => 'hsp'
 
92
    );
 
93
 
 
94
    %MAPPING = (
 
95
        'Hsp_bit-score'   => 'HSP-bits',
 
96
        'Hsp_score'       => 'HSP-score',
 
97
        'Hsp_evalue'      => 'HSP-evalue',
 
98
        'Hsp_query-from'  => 'HSP-query_start',
 
99
        'Hsp_query-to'    => 'HSP-query_end',
 
100
        'Hsp_hit-from'    => 'HSP-hit_start',
 
101
        'Hsp_hit-to'      => 'HSP-hit_end',
 
102
        'Hsp_positive'    => 'HSP-conserved',
 
103
        'Hsp_identity'    => 'HSP-identical',
 
104
        'Hsp_gaps'        => 'HSP-hsp_gaps',
 
105
        'Hsp_hitgaps'     => 'HSP-hit_gaps',
 
106
        'Hsp_querygaps'   => 'HSP-query_gaps',
 
107
        'Hsp_qseq'        => 'HSP-query_seq',
 
108
        'Hsp_hseq'        => 'HSP-hit_seq',
 
109
        'Hsp_midline'     => 'HSP-homology_seq',
 
110
        'Hsp_align-len'   => 'HSP-hsp_length',
 
111
        'Hsp_query-frame' => 'HSP-query_frame',
 
112
        'Hsp_hit-frame'   => 'HSP-hit_frame',
 
113
 
 
114
        'Hit_id'        => 'HIT-name',
 
115
        'Hit_len'       => 'HIT-length',
 
116
        'Hit_accession' => 'HIT-accession',
 
117
        'Hit_desc'      => 'HIT-description',
 
118
        'Hit_signif'    => 'HIT-significance',
 
119
        'Hit_score'     => 'HIT-score',
 
120
 
 
121
        'HMMER_program'   => 'RESULT-algorithm_name',
 
122
        'HMMER_version'   => 'RESULT-algorithm_version',
 
123
        'HMMER_query-def' => 'RESULT-query_name',
 
124
        'HMMER_query-len' => 'RESULT-query_length',
 
125
        'HMMER_query-acc' => 'RESULT-query_accession',
 
126
        'HMMER_querydesc' => 'RESULT-query_description',
 
127
        'HMMER_hmm'       => 'RESULT-hmm_name',
 
128
        'HMMER_seqfile'   => 'RESULT-sequence_file',
 
129
        'HMMER_db'        => 'RESULT-database_name',
 
130
    );
 
131
}
 
132
 
 
133
=head2 new
 
134
 
 
135
 Title   : new
 
136
 Usage   : my $obj = new Bio::SearchIO::Hmmer3->new();
 
137
 Function: Builds a new Bio::SearchIO::Hmmer3 object
 
138
 Returns : an instance of Bio::SearchIO::Hmmer3
 
139
 Args    : -fh/-file => HMMER filename
 
140
           -format   => 'hmmer3'
 
141
 
 
142
=cut
 
143
 
 
144
sub _initialize {
 
145
  my( $self,@args ) = @_;
 
146
  $self->SUPER::_initialize(@args);
 
147
  $self->{'_hmmidline'} = 'HMMER 3.0b placeholder';
 
148
  $self->{'_alnreport'} = 1; #does report include alignments
 
149
}
 
150
 
 
151
=head2 next_result
 
152
 
 
153
 Title   : next_result
 
154
 Usage   : my $hit = $searchio->next_result;
 
155
 Function: Returns the next Result from a search
 
156
 Returns : Bio::Search::Result::ResultI object
 
157
 Args    : none
 
158
 
 
159
=cut
 
160
 
 
161
sub next_result{
 
162
   my ($self)  = @_;
 
163
   my $seentop = 0; #Placeholder for when we deal with multi-query reports
 
164
   my $reporttype;
 
165
   my ( $last, @hit_list, @hsp_list, %hspinfo, %hitinfo, %domaincounter );
 
166
   local $/ = "\n";
 
167
   local $_;
 
168
 
 
169
   my $verbose = $self->verbose;  # cache for speed? JES's idea in hmmer.pm
 
170
   $self->start_document();
 
171
   local ($_);
 
172
   #This is here to ensure that next_result doesn't produce infinite loop
 
173
   if(!defined( $_ = $self->_readline) ) {
 
174
       return undef;
 
175
   }
 
176
   else{
 
177
       $self->_pushback($_);
 
178
   }
 
179
   #Regex goes here for HMMER3
 
180
   #Start with hmmsearch processing
 
181
   while ( defined( $_ = $self->_readline ) ) {
 
182
       my $lineorig = $_;
 
183
       chomp;
 
184
       #Grab the program name.
 
185
       if ( $_ =~ m/^\#\s(\S+)\s\:\:\s/ ){
 
186
           my $prog = $1;
 
187
           #TO DO LATER: customize the above regex to adapt to other
 
188
           #program types!!! (hmmscan, etc)
 
189
           $self->start_element( { 'Name' => 'HMMER_Output' } );
 
190
           $self->{'_result_count'}++; #Might need to move to another block
 
191
           $self->element(
 
192
               {
 
193
                   'Name' => 'HMMER_program',
 
194
                   'Data' => uc($prog)
 
195
               }
 
196
           );
 
197
       }
 
198
       #Get the HMMER package version and release date
 
199
       elsif ( $_ =~ m/^\#\sHMMER\s+(\S+)\s+\((.+)\)/ ) {
 
200
           my $version     = $1;
 
201
           my $versiondate = $2;
 
202
           $self->{'_hmmidline'} = $_;
 
203
           $self->element(
 
204
               {
 
205
                   'Name' => 'HMMER_version',
 
206
                   'Data' => $version
 
207
               }
 
208
           );
 
209
       }
 
210
       #Get the query info
 
211
       elsif( $_ =~ /^\#\squery \w+ file\:\s+(\S+)/ ){
 
212
           if( $self->{'_reporttype'} eq 'HMMSEARCH') {
 
213
               $self->{'_hmmfileline'} = $lineorig;
 
214
               $self->element(
 
215
                   {
 
216
                       'Name' => 'HMMER_hmm',
 
217
                       'Data' => $1
 
218
                   }
 
219
               );
 
220
           }
 
221
           elsif( $self->{'_reporttype'} eq 'HMMSCAN' ) {
 
222
               $self->{'_hmmseqline'} = $lineorig;
 
223
               $self->element(
 
224
                   {
 
225
                       'Name' => 'HMMER_seqfile',
 
226
                       'Data' => $1
 
227
                   }
 
228
              );
 
229
           }
 
230
       }
 
231
       #If this is a report without alignments
 
232
       elsif( $_ =~ m/^\#\sshow\salignments\sin\soutput/ ){
 
233
           $self->{'_alnreport'} = 0;
 
234
       }
 
235
       #Get the database info
 
236
       elsif( $_ =~ m/^\#\starget\s\S+\sdatabase\:\s+(\S+)/ ){
 
237
#          $self->{'_hmmseqline'} = $lineorig;
 
238
#          $self->element(
 
239
#              {
 
240
#                  'Name' => 'HMMER_seqfile',
 
241
#                  'Data' => $1
 
242
#              }
 
243
#          );
 
244
           if( $self->{'_reporttype'} eq 'HMMSEARCH') {
 
245
               $self->{'_hmmseqline'} = $lineorig;
 
246
               $self->element(
 
247
                   {
 
248
                       'Name' => 'HMMER_seqfile',
 
249
                       'Data' => $1
 
250
                   }
 
251
               );
 
252
           }
 
253
           elsif( $self->{'_reporttype'} eq 'HMMSCAN' ) {
 
254
               $self->{'_hmmfileline'} = $lineorig;
 
255
               $self->element(
 
256
                   {
 
257
                       'Name' => 'HMMER_hmm',
 
258
                       'Data' => $1
 
259
                   }
 
260
              );
 
261
           }
 
262
       }
 
263
       #Get query data
 
264
       elsif( $_ =~ s/^Query:\s+// ) {
 
265
           #TODO Code to deal with multi query report
 
266
           unless( s/\s+\[[L|M]\=(\d+)\]$// ){
 
267
               warn "Error parsing length for query, offending line $_\n";
 
268
               exit(0);
 
269
           }
 
270
           my $querylen = $1;
 
271
           $self->element(
 
272
               {
 
273
                   'Name' => 'HMMER_query-len',
 
274
                   'Data' => $querylen
 
275
               }
 
276
           );
 
277
           $self->element(
 
278
               {
 
279
                   'Name' => 'HMMER_query-def',
 
280
                   'Data' => $_
 
281
               }
 
282
           );
 
283
       }
 
284
       #Get Accession data
 
285
       elsif( $_ =~ s/^Accession:\s+// ){
 
286
           s/\s+$//;
 
287
           $self->element(
 
288
               {
 
289
                   'Name' => 'HMMER_query-acc',
 
290
                   'Data' => $_
 
291
               }
 
292
           );
 
293
       }
 
294
       #Get description data
 
295
       elsif( $_ =~ s/^Description:\s+// ){
 
296
           s/\s+$//;
 
297
           $self->element(
 
298
               {
 
299
                   'Name' => 'HMMER_querydesc',
 
300
                   'Data' => $_
 
301
               }
 
302
           );
 
303
       }
 
304
       #PROCESS HMMSEARCH AND HMMSCAN RESULTS SPECIFIC FORMATTING HERE
 
305
       elsif( defined $self->{'_reporttype'} &&
 
306
              (
 
307
               $self->{'_reporttype'} eq 'HMMSEARCH' ||
 
308
               $self->{'_reporttype'} eq 'HMMSCAN'
 
309
              )
 
310
           ){
 
311
           #Complete sequence table data above inclusion threshold
 
312
           if( $_ =~ m/Scores for complete sequence/){
 
313
               while (defined( $_ = $self->_readline ) ) {
 
314
                   if ($_ =~ m/inclusion threshold/ || m/Domain( and alignment)? annotation for each/ ||
 
315
                       m/\[No hits detected/ || m!^//! ){
 
316
                       $self->_pushback($_);
 
317
                       last;
 
318
                   }
 
319
                   #grab table data
 
320
                   next if ( m/\-\-\-/ || m/^\s+E\-value\s+score/ || m/^$/);
 
321
                   my (
 
322
                       $eval_full, $score_full, $bias_full,
 
323
                       $eval_best, $score_best, $bias_best,
 
324
                       $exp, $n, $hitid, $desc, @hitline
 
325
                       );
 
326
                   @hitline = split(" ", $_);
 
327
                   $eval_full  = shift @hitline;
 
328
                   $score_full = shift @hitline;
 
329
                   $bias_full  = shift @hitline;
 
330
                   $eval_best  = shift @hitline;
 
331
                   $score_best = shift @hitline;
 
332
                   $bias_best  = shift @hitline;
 
333
                   $exp        = shift @hitline;
 
334
                   $n          = shift @hitline;
 
335
                   $hitid      = shift @hitline;
 
336
                   $desc       = join " ", @hitline;
 
337
 
 
338
                   if( !defined( $desc ) ){
 
339
                       $desc = "";
 
340
                   }
 
341
                   push @hit_list, [ $hitid, $desc, $eval_full, $score_full ];
 
342
                   $hitinfo{$hitid}= $#hit_list;
 
343
               }
 
344
           }
 
345
           #Complete sequence table data below inclusion threshold
 
346
           #not currently fully implemented
 
347
           elsif( $_ =~ m/inclusion threshold/ ){
 
348
               while( defined( $_ = $self->_readline ) ) {
 
349
                   if( $_ =~ m/Domain( and alignment)? annotation for each/ ||
 
350
                       m/Internal pipeline statistics summary/ ){
 
351
                       $self->_pushback($_);
 
352
                       last;
 
353
                   }
 
354
                   next if( $_ =~ m/^$/ );
 
355
                   my (
 
356
                       $eval_full, $score_full, $bias_full,
 
357
                       $eval_best, $score_best, $bias_best,
 
358
                       $exp, $n, $hitid, $desc, @hitline
 
359
                       );
 
360
                   @hitline = split(" ", $_);
 
361
                   $eval_full  = shift @hitline;
 
362
                   $score_full = shift @hitline;
 
363
                   $bias_full  = shift @hitline;
 
364
                   $eval_best  = shift @hitline;
 
365
                   $score_best = shift @hitline;
 
366
                   $bias_best  = shift @hitline;
 
367
                   $exp        = shift @hitline;
 
368
                   $n          = shift @hitline;
 
369
                   $hitid      = shift @hitline;
 
370
                   $desc       = join " ", @hitline;
 
371
 
 
372
                   $hitinfo{$hitid} = "below_inclusion";
 
373
               }
 
374
           }
 
375
           #Domain annotation for each sequence table data
 
376
           elsif( $_ =~ m/Domain( and alignment)? annotation for each/){
 
377
               @hsp_list = (); #here for multi-query reports
 
378
               my $name;
 
379
 
 
380
               while( defined( $_ = $self->_readline ) ) {
 
381
                   if ($_ =~ m/Internal pipeline statistics/ || m/\[No targets detected/ ){
 
382
                       $self->_pushback($_);
 
383
                       last;
 
384
                   }
 
385
                   if( $_ =~ m/^\>\>\s(.*?)\s+/ ) {
 
386
                       $name = $1;
 
387
                       #skip hits below inclusion threshold
 
388
                       next if( $hitinfo{$name} eq "below_inclusion");
 
389
                       $domaincounter{$name} = 0;
 
390
 
 
391
                       while( defined( $_ = $self->_readline ) ) {
 
392
                           #grab table data for sequence
 
393
                           if ($_ =~ m/Internal pipeline statistics/ ||
 
394
                               $_ =~ m/^\>\>/                        ){
 
395
                               $self->_pushback($_);
 
396
                               last;
 
397
                           }
 
398
                           if ( $_ =~ m/Alignments for each domain/ ) {
 
399
                               $self->_pushback($_);
 
400
                               last;
 
401
                           }
 
402
                           if ( $_ =~ m/^\s+\#\s+score/ ||
 
403
                                $_ =~ m/^\s\-\-\-\s+/   ||
 
404
#                               $_ =~ m/^\>\>/          ||
 
405
                                $_ =~ m/^$/             ){
 
406
                               next;
 
407
                           }
 
408
 
 
409
#                          grab hsp data from table, push into @hsp;
 
410
                           if(
 
411
                               my ($domain_num, $score, $bias, $ceval,
 
412
                                   $ieval, $hmmstart, $hmmstop,
 
413
                                   $qalistart, $qalistop, $envstart,
 
414
                                   $envstop, $envbound, $acc) =
 
415
                               m!^\s+(\d+)\s\!*\?*\s+       #domain num
 
416
                                   (\S+)\s+(\S+)\s+             #score, bias
 
417
                                   (\S+)\s+(\S+)\s+             #c-eval, i-eval
 
418
                                   (\d+)\s+(\d+).+?             #hmm start, stop
 
419
                                   (\d+)\s+(\d+).+?             #query start, stop
 
420
                                   (\d+)\s+(\d+).+?             #env start, stop
 
421
                                   (\S+)                        #acc
 
422
                                   \s*$!ox
 
423
                               ){
 
424
                               #keeping simple for now. let's customize later
 
425
                               my @vals = ($hmmstart, $hmmstop, $qalistart, $qalistop, $score, $ceval, '', '', '');
 
426
                               my $info = $hit_list[ $hitinfo{$name} ];
 
427
                               if( !defined $info ){
 
428
                                   $self->warn(
 
429
                                       "Incomplete sequence information; can't find $name, hitinfo says $hitinfo{$name}\n"
 
430
                                       );
 
431
                                   next;
 
432
                               }
 
433
                               $domaincounter{$name}++;
 
434
                               my $hsp_key = $name . "_" . $domaincounter{$name};
 
435
                               push @hsp_list, [ $name, @vals ];
 
436
                               $hspinfo{$hsp_key} = $#hsp_list;
 
437
                           }
 
438
                           else{
 
439
                               print "missed this line: $_\n";
 
440
                           }
 
441
                       }
 
442
                   }
 
443
                   elsif ($_ =~ m/Alignments for each domain/ ) {
 
444
                       my $domain_count = 0;
 
445
                       #line counter
 
446
                       my $count = 0;
 
447
                       # There's an optional block, so we sometimes need to
 
448
                       # count to 3, and sometimes to 4.
 
449
                       my $max_count = 3;
 
450
                       my $lastdomain;
 
451
                       my $hsp;
 
452
                       my ($hline, $midline, $qline);
 
453
 
 
454
                       while( defined( $_ = $self->_readline ) ) {
 
455
                           if( $_ =~ m/^\>\>/ ||
 
456
                               $_ =~ m/Internal pipeline statistics/){
 
457
                               $self->_pushback($_);
 
458
                               last;
 
459
                           }
 
460
                           elsif( $hitinfo{$name} eq "below_inclusion" ||
 
461
                                   $_ =~ m/^$/ ) {
 
462
                               next;
 
463
                           }
 
464
                           elsif( $_ =~ /\s\s\=\=\sdomain\s(\d+)\s+/){
 
465
                               my $domainnum = $1;
 
466
                               $count = 0;
 
467
                               my $key = $name . "_" . $domainnum;
 
468
                               $hsp = $hsp_list[ $hspinfo{$key} ];
 
469
                               $hline = $$hsp[-3];
 
470
                               $midline = $$hsp[-2];
 
471
                               $qline = $$hsp[-1];
 
472
                               $lastdomain = $name;
 
473
                           }
 
474
                           # model data track, some reports don't have
 
475
                           elsif( $_ =~ m/\s+\S+\sCS$/ ){
 
476
                               my $modeltrack = $_;
 
477
                               $max_count++;
 
478
                               $count++;
 
479
                               next;
 
480
                           }
 
481
                           elsif( $count == $max_count - 3 ){
 
482
                               #hit sequence
 
483
                               my @data = split(" ", $_);
 
484
                               my $seq = $data[-2];
 
485
                               $hline .= $seq;
 
486
                               $count++;
 
487
                               next;
 
488
                           }
 
489
                           elsif( $count == $max_count - 2 ){
 
490
                               #conservation track
 
491
                               #storage isn't quite right - need to remove
 
492
                               #leading/lagging whitespace while preserving
 
493
                               #gap data (latter isn't done, former is)
 
494
                               $_ =~ s/^\s+//;
 
495
                               $_ =~ s/\s+$//;
 
496
                               $midline .= $_;
 
497
                               $count++;
 
498
                               next;
 
499
                           }
 
500
                           elsif( $count == $max_count - 1 ){
 
501
                               #query track
 
502
                               my @data = split(" ", $_);
 
503
                               my $seq = $data[-2];
 
504
                               $qline .= $seq;
 
505
                               $count++;
 
506
                               next;
 
507
                           }
 
508
                           elsif( $count == $max_count ){
 
509
                               #pval track
 
510
                               my $pvals = $_;
 
511
                               $count = 0;
 
512
                               $max_count = 3;
 
513
                               $$hsp[-3] = $hline;
 
514
                               $$hsp[-2] = $midline;
 
515
                               $$hsp[-1] = $qline;
 
516
                               next;
 
517
                           }
 
518
                           else{
 
519
                               print "missed $_\n";
 
520
                           }
 
521
                       }
 
522
                   }
 
523
               }
 
524
           }
 
525
           elsif( m/Internal pipeline statistics/ || m!^//! ){
 
526
#              if within hit, hsp close;
 
527
               if ( $self->within_element('hit') ) {
 
528
                   if ( $self->within_element('hsp') ) {
 
529
                       $self->end_element( { 'Name' => 'Hsp' } );
 
530
                   }
 
531
                   $self->end_element( { 'Name' => 'Hit' } );
 
532
               }
 
533
               #grab summary statistics of run
 
534
               while( defined( $_ = $self->_readline ) ) {
 
535
                   last if ( $_ =~ m/^\/\/$/ );
 
536
               }
 
537
 
 
538
               #Jason does a lot of processing of hits/hsps here;
 
539
               while( my $hit = shift @hit_list ) {
 
540
                   my $hit_name = shift @$hit;
 
541
                   my $hit_desc = shift @$hit;
 
542
                   my $hit_signif = shift @$hit;
 
543
                   my $hit_score = shift @$hit;
 
544
                   my $num_domains = $domaincounter{$hit_name} || 0;
 
545
 
 
546
                   $self->start_element( { 'Name' => 'Hit' } );
 
547
                   $self->element(
 
548
                       {
 
549
                           'Name' => 'Hit_id',
 
550
                           'Data' => $hit_name
 
551
                       }
 
552
                   );
 
553
                   $self->element(
 
554
                       {
 
555
                           'Name' => 'Hit_desc',
 
556
                           'Data' => $hit_desc
 
557
                       }
 
558
                   );
 
559
                   $self->element(
 
560
                       {
 
561
                           'Name' => 'Hit_signif',
 
562
                           'Data' => $hit_signif
 
563
                       }
 
564
                   );
 
565
                   $self->element(
 
566
                       {
 
567
                           'Name' => 'Hit_score',
 
568
                           'Data' => $hit_score
 
569
                       }
 
570
                   );
 
571
                   for my $i (1..$num_domains) {
 
572
                       my $key = $hit_name . "_" . $i;
 
573
                       my $hsp = $hsp_list[ $hspinfo{$key} ];
 
574
                       if(defined $hsp) {
 
575
                           my $hsp_name = shift @$hsp;
 
576
                           $self->start_element( { 'Name' => 'Hsp' } );
 
577
                           $self->element( {
 
578
                                   'Name' => 'Hsp_identity',
 
579
                                   'Data' => 0
 
580
                               } );
 
581
                           $self->element( {
 
582
                                   'Name' => 'Hsp_positive',
 
583
                                   'Data' => 0
 
584
                               } );
 
585
                           $self->element( {
 
586
                                   'Name' => 'Hsp_hit-from',
 
587
                                   'Data' => shift @$hsp
 
588
                               } );
 
589
                           $self->element( {
 
590
                                   'Name' => 'Hsp_hit-to',
 
591
                                   'Data' => shift @$hsp
 
592
                               } );
 
593
                           $self->element( {
 
594
                                   'Name' => 'Hsp_query-from',
 
595
                                   'Data' => shift @$hsp
 
596
                               } );
 
597
                           $self->element( {
 
598
                                   'Name' => 'Hsp_query-to',
 
599
                                   'Data' => shift @$hsp
 
600
                               } );
 
601
                           $self->element( {
 
602
                                   'Name' => 'Hsp_score',
 
603
                                   'Data' => shift @$hsp
 
604
                               } );
 
605
                           $self->element( {
 
606
                                   'Name' => 'Hsp_evalue',
 
607
                                   'Data' => shift @$hsp
 
608
                               } );
 
609
                           $self->element( {
 
610
                                   'Name' => 'Hsp_hseq',
 
611
                                   'Data' => shift @$hsp
 
612
                               } );
 
613
                           $self->element( {
 
614
                                   'Name' => 'Hsp_midline',
 
615
                                   'Data' => shift @$hsp
 
616
                               } );
 
617
                           $self->element( {
 
618
                                   'Name' => 'Hsp_qseq',
 
619
                                   'Data' => shift @$hsp
 
620
                               } );
 
621
                           $self->end_element( { 'Name' => 'Hsp' } );
 
622
                       }
 
623
                   }
 
624
                   $self->end_element( { 'Name' => 'Hit' } );
 
625
               }
 
626
               @hit_list = ();
 
627
               %hitinfo = ();
 
628
               last;
 
629
           }
 
630
       }
 
631
       else{
 
632
           print "missed: $_\n";
 
633
           $self->debug($_);
 
634
       }
 
635
       $last = $_;
 
636
   }
 
637
   $self->end_element( { 'Name' => 'HMMER_Output' } );
 
638
   my $result = $self->end_document();
 
639
   return $result;
 
640
}
 
641
 
 
642
 
 
643
 
 
644
=head2 start_element
 
645
 
 
646
 Title   : start_element
 
647
 Usage   : $eventgenerator->start_element
 
648
 Function: Handles a start event
 
649
 Returns : none
 
650
 Args    : hashref with at least 2 keys 'Data' and 'Name'
 
651
 
 
652
=cut
 
653
 
 
654
sub start_element{
 
655
 
 
656
    my ( $self, $data ) = @_;
 
657
 
 
658
    # we currently don't care about attributes
 
659
    my $nm   = $data->{'Name'};
 
660
    my $type = $MODEMAP{$nm};
 
661
    if ($type) {
 
662
        if ( $self->_eventHandler->will_handle($type) ) {
 
663
            my $func = sprintf( "start_%s", lc $type );
 
664
            $self->_eventHandler->$func( $data->{'Attributes'} );
 
665
        }
 
666
        unshift @{ $self->{'_elements'} }, $type;
 
667
    }
 
668
    if ( defined $type
 
669
        && $type eq 'result' )
 
670
    {
 
671
        $self->{'_values'} = {};
 
672
        $self->{'_result'} = undef;
 
673
    }
 
674
}
 
675
 
 
676
=head2 end_element
 
677
 
 
678
 Title   : end_element
 
679
 Usage   : $eventgeneartor->end_element
 
680
 Function: Handles and end element event
 
681
 Returns : none
 
682
 Args    : hashref with at least 2 keys 'Data' and 'Name'
 
683
 
 
684
=cut
 
685
 
 
686
sub end_element{
 
687
 
 
688
    my ( $self, $data ) = @_;
 
689
    my $nm   = $data->{'Name'};
 
690
    my $type = $MODEMAP{$nm};
 
691
    my $rc;
 
692
 
 
693
    if ( $nm eq 'HMMER_program' ) {
 
694
        if ( $self->{'_last_data'} =~ /(HMM\S+)/i ) {
 
695
            $self->{'_reporttype'} = uc $1;
 
696
        }
 
697
    }
 
698
 
 
699
    # Hsp are sort of weird, in that they end when another
 
700
    # object begins so have to detect this in end_element for now
 
701
    if ( $nm eq 'Hsp' ) {
 
702
        foreach (qw(Hsp_qseq Hsp_midline Hsp_hseq)) {
 
703
            my $data = $self->{'_last_hspdata'}->{$_};
 
704
            if ($data && $_ eq 'Hsp_hseq') {
 
705
                # replace hmm '.' gap symbol by '-'
 
706
                $data =~ s/\./-/g;
 
707
            }
 
708
            $self->element(
 
709
                {
 
710
                    'Name' => $_,
 
711
                    'Data' => $data
 
712
                }
 
713
            );
 
714
        }
 
715
        $self->{'_last_hspdata'} = {};
 
716
    }
 
717
    if ($type) {
 
718
        if ( $self->_eventHandler->will_handle($type) ) {
 
719
            my $func = sprintf( "end_%s", lc $type );
 
720
            $rc = $self->_eventHandler->$func( $self->{'_reporttype'},
 
721
                $self->{'_values'} );
 
722
        }
 
723
        my $lastelem = shift @{ $self->{'_elements'} };
 
724
    }
 
725
    elsif ( $MAPPING{$nm} ) {
 
726
       if ( ref( $MAPPING{$nm} ) =~ /hash/i ) {
 
727
            my $key = ( keys %{ $MAPPING{$nm} } )[0];
 
728
            $self->{'_values'}->{$key}->{ $MAPPING{$nm}->{$key} } =
 
729
              $self->{'_last_data'};
 
730
        }
 
731
        else {
 
732
            $self->{'_values'}->{ $MAPPING{$nm} } = $self->{'_last_data'};
 
733
#           print "lastdata is " . $self->{'_last_data'} . "\n";
 
734
        }
 
735
    }
 
736
    else {
 
737
        $self->debug("unknown nm $nm, ignoring\n");
 
738
    }
 
739
    $self->{'_last_data'} = '';    # remove read data if we are at
 
740
                                   # end of an element
 
741
    $self->{'_result'} = $rc if ( defined $type && $type eq 'result' );
 
742
    return $rc;
 
743
}
 
744
 
 
745
=head2 element
 
746
 
 
747
 Title   : element
 
748
 Usage   : $eventhandler->element({'Name' => $name, 'Data' => $str});
 
749
 Function: Convienence method that calls start_element, characters, end_element
 
750
 Returns : none
 
751
 Args    : Hash ref with the keys 'Name' and 'Data'
 
752
 
 
753
=cut
 
754
 
 
755
sub element{
 
756
    my ( $self, $data ) = @_;
 
757
    $self->start_element($data);
 
758
    $self->characters($data);
 
759
    $self->end_element($data);
 
760
}
 
761
 
 
762
=head2 characters
 
763
 
 
764
 Title   : characters
 
765
 Usage   : $eventgenerator->characters($str)
 
766
 Function: Send a character events
 
767
 Returns : none
 
768
 Args    : string
 
769
 
 
770
=cut
 
771
 
 
772
sub characters{
 
773
    my ( $self, $data ) = @_;
 
774
 
 
775
    if (   $self->in_element('hsp')
 
776
        && $data->{'Name'} =~ /Hsp\_(qseq|hseq|midline)/o
 
777
        && defined $data->{'Data'} )
 
778
    {
 
779
        $self->{'_last_hspdata'}->{ $data->{'Name'} } .= $data->{'Data'};
 
780
    }
 
781
    return unless ( defined $data->{'Data'} && $data->{'Data'} !~ /^\s+$/o );
 
782
 
 
783
    $self->{'_last_data'} = $data->{'Data'};
 
784
}
 
785
 
 
786
=head2 within_element
 
787
 
 
788
 Title   : within_element
 
789
 Usage   : if( $eventgenerator->within_element( $element ) ) {}
 
790
 Function: Test if we are within a particular element
 
791
           This is different than 'in' because within can be tested for
 
792
           a whole block
 
793
 Returns : boolean
 
794
 Args    : string element name
 
795
 
 
796
=cut
 
797
 
 
798
sub within_element{
 
799
    my ( $self, $name ) = @_;
 
800
    return 0
 
801
      if ( !defined $name
 
802
        || !defined $self->{'_elements'}
 
803
        || scalar @{ $self->{'_elements'} } == 0 );
 
804
    foreach ( @{ $self->{'_elements'} } ) {
 
805
        return 1 if ( $_ eq $name );
 
806
    }
 
807
    return 0;
 
808
}
 
809
 
 
810
=head2 in_element
 
811
 
 
812
 Title   : in_element
 
813
 Usage   : if( $eventgenerator->in_element( $element ) ) {}
 
814
 Function: Test if we are in a particular element
 
815
           This is different than 'within' because 'in' only
 
816
           tests its immediate parent
 
817
 Returns : boolean
 
818
 Args    : string element name
 
819
 
 
820
=cut
 
821
 
 
822
sub in_element{
 
823
    my ( $self, $name ) = @_;
 
824
    return 0 if !defined $self->{'_elements'}->[0];
 
825
    return ( $self->{'_elements'}->[0] eq $name );
 
826
}
 
827
 
 
828
=head2 start_document
 
829
 
 
830
 Title   : start_document
 
831
 Usage   : $eventgenerator->start_document
 
832
 Function: Handle a start document event
 
833
 Returns : none
 
834
 Args    : none
 
835
 
 
836
=cut
 
837
 
 
838
sub start_document{
 
839
   my ($self) = @_;
 
840
   $self->{'_lasttype'} = '';
 
841
   $self->{'_values'}   = {};
 
842
   $self->{'_result'}   = undef;
 
843
   $self->{'_elements'} = [];
 
844
}
 
845
 
 
846
=head2 end_document
 
847
 
 
848
 Title   : end_document
 
849
 Usage   : $eventgenerator->end_document
 
850
 Function: Handles an end document event
 
851
 Returns : Bio::Search::Result::ResultI object
 
852
 Args    : none
 
853
 
 
854
=cut
 
855
 
 
856
sub end_document{
 
857
   my ($self) = @_;
 
858
   return $self->{'_result'};
 
859
}
 
860
 
 
861
=head2 result_count
 
862
 
 
863
 Title   : result_count
 
864
 Usage   : my $count = $searchio->result_count
 
865
 Function: Returns the number of results processed
 
866
 Returns : interger
 
867
 Args    : none
 
868
 
 
869
=cut
 
870
 
 
871
sub result_count{
 
872
   my $self = shift;
 
873
   return $self->{'_result_count'};
 
874
}
 
875
 
 
876
 
 
877
1;