File Coverage

Bio/SearchIO/sim4.pm
Criterion Covered Total %
statement 170 202 84.1
branch 75 108 69.4
condition 24 54 44.4
subroutine 14 18 77.7
pod 11 12 91.6
total 294 394 74.6


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::SearchIO::sim4
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Jason Stajich
7             #
8             # Copyright Jason Stajich
9             #
10             # You may distribute this module under the same terms as perl itself
11              
12             # POD documentation - main docs before the code
13              
14             =head1 NAME
15              
16             Bio::SearchIO::sim4 - parser for Sim4 alignments
17              
18             =head1 SYNOPSIS
19              
20             # do not use this module directly, it is a driver for SearchIO
21             use Bio::SearchIO;
22             my $searchio = Bio::SearchIO->new(-file => 'results.sim4',
23             -format => 'sim4');
24              
25             while ( my $result = $searchio->next_result ) {
26             while ( my $hit = $result->next_hit ) {
27             while ( my $hsp = $hit->next_hsp ) {
28             # ...
29             }
30             }
31             }
32              
33             =head1 DESCRIPTION
34              
35             This is a driver for the SearchIO system for parsing Sim4.
36             http://globin.cse.psu.edu/html/docs/sim4.html
37              
38             Cannot parse LAV or 'exon file' formats (A=2 or A=5)
39              
40             =head1 FEEDBACK
41              
42             =head2 Mailing Lists
43              
44             User feedback is an integral part of the evolution of this and other
45             Bioperl modules. Send your comments and suggestions preferably to
46             the Bioperl mailing list. Your participation is much appreciated.
47              
48             bioperl-l@bioperl.org - General discussion
49             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
50              
51             =head2 Support
52              
53             Please direct usage questions or support issues to the mailing list:
54              
55             I
56              
57             rather than to the module maintainer directly. Many experienced and
58             reponsive experts will be able look at the problem and quickly
59             address it. Please include a thorough description of the problem
60             with code and data examples if at all possible.
61              
62             =head2 Reporting Bugs
63              
64             Report bugs to the Bioperl bug tracking system to help us keep track
65             of the bugs and their resolution. Bug reports can be submitted via the
66             web:
67              
68             https://github.com/bioperl/bioperl-live/issues
69              
70             =head1 AUTHOR - Jason Stajich
71              
72             Email jason-at-bioperl-dot-org
73              
74             =head1 CONTRIBUTORS
75              
76             Luc Gauthier (lgauthie@hotmail.com)
77              
78             =head1 APPENDIX
79              
80             The rest of the documentation details each of the object methods.
81             Internal methods are usually preceded with a _
82              
83             =cut
84              
85              
86             # Let the code begin...
87              
88              
89             package Bio::SearchIO::sim4;
90              
91 1     1   3 use strict;
  1         1  
  1         27  
92 1         59 use vars qw($DEFAULTFORMAT %ALIGN_TYPES
93 1     1   3 %MAPPING %MODEMAP $DEFAULT_WRITER_CLASS);
  1         1  
94              
95 1     1   376 use POSIX;
  1         4065  
  1         5  
96 1     1   1872 use Bio::SearchIO::SearchResultEventBuilder;
  1         2  
  1         33  
97              
98 1     1   4 use base qw(Bio::SearchIO);
  1         1  
  1         2129  
99              
100             $DEFAULTFORMAT = 'SIM4';
101             $DEFAULT_WRITER_CLASS = 'Bio::SearchIO::Writer::HitTableWriter';
102              
103             %ALIGN_TYPES = (
104             0 => 'Ruler',
105             1 => 'Query',
106             2 => 'Mid',
107             3 => 'Sbjct'
108             );
109              
110             %MODEMAP = (
111             'Sim4Output' => 'result',
112             'Hit' => 'hit',
113             'Hsp' => 'hsp'
114             );
115              
116             %MAPPING = (
117             'Hsp_query-from'=> 'HSP-query_start',
118             'Hsp_query-to' => 'HSP-query_end',
119             'Hsp_qseq' => 'HSP-query_seq',
120             'Hsp_qlength' => 'HSP-query_length',
121             'Hsp_querygaps' => 'HSP-query_gaps',
122             'Hsp_hit-from' => 'HSP-hit_start',
123             'Hsp_hit-to' => 'HSP-hit_end',
124             'Hsp_hseq' => 'HSP-hit_seq',
125             'Hsp_hlength' => 'HSP-hit_length',
126             'Hsp_hitgaps' => 'HSP-hit_gaps',
127             'Hsp_midline' => 'HSP-homology_seq',
128             'Hsp_score' => 'HSP-score',
129             'Hsp_align-len' => 'HSP-hsp_length',
130             'Hsp_identity' => 'HSP-identical',
131              
132             'Hit_id' => 'HIT-name',
133             'Hit_desc' => 'HIT-description',
134             'Hit_len' => 'HIT-length',
135              
136             'Sim4Output_program' => 'RESULT-algorithm_name',
137             'Sim4Output_query-def' => 'RESULT-query_name',
138             'Sim4Output_query-desc'=> 'RESULT-query_description',
139             'Sim4Output_query-len' => 'RESULT-query_length',
140             );
141              
142              
143              
144             =head2 new
145              
146             Title : new
147             Usage : my $obj = Bio::SearchIO::sim4->new();
148             Function: Builds a new Bio::SearchIO::sim4 object
149             Returns : an instance of Bio::SearchIO::sim4
150             Args :
151              
152              
153             =cut
154              
155              
156             =head2 next_result
157              
158             Title : next_result
159             Usage : my $result = $searchio->next_result;
160             Function: Returns the next Result from a search
161             Returns : Bio::Search::Result::ResultI object
162             Args : none
163              
164             =cut
165              
166             sub next_result {
167 6     6 1 14 my ($self) = @_;
168 6         21 local $/ = "\n";
169 6         7 local $_;
170              
171             # Declare/adjust needed variables
172 6         9 $self->{'_last_data'} = '';
173 6         5 my ($seentop, $qfull, @hsps, %alignment, $format);
174 6         6 my $hit_direction = 1;
175              
176             # Start document and main element
177 6         14 $self->start_document();
178 6         18 $self->start_element({'Name' => 'Sim4Output'});
179 6         7 my $lastquery = '';
180             # Read output report until EOF
181 6         21 while( defined($_ = $self->_readline) ) {
182             # Skip empty lines, chomp filled ones
183 72 100       202 next if( /^\s+$/); chomp;
  54         45  
184              
185             # Make sure sim4 output format is not 2 or 5
186 54 100       69 if (!$seentop) {
187 6 50       39 if ( /^\#:lav/ ) { $format = 2; }
  0 50       0  
188 0         0 elsif ( /^<|>/ ) { $format = 5; }
189 6 50       12 $self->throw("Bio::SearchIO::sim4 module cannot parse 'type $format' outputs.") if $format;
190             }
191              
192             # This line indicates the start of a new hit
193 54 100       255 if( /^seq1\s*=\s*(\S+),\s+(\d+)/ ) {
    100          
    100          
    100          
    100          
    50          
194 7         20 my ($nm,$desc) = ($1,$2);
195             # First hit? Adjust some parameters if so
196 7 100       12 if ( ! $seentop ) {
    50          
197 6         27 $self->element( {'Name' => 'Sim4Output_query-def',
198             'Data' => $nm} );
199 6         19 $self->element( {'Name' => 'Sim4Output_query-len',
200             'Data' => $desc} );
201 6         9 $seentop = 1;
202             } elsif( $nm ne $lastquery ) {
203 0         0 $self->_pushback($_);
204 0         0 last;
205             }
206 7         8 $lastquery = $nm;
207             # A previous HSP may need to be ended
208 7 50       9 $self->end_element({'Name' => 'Hsp'}) if ( $self->in_element('hsp') );
209             # A previous hit exists? End it and reset needed variables
210 7 100       12 if ( $self->in_element('hit') ) {
211 1         3 foreach (@hsps) {
212 4         8 $self->start_element({'Name' => 'Hsp'});
213 4         15 while (my ($name, $data) = each %$_) {
214 32         83 $self->{'_currentHSP'}{$name} = $data;
215             }
216 4         10 $self->end_element({'Name' => 'Hsp'});
217 4         9 $self->{'_currentHSP'} = {};
218             }
219 1 50       4 $format = 0 if @hsps;
220 1         5 @hsps = ();
221 1         3 %alignment = ();
222 1         1 $qfull = 0;
223 1         1 $hit_direction = 1;
224 1         3 $self->end_element({'Name' => 'Hit'});
225             }
226              
227             # This line describes the current hit... so let's start it
228             } elsif( /^seq2\s*=\s*(\S+)\s+\(>?(\S+)\s*\),\s*(\d+)/ ) {
229 7         19 $self->start_element({'Name' => 'Hit'});
230 7         25 $self->element( {'Name' => 'Hit_id', 'Data' => $2} );
231 7         20 $self->element( {'Name' => 'Hit_desc', 'Data' => $1} );
232 7         21 $self->element( {'Name' => 'Hit_len', 'Data' => $3} );
233              
234             # This line may give additional details about query or subject
235             } elsif( /^>(\S+)\s*(.*)?/ ) {
236             # Previous line was query details... this time subject details
237 2 100       4 if( $qfull ) {
238 1 50       4 $format = 4 if !$format;
239 1         3 $self->element({'Name' => 'Hit_desc', 'Data' => $2});
240             # First line of this type is always query details for a given hit
241             } else {
242 1         4 $self->element({'Name' => 'Sim4Output_query-desc', 'Data' => $2});
243 1         2 $qfull = 1;
244             }
245              
246             # This line indicates that subject is on reverse strand
247             } elsif( /^\(complement\)/ ) {
248 2         4 $hit_direction = -1;
249              
250             # This line describes the current HSP... so add it to @hsps array
251             } elsif( /^\(?(\d+)\-(\d+)\)?\s+\(?(\d+)\-(\d+)\)?\s+(\d+)/ ) {
252 28         58 my ($qs,$qe,$hs,$he,$pid) = ($1,$2,$3,$4,$5);
253 28 100       203 push @hsps, {
    100          
254             'Hsp_query-from' => $qs,
255             'Hsp_query-to' => $qe,
256             'Hsp_hit-from' => $hit_direction >= 0 ? $hs : $he,
257             'Hsp_hit-to' => $hit_direction >= 0 ? $he : $hs,
258             'Hsp_identity' => 0, #can't determine correctly from raw pct
259             'Hsp_qlength' => abs($qe - $qs) + 1,
260             'Hsp_hlength' => abs($he - $hs) + 1,
261             'Hsp_align-len' => abs($qe - $qs) + 1,
262             };
263              
264             # This line indicates the start of an alignment block
265             } elsif( /^\s+(\d+)\s/ ) {
266             # Store the current alignment block in a hash
267 8   66     31 for( my $i = 0; defined($_) && $i < 4; $i++ ) {
268 32         78 my ($start, $string) = /^\s+(\d*)\s(.*)/;
269             $alignment{$ALIGN_TYPES{$i}} = { start => $start, string => $i != 2
270             ? $string
271 32 100       104 : (' ' x (length($alignment{$ALIGN_TYPES{$i-1}}{string}) - length($string))) . $string
272             };
273 32         105 $_ = $self->_readline();
274             }
275              
276             # 'Ruler' line indicates the start of a new HSP
277 8 100       19 if ($alignment{Ruler}{start} == 0) {
278 2 50       7 $format = @hsps ? 3 : 1 if !$format;
    100          
279             # A previous HSP may need to be ended
280 2 50       4 $self->end_element({'Name' => 'Hsp'}) if ( $self->in_element('hsp') );
281             # Start the new HSP and fill the '_currentHSP' property with available details
282 2         6 $self->start_element({'Name' => 'Hsp'});
283             $self->{'_currentHSP'} = @hsps ? shift @hsps : {
284             'Hsp_query-from' => $alignment{Query}{start},
285             'Hsp_hit-from' => $alignment{Sbjct}{start},
286             }
287 2 50       8 }
288              
289             # Midline indicates a boundary between two HSPs
290 8 100       29 if ( $alignment{Mid}{string} =~ /<|>/g ) {
291 4         4 my ($hsp_start, $hsp_end);
292             # Are we currently in an open HSP?
293 4 100       6 if ( $self->in_element('hsp') ) {
294             # Find end pos, adjust 'gaps', 'seq' and 'midline' properties... then close HSP
295 2         3 $hsp_end = (pos $alignment{Mid}{string}) - 1;
296             $self->{'_currentHSP'}{'Hsp_querygaps'} +=
297 2         10 ($self->{'_currentHSP'}{'Hsp_qseq'} .= substr($alignment{Query}{string}, 0, $hsp_end)) =~ s/ /-/g;
298             $self->{'_currentHSP'}{'Hsp_hitgaps'} +=
299 2         5 ($self->{'_currentHSP'}{'Hsp_hseq'} .= substr($alignment{Sbjct}{string}, 0, $hsp_end)) =~ s/ /-/g;
300 2         5 ($self->{'_currentHSP'}{'Hsp_midline'} .= substr($alignment{Mid}{string}, 0, $hsp_end)) =~ s/-/ /g;
301 2         5 $self->end_element({'Name' => 'Hsp'});
302              
303             # Does a new HSP start in the current alignment block?
304 2 50       11 if ( $alignment{Mid}{string} =~ /\|/g ) {
305             # Find start pos, start new HSP and fill it with available details
306 0         0 $hsp_start = (pos $alignment{Mid}{string}) - 1;
307 0         0 $self->start_element({'Name' => 'Hsp'});
308 0 0       0 $self->{'_currentHSP'} = @hsps ? shift @hsps : {};
309             $self->{'_currentHSP'}{'Hsp_querygaps'} +=
310 0         0 ($self->{'_currentHSP'}{'Hsp_qseq'} = substr($alignment{Query}{string}, $hsp_start)) =~ s/ /-/g;
311             $self->{'_currentHSP'}{'Hsp_hitgaps'} +=
312 0         0 ($self->{'_currentHSP'}{'Hsp_hseq'} = substr($alignment{Sbjct}{string}, $hsp_start)) =~ s/ /-/g;
313 0         0 ($self->{'_currentHSP'}{'Hsp_midline'} = substr($alignment{Mid}{string}, $hsp_start)) =~ s/-/ /g;
314             }
315             }
316             # No HSP is currently open...
317             else {
318             # Find start pos, start new HSP and fill it with available
319             # details then skip to next alignment block
320 2         5 $hsp_start = index($alignment{Mid}{string}, '|');
321 2         5 $self->start_element({'Name' => 'Hsp'});
322             $self->{'_currentHSP'} = @hsps ? shift @hsps : {
323             'Hsp_query-from' => $alignment{Query}{start},
324 2 50       6 };
325             $self->{'_currentHSP'}{'Hsp_querygaps'} +=
326 2         9 ($self->{'_currentHSP'}{'Hsp_qseq'} = substr($alignment{Query}{string}, $hsp_start)) =~ s/ /-/g;
327             $self->{'_currentHSP'}{'Hsp_hitgaps'} +=
328 2         6 ($self->{'_currentHSP'}{'Hsp_hseq'} = substr($alignment{Sbjct}{string}, $hsp_start)) =~ s/ /-/g;
329 2         5 ($self->{'_currentHSP'}{'Hsp_midline'} = substr($alignment{Mid}{string}, $hsp_start)) =~ s/-/ /g;
330 2         4 next;
331             }
332             }
333             # Current alignment block does not contain HSPs boundary
334             else {
335             # Start a new HSP if none is currently open
336             # (Happens if last boundary finished at the very end of previous block)
337 4 50       7 if ( !$self->in_element('hsp') ) {
338 0         0 $self->start_element({'Name' => 'Hsp'});
339             $self->{'_currentHSP'} = @hsps ? shift @hsps : {
340             'Hsp_query-from' => $alignment{Query}{start},
341             'Hsp_hit-from' => $alignment{Sbjct}{start},
342             }
343 0 0       0 }
344             # Adjust details of the current HSP
345             $self->{'_currentHSP'}{'Hsp_query-from'} ||=
346             $alignment{Query}{start} -
347 4   0     8 length($self->{'_currentHSP'}{'Hsp_qseq'} || '');
      33        
348             $self->{'_currentHSP'}{'Hsp_hit-from'} ||=
349             $alignment{Sbjct}{start} -
350 4   0     9 length($self->{'_currentHSP'}{'Hsp_hseq'} || '');
      33        
351             $self->{'_currentHSP'}{'Hsp_querygaps'} +=
352             ($self->{'_currentHSP'}{'Hsp_qseq'} .=
353 4         13 $alignment{Query}{string}) =~ s/ /-/g;
354             $self->{'_currentHSP'}{'Hsp_hitgaps'} +=
355             ($self->{'_currentHSP'}{'Hsp_hseq'} .=
356 4         16 $alignment{Sbjct}{string}) =~ s/ /-/g;
357             ($self->{'_currentHSP'}{'Hsp_midline'} .=
358 4         22 $alignment{Mid}{string}) =~ s/-/ /g;
359             }
360             }
361             }
362              
363             # We are done reading the sim4 report, end everything and return
364 6 50       14 if( $seentop ) {
365             # end HSP if needed
366 6 100       12 $self->end_element({'Name' => 'Hsp'}) if ( $self->in_element('hsp') );
367             # end Hit if needed
368 6 50       15 if ( $self->in_element('hit') ) {
369 6         10 foreach (@hsps) {
370 20         41 $self->start_element({'Name' => 'Hsp'});
371 20         76 while (my ($name, $data) = each %$_) {
372 160         321 $self->{'_currentHSP'}{$name} = $data;
373             }
374 20         37 $self->end_element({'Name' => 'Hsp'});
375             }
376 6         16 $self->end_element({'Name' => 'Hit'});
377             }
378             # adjust result's algorithm name, end output and return
379 6 100       31 $self->element({'Name' => 'Sim4Output_program',
380             'Data' => $DEFAULTFORMAT . ' (A=' . (defined $format ? $format : '?') . ')'});
381 6         17 $self->end_element({'Name' => 'Sim4Output'});
382 6         18 return $self->end_document();
383             }
384 0         0 return;
385             }
386              
387             =head2 start_element
388              
389             Title : start_element
390             Usage : $eventgenerator->start_element
391             Function: Handles a start element event
392             Returns : none
393             Args : hashref with at least 2 keys 'Data' and 'Name'
394              
395              
396             =cut
397              
398             sub start_element{
399 378     378 1 251 my ($self,$data) = @_;
400             # we currently don't care about attributes
401 378         297 my $nm = $data->{'Name'};
402 378         267 my $type = $MODEMAP{$nm};
403              
404 378 100       818 if( $type ) {
405 41 50       52 if( $self->_will_handle($type) ) {
406 41         85 my $func = sprintf("start_%s",lc $type);
407 41         67 $self->_eventHandler->$func($data->{'Attributes'});
408             }
409 41         47 unshift @{$self->{'_elements'}}, $type;
  41         64  
410              
411 41 100       82 if($type eq 'result') {
412 6         7 $self->{'_values'} = {};
413 6         11 $self->{'_result'}= undef;
414             }
415             }
416              
417             }
418              
419             =head2 end_element
420              
421             Title : start_element
422             Usage : $eventgenerator->end_element
423             Function: Handles an end element event
424             Returns : none
425             Args : hashref with at least 2 keys 'Data' and 'Name'
426              
427              
428             =cut
429              
430             sub end_element {
431 378     378 1 251 my ($self,$data) = @_;
432 378         285 my $nm = $data->{'Name'};
433 378         253 my $type = $MODEMAP{$nm};
434 378         208 my $rc;
435            
436 378 100       454 if( $nm eq 'Hsp' ) {
437 28   100     84 $self->{'_currentHSP'}{'Hsp_midline'} ||= '';
438             $self->{'_currentHSP'}{'Hsp_query-to'} ||=
439 28   33     44 $self->{'_currentHSP'}{'Hsp_query-from'} + length($self->{'_currentHSP'}{'Hsp_qseq'}) - 1 - $self->{'_currentHSP'}{'Hsp_querygaps'};
440             $self->{'_currentHSP'}{'Hsp_hit-to'} ||=
441 28   33     39 $self->{'_currentHSP'}{'Hsp_hit-from'} + length($self->{'_currentHSP'}{'Hsp_hseq'}) - 1 - $self->{'_currentHSP'}{'Hsp_hitgaps'};
442             $self->{'_currentHSP'}{'Hsp_identity'} ||=
443 28   66     76 ($self->{'_currentHSP'}{'Hsp_midline'} =~ tr/\|//);
444 28   33     40 $self->{'_currentHSP'}{'Hsp_qlength'} ||= abs($self->{'_currentHSP'}{'Hsp_query-to'} - $self->{'_currentHSP'}{'Hsp_query-from'}) + 1;
445 28   33     83 $self->{'_currentHSP'}{'Hsp_hlength'} ||= abs($self->{'_currentHSP'}{'Hsp_hit-to'} - $self->{'_currentHSP'}{'Hsp_hit-from'}) + 1;
446 28   33     42 $self->{'_currentHSP'}{'Hsp_align-len'} ||= abs($self->{'_currentHSP'}{'Hsp_query-to'} - $self->{'_currentHSP'}{'Hsp_query-from'}) + 1;
447 28   66     102 $self->{'_currentHSP'}{'Hsp_score'} ||= int(100 * ($self->{'_currentHSP'}{'Hsp_identity'} / $self->{'_currentHSP'}{'Hsp_align-len'}));
448 28         21 foreach (keys %{$self->{'_currentHSP'}}) {
  28         80  
449 296         206 $self->element({'Name' => $_, 'Data' => delete ${$self->{'_currentHSP'}}{$_}});
  296         571  
450             }
451             }
452              
453 378 100       541 if( $type = $MODEMAP{$nm} ) {
    50          
454 41 50       51 if( $self->_will_handle($type) ) {
455 41         79 my $func = sprintf("end_%s",lc $type);
456             $rc = $self->_eventHandler->$func($self->{'_reporttype'},
457 41         63 $self->{'_values'});
458             }
459 41         29 shift @{$self->{'_elements'}};
  41         47  
460              
461             } elsif( $MAPPING{$nm} ) {
462              
463 337 50       322 if ( ref($MAPPING{$nm}) =~ /hash/i ) {
464 0         0 my $key = (keys %{$MAPPING{$nm}})[0];
  0         0  
465 0         0 $self->{'_values'}->{$key}->{$MAPPING{$nm}->{$key}} = $self->{'_last_data'};
466             } else {
467 337         441 $self->{'_values'}->{$MAPPING{$nm}} = $self->{'_last_data'};
468             }
469             } else {
470 0         0 $self->debug( "unknown nm $nm, ignoring\n");
471             }
472 378         281 $self->{'_last_data'} = ''; # remove read data if we are at
473             # end of an element
474 378 100 100     563 $self->{'_result'} = $rc if( defined $type && $type eq 'result' );
475 378         562 return $rc;
476             }
477              
478             =head2 element
479              
480             Title : element
481             Usage : $eventhandler->element({'Name' => $name, 'Data' => $str});
482             Function: Convience method that calls start_element, characters, end_element
483             Returns : none
484             Args : Hash ref with the keys 'Name' and 'Data'
485              
486              
487             =cut
488              
489             sub element{
490 337     337 1 237 my ($self,$data) = @_;
491 337         299 $self->start_element($data);
492 337         318 $self->characters($data);
493 337         344 $self->end_element($data);
494             }
495              
496             =head2 characters
497              
498             Title : characters
499             Usage : $eventgenerator->characters($str)
500             Function: Send a character events
501             Returns : none
502             Args : string
503              
504              
505             =cut
506              
507             sub characters{
508 337     337 1 238 my ($self,$data) = @_;
509 337 50 33     1066 return unless ( defined $data->{'Data'} && $data->{'Data'} !~ /^\s+$/ );
510            
511 337 100 100     340 if( $self->in_element('hsp') &&
512             $data->{'Name'} =~ /Hsp\_(qseq|hseq|midline)/ ) {
513 36         54 $self->{'_last_hspdata'}->{$data->{'Name'}} .= $data->{'Data'};
514             }
515              
516 337         388 $self->{'_last_data'} = $data->{'Data'};
517             }
518              
519             =head2 within_element
520              
521             Title : within_element
522             Usage : if( $eventgenerator->within_element($element) ) {}
523             Function: Test if we are within a particular element
524             This is different than 'in' because within can be tested
525             for a whole block.
526             Returns : boolean
527             Args : string element name
528              
529              
530             =cut
531              
532             sub within_element{
533 0     0 1 0 my ($self,$name) = @_;
534             return 0 if ( ! defined $name &&
535             ! defined $self->{'_elements'} ||
536 0 0 0     0 scalar @{$self->{'_elements'}} == 0) ;
  0   0     0  
537 0         0 foreach ( @{$self->{'_elements'}} ) {
  0         0  
538 0 0       0 if( $_ eq $name ) {
539 0         0 return 1;
540             }
541             }
542 0         0 return 0;
543             }
544              
545              
546             =head2 in_element
547              
548             Title : in_element
549             Usage : if( $eventgenerator->in_element($element) ) {}
550             Function: Test if we are in a particular element
551             This is different than 'in' because within can be tested
552             for a whole block.
553             Returns : boolean
554             Args : string element name
555              
556              
557             =cut
558              
559             sub in_element{
560 373     373 1 276 my ($self,$name) = @_;
561 373 50       474 return 0 if ! defined $self->{'_elements'}->[0];
562 373         1282 return ( $self->{'_elements'}->[0] eq $name)
563             }
564              
565             =head2 start_document
566              
567             Title : start_document
568             Usage : $eventgenerator->start_document
569             Function: Handle a start document event
570             Returns : none
571             Args : none
572              
573              
574             =cut
575              
576             sub start_document{
577 6     6 1 5 my ($self) = @_;
578 6         9 $self->{'_lasttype'} = '';
579 6         11 $self->{'_values'} = {};
580 6         6 $self->{'_result'}= undef;
581 6         9 $self->{'_elements'} = [];
582 6         11 $self->{'_reporttype'} = $DEFAULTFORMAT;
583             }
584              
585              
586             =head2 end_document
587              
588             Title : end_document
589             Usage : $eventgenerator->end_document
590             Function: Handles an end document event
591             Returns : Bio::Search::Result::ResultI object
592             Args : none
593              
594              
595             =cut
596              
597             sub end_document{
598 6     6 1 10 my ($self,@args) = @_;
599 6         47 return $self->{'_result'};
600             }
601              
602              
603             sub write_result {
604 0     0 1 0 my ($self, $blast, @args) = @_;
605              
606 0 0       0 if( not defined($self->writer) ) {
607 0         0 $self->warn("Writer not defined. Using a $DEFAULT_WRITER_CLASS");
608 0         0 $self->writer( $DEFAULT_WRITER_CLASS->new() );
609             }
610 0         0 $self->SUPER::write_result( $blast, @args );
611             }
612              
613             sub result_count {
614 0     0 1 0 return 1; # can a sim4 report contain more than one result?
615             }
616              
617 0     0 0 0 sub report_count { shift->result_count }
618              
619             =head2 _will_handle
620              
621             Title : _will_handle
622             Usage : Private method. For internal use only.
623             if( $self->_will_handle($type) ) { ... }
624             Function: Provides an optimized way to check whether or not an element of a
625             given type is to be handled.
626             Returns : Reference to EventHandler object if the element type is to be handled.
627             undef if the element type is not to be handled.
628             Args : string containing type of element.
629              
630             Optimizations:
631              
632             1. Using the cached pointer to the EventHandler to minimize repeated lookups.
633             2. Caching the will_handle status for each type that is encountered
634             so that it only need be checked by calling handler->will_handle($type) once.
635              
636             This does not lead to a major savings by itself (only 5-10%).
637             In combination with other optimizations, or for large parse jobs, the
638             savings good be significant.
639              
640             To test against the unoptimized version, remove the parentheses from
641             around the third term in the ternary " ? : " operator and add two
642             calls to $self-E_eventHandler().
643              
644             =cut
645              
646             sub _will_handle {
647 82     82   58 my ($self,$type) = @_;
648 82   66     143 my $handler = $self->{'_handler_cache'} ||= $self->_eventHandler;
649              
650             my $will_handle = defined($self->{'_will_handle_cache'}->{$type})
651             ? $self->{'_will_handle_cache'}->{$type}
652 82 100       162 : ($self->{'_will_handle_cache'}->{$type} =
653             $handler->will_handle($type));
654              
655 82 50       167 return $will_handle ? $handler : undef;
656             }
657              
658             1;