~ubuntu-branches/ubuntu/karmic/bioperl/karmic

« back to all changes in this revision

Viewing changes to Bio/SearchIO/sim4.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matt Hope
  • Date: 2004-04-18 14:24:11 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040418142411-gr92uexquw4w8liq
Tags: 1.4-1
* New upstream release
* Examples and working code are installed by default to usr/bin,
  this has been moved to usr/share/doc/bioperl/bin

Show diffs side-by-side

added added

removed removed

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