File Coverage

Bio/SearchIO/wise.pm
Criterion Covered Total %
statement 113 149 75.8
branch 28 52 53.8
condition 4 12 33.3
subroutine 14 20 70.0
pod 13 14 92.8
total 172 247 69.6


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::SearchIO::wise
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::wise - Parsing of wise output as alignments
17              
18             =head1 SYNOPSIS
19              
20             use Bio::SearchIO;
21             my $parser = Bio::SearchIO->new(-file => 'file.genewise',
22             -format => 'wise',
23             -wisetype=> 'genewise');
24              
25             while( my $result = $parser->next_result ) {}
26              
27             =head1 DESCRIPTION
28              
29             This object parsers Wise output using Bio::Tools::Genewise or
30             Bio::Tools::Genomewise as a helper.
31              
32             =head1 FEEDBACK
33              
34             =head2 Mailing Lists
35              
36             User feedback is an integral part of the evolution of this and other
37             Bioperl modules. Send your comments and suggestions preferably to
38             the Bioperl mailing list. Your participation is much appreciated.
39              
40             bioperl-l@bioperl.org - General discussion
41             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
42              
43             =head2 Support
44              
45             Please direct usage questions or support issues to the mailing list:
46              
47             I
48              
49             rather than to the module maintainer directly. Many experienced and
50             reponsive experts will be able look at the problem and quickly
51             address it. Please include a thorough description of the problem
52             with code and data examples if at all possible.
53              
54             =head2 Reporting Bugs
55              
56             Report bugs to the Bioperl bug tracking system to help us keep track
57             of the bugs and their resolution. Bug reports can be submitted via
58             the web:
59              
60             https://github.com/bioperl/bioperl-live/issues
61              
62             =head1 AUTHOR - Jason Stajich
63              
64             Email jason-at-bioperl-dot-org
65              
66             =head1 APPENDIX
67              
68             The rest of the documentation details each of the object methods.
69             Internal methods are usually preceded with a _
70              
71             =cut
72              
73              
74             # Let the code begin...
75              
76              
77             package Bio::SearchIO::wise;
78 1     1   3 use vars qw(%MAPPING %MODEMAP $DEFAULT_WRITER_CLASS);
  1         1  
  1         53  
79 1     1   3 use strict;
  1         1  
  1         17  
80              
81             # Object preamble - inherits from Bio::Root::Root
82              
83 1     1   3 use base qw(Bio::SearchIO);
  1         1  
  1         101  
84              
85             %MODEMAP = ('WiseOutput' => 'result',
86             'Hit' => 'hit',
87             'Hsp' => 'hsp'
88             );
89             %MAPPING =
90             (
91             'Hsp_query-from'=> 'HSP-query_start',
92             'Hsp_query-to' => 'HSP-query_end',
93             'Hsp_hit-from' => 'HSP-hit_start',
94             'Hsp_hit-to' => 'HSP-hit_end',
95             'Hsp_qseq' => 'HSP-query_seq',
96             'Hsp_hseq' => 'HSP-hit_seq',
97             'Hsp_midline' => 'HSP-homology_seq',
98             'Hsp_score' => 'HSP-score',
99             'Hsp_qlength' => 'HSP-query_length',
100             'Hsp_hlength' => 'HSP-hit_length',
101             'Hsp_align-len' => 'HSP-hsp_length',
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            
108             'Hit_id' => 'HIT-name',
109             # 'Hit_desc' => 'HIT-description',
110             # 'Hit_len' => 'HIT-length',
111             'Hit_score' => 'HIT-score',
112              
113             'WiseOutput_program' => 'RESULT-algorithm_name',
114             'WiseOutput_query-def' => 'RESULT-query_name',
115             'WiseOutput_query-desc'=> 'RESULT-query_description',
116             'WiseOutput_query-len' => 'RESULT-query_length',
117             );
118              
119             $DEFAULT_WRITER_CLASS = 'Bio::SearchIO::Writer::HitTableWriter';
120              
121              
122 1     1   571 use Bio::Tools::Genewise;
  1         2  
  1         28  
123 1     1   293 use Bio::Tools::Genomewise;
  1         1  
  1         1130  
124              
125             =head2 new
126              
127             Title : new
128             Usage : my $obj = Bio::SearchIO::wise->new();
129             Function: Builds a new Bio::SearchIO::wise object
130             Returns : an instance of Bio::SearchIO::wise
131             Args : -wise => a Bio::Tools::Genewise or Bio::Tools::Genomewise object
132              
133              
134             =cut
135              
136             sub _initialize {
137 1     1   2 my ($self,@args) = @_;
138 1         3 my ( $wisetype, $file,$fh ) =
139             $self->_rearrange([qw(WISETYPE FILE FH)], @args);
140 1         2 my @newargs;
141 1         3 while( @args ) {
142 3         2 my $a = shift @args;
143 3 100       16 if( $a =~ /FILE|FH/i ) {
144 1         1 shift @args;
145 1         2 next;
146             }
147 2         4 push @newargs, $a, shift @args;
148             }
149 1         6 $self->SUPER::_initialize(@newargs);
150              
151             # Optimization: caching the EventHandler
152             # since it's use a lot during the parse.
153 1         5 $self->{'_handler_cache'} = $self->_eventHandler;
154              
155 1         2 $self->wisetype($wisetype);
156 1         1 my @ioargs;
157 1 50       3 if( $fh ) {
    50          
158 0         0 push @ioargs, ('-fh' => $fh);
159             } elsif( $file ) {
160 1         2 push @ioargs, ('-file' => $file);
161             }
162              
163 1 50       4 if( $wisetype =~ /genewise/i ) {
    0          
164 1         6 $self->wise(Bio::Tools::Genewise->new(@ioargs));
165             } elsif( $wisetype =~ /genomewise/i ) {
166 0         0 $self->wise(Bio::Tools::Genomewise->new(@ioargs));
167             } else {
168 0         0 $self->throw("Must supply a -wisetype to ".ref($self)." which is one of 'genomewise' 'genewise'\n");
169             }
170 1         3 return $self;
171             }
172              
173              
174             =head2 next_result
175              
176             Title : next_result
177             Usage : my $hit = $searchio->next_result;
178             Function: Returns the next Result from a search
179             Returns : Bio::Search::Result::ResultI object
180             Args : none
181              
182             =cut
183              
184             sub next_result{
185 1     1 1 6 my ($self) = @_;
186 1         4 local $/ = "\n";
187 1         1 local $_;
188              
189 1 50       2 return unless $self->wise;
190 1         2 my $prediction = $self->wise->next_prediction;
191 1 50       3 return unless $prediction;
192 1         5 $self->{'_reporttype'} = uc $self->wisetype;
193 1         9 $self->start_element({'Name' => 'WiseOutput'});
194 1         4 $self->element({'Name' => 'WiseOutput_program',
195             'Data' => $self->wisetype});
196 1         55 $self->element({'Name' => 'WiseOutput_query-def',
197             'Data' => $self->wise->_prot_id});
198 1         5 my @transcripts = $prediction->transcripts;
199              
200 1         3 foreach my $transcript ( @transcripts ) {
201 1         4 my @exons = $transcript->exons;
202 1         3 my $protid;
203 1         4 $self->start_element({'Name' => 'Hit'});
204            
205 1 50       8 if( $exons[0]->has_tag('supporting_feature') ) {
206 1         6 my ($supporting_feature) = $exons[0]->get_tag_values('supporting_feature');
207 1         3 $protid = $supporting_feature->feature2->seq_id;
208 1         12 $self->element({'Name' => 'Hit_id',
209             'Data' => $self->wise->_target_id});
210             }
211 1         4 $self->element({'Name' => 'Hit_score',
212             'Data' => $self->wise->_score});
213 1         2 foreach my $exon ( @exons ) {
214 18         37 $self->start_element({'Name' => 'Hsp'});
215 18 50       42 if( $exon->strand < 0 ) {
216 0         0 $self->element({'Name' => 'Hsp_query-from',
217             'Data' => $exon->end});
218 0         0 $self->element({'Name' => 'Hsp_query-to',
219             'Data' => $exon->start});
220             } else {
221 18         30 $self->element({'Name' => 'Hsp_query-from',
222             'Data' => $exon->start});
223 18         36 $self->element({'Name' => 'Hsp_query-to',
224             'Data' => $exon->end});
225             }
226 18         32 $self->element({'Name' => 'Hsp_score',
227             'Data' => $self->wise->_score});
228 18 50       35 if( $exon->has_tag('supporting_feature') ) {
229 18         24 my ($sf) = $exon->get_tag_values('supporting_feature');
230 18         35 my $protein = $sf->feature2;
231 18 50       29 if( $protein->strand < 0 ) {
232 0         0 $self->element({'Name' => 'Hsp_hit-from',
233             'Data' => $protein->end});
234 0         0 $self->element({'Name' => 'Hsp_hit-to',
235             'Data' => $protein->start});
236             } else {
237 18         31 $self->element({'Name' => 'Hsp_hit-from',
238             'Data' => $protein->start});
239 18         34 $self->element({'Name' => 'Hsp_hit-to',
240             'Data' => $protein->end});
241             }
242             }
243 18         40 $self->element({'Name' => 'Hsp_identity',
244             'Data' => 0});
245 18         38 $self->element({'Name' => 'Hsp_positive',
246             'Data' => 0});
247 18         31 $self->end_element({'Name' => 'Hsp'});
248             }
249 1         3 $self->end_element({'Name' => 'Hit'});
250             }
251 1         3 $self->end_element({'Name' => 'WiseOutput'});
252 1         4 return $self->end_document();
253             }
254              
255             =head2 start_element
256              
257             Title : start_element
258             Usage : $eventgenerator->start_element
259             Function: Handles a start element event
260             Returns : none
261             Args : hashref with at least 2 keys 'Data' and 'Name'
262              
263              
264             =cut
265              
266             sub start_element{
267 150     150 1 96 my ($self,$data) = @_;
268             # we currently don't care about attributes
269 150         106 my $nm = $data->{'Name'};
270 150         109 my $type = $MODEMAP{$nm};
271              
272 150 100       192 if( $type ) {
273 20 50       30 if( $self->_eventHandler->will_handle($type) ) {
274 20         37 my $func = sprintf("start_%s",lc $type);
275 20         25 $self->_eventHandler->$func($data->{'Attributes'});
276             }
277 20         22 unshift @{$self->{'_elements'}}, $type;
  20         23  
278              
279 20 100       41 if($type eq 'result') {
280 1         2 $self->{'_values'} = {};
281 1         3 $self->{'_result'}= undef;
282             }
283             }
284              
285             }
286              
287             =head2 end_element
288              
289             Title : start_element
290             Usage : $eventgenerator->end_element
291             Function: Handles an end element event
292             Returns : none
293             Args : hashref with at least 2 keys 'Data' and 'Name'
294              
295              
296             =cut
297              
298             sub end_element {
299 150     150 1 90 my ($self,$data) = @_;
300 150         125 my $nm = $data->{'Name'};
301 150         98 my $type = $MODEMAP{$nm};
302 150         77 my $rc;
303              
304 150 100       221 if( $type = $MODEMAP{$nm} ) {
    50          
305 20 50       35 if( $self->_eventHandler->will_handle($type) ) {
306 20         39 my $func = sprintf("end_%s",lc $type);
307             $rc = $self->_eventHandler->$func($self->{'_reporttype'},
308 20         22 $self->{'_values'});
309             }
310 20         16 shift @{$self->{'_elements'}};
  20         23  
311              
312             } elsif( $MAPPING{$nm} ) {
313              
314 130 50       131 if ( ref($MAPPING{$nm}) =~ /hash/i ) {
315 0         0 my $key = (keys %{$MAPPING{$nm}})[0];
  0         0  
316 0         0 $self->{'_values'}->{$key}->{$MAPPING{$nm}->{$key}} = $self->{'_last_data'};
317             } else {
318 130         165 $self->{'_values'}->{$MAPPING{$nm}} = $self->{'_last_data'};
319             }
320             } else {
321 0         0 $self->debug( "unknown nm $nm, ignoring\n");
322             }
323 150         94 $self->{'_last_data'} = ''; # remove read data if we are at
324             # end of an element
325 150 100 100     238 $self->{'_result'} = $rc if( defined $type && $type eq 'result' );
326 150         142 return $rc;
327             }
328              
329             =head2 element
330              
331             Title : element
332             Usage : $eventhandler->element({'Name' => $name, 'Data' => $str});
333             Function: Convience method that calls start_element, characters, end_element
334             Returns : none
335             Args : Hash ref with the keys 'Name' and 'Data'
336              
337              
338             =cut
339              
340             sub element{
341 130     130 1 83 my ($self,$data) = @_;
342 130         121 $self->start_element($data);
343 130         124 $self->characters($data);
344 130         130 $self->end_element($data);
345             }
346              
347             =head2 characters
348              
349             Title : characters
350             Usage : $eventgenerator->characters($str)
351             Function: Send a character events
352             Returns : none
353             Args : string
354              
355              
356             =cut
357              
358             sub characters{
359 130     130 1 71 my ($self,$data) = @_;
360              
361 130 50 33     397 return unless ( defined $data->{'Data'} && $data->{'Data'} !~ /^\s+$/ );
362              
363 130         116 $self->{'_last_data'} = $data->{'Data'};
364             }
365              
366             =head2 within_element
367              
368             Title : within_element
369             Usage : if( $eventgenerator->within_element($element) ) {}
370             Function: Test if we are within a particular element
371             This is different than 'in' because within can be tested
372             for a whole block.
373             Returns : boolean
374             Args : string element name
375              
376              
377             =cut
378              
379             sub within_element{
380 0     0 1 0 my ($self,$name) = @_;
381             return 0 if ( ! defined $name &&
382             ! defined $self->{'_elements'} ||
383 0 0 0     0 scalar @{$self->{'_elements'}} == 0) ;
  0   0     0  
384 0         0 foreach ( @{$self->{'_elements'}} ) {
  0         0  
385 0 0       0 if( $_ eq $name ) {
386 0         0 return 1;
387             }
388             }
389 0         0 return 0;
390             }
391              
392              
393             =head2 in_element
394              
395             Title : in_element
396             Usage : if( $eventgenerator->in_element($element) ) {}
397             Function: Test if we are in a particular element
398             This is different than 'in' because within can be tested
399             for a whole block.
400             Returns : boolean
401             Args : string element name
402              
403              
404             =cut
405              
406             sub in_element{
407 0     0 1 0 my ($self,$name) = @_;
408 0 0       0 return 0 if ! defined $self->{'_elements'}->[0];
409 0         0 return ( $self->{'_elements'}->[0] eq $name)
410             }
411              
412             =head2 start_document
413              
414             Title : start_document
415             Usage : $eventgenerator->start_document
416             Function: Handle a start document event
417             Returns : none
418             Args : none
419              
420              
421             =cut
422              
423             sub start_document{
424 0     0 1 0 my ($self) = @_;
425 0         0 $self->{'_lasttype'} = '';
426 0         0 $self->{'_values'} = {};
427 0         0 $self->{'_result'}= undef;
428 0         0 $self->{'_elements'} = [];
429 0         0 $self->{'_reporttype'} = 'exonerate';
430             }
431              
432              
433             =head2 end_document
434              
435             Title : end_document
436             Usage : $eventgenerator->end_document
437             Function: Handles an end document event
438             Returns : Bio::Search::Result::ResultI object
439             Args : none
440              
441              
442             =cut
443              
444             sub end_document{
445 1     1 1 2 my ($self,@args) = @_;
446 1         8 return $self->{'_result'};
447             }
448              
449              
450             sub write_result {
451 0     0 1 0 my ($self, $blast, @args) = @_;
452              
453 0 0       0 if( not defined($self->writer) ) {
454 0         0 $self->warn("Writer not defined. Using a $DEFAULT_WRITER_CLASS");
455 0         0 $self->writer( $DEFAULT_WRITER_CLASS->new() );
456             }
457 0         0 $self->SUPER::write_result( $blast, @args );
458             }
459              
460             sub result_count {
461 0     0 1 0 my $self = shift;
462 0         0 return $self->{'_result_count'};
463             }
464              
465 0     0 0 0 sub report_count { shift->result_count }
466              
467              
468             =head2 wise
469              
470             Title : wise
471             Usage : $obj->wise($newval)
472             Function: Get/Set the Wise object parser
473             Returns : value of wise (a scalar)
474             Args : on set, new value (a scalar or undef, optional)
475              
476              
477             =cut
478              
479             sub wise{
480 24     24 1 22 my $self = shift;
481 24 100       41 return $self->{'wise'} = shift if @_;
482 23         63 return $self->{'wise'};
483             }
484              
485             =head2 wisetype
486              
487             Title : wisetype
488             Usage : $obj->wisetype($newval)
489             Function: Wise program type
490             Returns : value of wisetype (a scalar)
491             Args : on set, new value (a scalar or undef, optional)
492              
493              
494             =cut
495              
496             sub wisetype{
497 3     3 1 3 my $self = shift;
498              
499 3 100       8 return $self->{'wisetype'} = shift if @_;
500 2         9 return $self->{'wisetype'};
501             }
502              
503             1;