ide/bioperl-mode: into its own repository to be developed separately
[bioperl-live.git] / Bio / SearchIO / wise.pm
blobc265cd62c2acba914197a28406a0e9cd32c54b3d
2 # BioPerl module for Bio::SearchIO::wise
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Jason Stajich <jason-at-bioperl-dot-org>
8 # Copyright Jason Stajich
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
14 =head1 NAME
16 Bio::SearchIO::wise - Parsing of wise output as alignments
18 =head1 SYNOPSIS
20 use Bio::SearchIO;
21 my $parser = Bio::SearchIO->new(-file => 'file.genewise',
22 -format => 'wise',
23 -wisetype=> 'genewise');
25 while( my $result = $parser->next_result ) {}
27 =head1 DESCRIPTION
29 This object parsers Wise output using Bio::Tools::Genewise or
30 Bio::Tools::Genomewise as a helper.
32 =head1 FEEDBACK
34 =head2 Mailing Lists
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.
40 bioperl-l@bioperl.org - General discussion
41 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
43 =head2 Support
45 Please direct usage questions or support issues to the mailing list:
47 I<bioperl-l@bioperl.org>
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.
54 =head2 Reporting Bugs
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:
60 https://github.com/bioperl/bioperl-live/issues
62 =head1 AUTHOR - Jason Stajich
64 Email jason-at-bioperl-dot-org
66 =head1 APPENDIX
68 The rest of the documentation details each of the object methods.
69 Internal methods are usually preceded with a _
71 =cut
74 # Let the code begin...
77 package Bio::SearchIO::wise;
78 use vars qw(%MAPPING %MODEMAP $DEFAULT_WRITER_CLASS);
79 use strict;
81 # Object preamble - inherits from Bio::Root::Root
83 use base qw(Bio::SearchIO);
85 %MODEMAP = ('WiseOutput' => 'result',
86 'Hit' => 'hit',
87 'Hsp' => 'hsp'
89 %MAPPING =
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',
108 'Hit_id' => 'HIT-name',
109 # 'Hit_desc' => 'HIT-description',
110 # 'Hit_len' => 'HIT-length',
111 'Hit_score' => 'HIT-score',
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',
119 $DEFAULT_WRITER_CLASS = 'Bio::SearchIO::Writer::HitTableWriter';
122 use Bio::Tools::Genewise;
123 use Bio::Tools::Genomewise;
125 =head2 new
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
134 =cut
136 sub _initialize {
137 my ($self,@args) = @_;
138 my ( $wisetype, $file,$fh ) =
139 $self->_rearrange([qw(WISETYPE FILE FH)], @args);
140 my @newargs;
141 while( @args ) {
142 my $a = shift @args;
143 if( $a =~ /FILE|FH/i ) {
144 shift @args;
145 next;
147 push @newargs, $a, shift @args;
149 $self->SUPER::_initialize(@newargs);
151 # Optimization: caching the EventHandler
152 # since it's use a lot during the parse.
153 $self->{'_handler_cache'} = $self->_eventHandler;
155 $self->wisetype($wisetype);
156 my @ioargs;
157 if( $fh ) {
158 push @ioargs, ('-fh' => $fh);
159 } elsif( $file ) {
160 push @ioargs, ('-file' => $file);
163 if( $wisetype =~ /genewise/i ) {
164 $self->wise(Bio::Tools::Genewise->new(@ioargs));
165 } elsif( $wisetype =~ /genomewise/i ) {
166 $self->wise(Bio::Tools::Genomewise->new(@ioargs));
167 } else {
168 $self->throw("Must supply a -wisetype to ".ref($self)." which is one of 'genomewise' 'genewise'\n");
170 return $self;
174 =head2 next_result
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
182 =cut
184 sub next_result{
185 my ($self) = @_;
186 local $/ = "\n";
187 local $_;
189 return unless $self->wise;
190 my $prediction = $self->wise->next_prediction;
191 return unless $prediction;
192 $self->{'_reporttype'} = uc $self->wisetype;
193 $self->start_element({'Name' => 'WiseOutput'});
194 $self->element({'Name' => 'WiseOutput_program',
195 'Data' => $self->wisetype});
196 $self->element({'Name' => 'WiseOutput_query-def',
197 'Data' => $self->wise->_prot_id});
198 my @transcripts = $prediction->transcripts;
200 foreach my $transcript ( @transcripts ) {
201 my @exons = $transcript->exons;
202 my $protid;
203 $self->start_element({'Name' => 'Hit'});
205 if( $exons[0]->has_tag('supporting_feature') ) {
206 my ($supporting_feature) = $exons[0]->get_tag_values('supporting_feature');
207 $protid = $supporting_feature->feature2->seq_id;
208 $self->element({'Name' => 'Hit_id',
209 'Data' => $self->wise->_target_id});
211 $self->element({'Name' => 'Hit_score',
212 'Data' => $self->wise->_score});
213 foreach my $exon ( @exons ) {
214 $self->start_element({'Name' => 'Hsp'});
215 if( $exon->strand < 0 ) {
216 $self->element({'Name' => 'Hsp_query-from',
217 'Data' => $exon->end});
218 $self->element({'Name' => 'Hsp_query-to',
219 'Data' => $exon->start});
220 } else {
221 $self->element({'Name' => 'Hsp_query-from',
222 'Data' => $exon->start});
223 $self->element({'Name' => 'Hsp_query-to',
224 'Data' => $exon->end});
226 $self->element({'Name' => 'Hsp_score',
227 'Data' => $self->wise->_score});
228 if( $exon->has_tag('supporting_feature') ) {
229 my ($sf) = $exon->get_tag_values('supporting_feature');
230 my $protein = $sf->feature2;
231 if( $protein->strand < 0 ) {
232 $self->element({'Name' => 'Hsp_hit-from',
233 'Data' => $protein->end});
234 $self->element({'Name' => 'Hsp_hit-to',
235 'Data' => $protein->start});
236 } else {
237 $self->element({'Name' => 'Hsp_hit-from',
238 'Data' => $protein->start});
239 $self->element({'Name' => 'Hsp_hit-to',
240 'Data' => $protein->end});
243 $self->element({'Name' => 'Hsp_identity',
244 'Data' => 0});
245 $self->element({'Name' => 'Hsp_positive',
246 'Data' => 0});
247 $self->end_element({'Name' => 'Hsp'});
249 $self->end_element({'Name' => 'Hit'});
251 $self->end_element({'Name' => 'WiseOutput'});
252 return $self->end_document();
255 =head2 start_element
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'
264 =cut
266 sub start_element{
267 my ($self,$data) = @_;
268 # we currently don't care about attributes
269 my $nm = $data->{'Name'};
270 my $type = $MODEMAP{$nm};
272 if( $type ) {
273 if( $self->_eventHandler->will_handle($type) ) {
274 my $func = sprintf("start_%s",lc $type);
275 $self->_eventHandler->$func($data->{'Attributes'});
277 unshift @{$self->{'_elements'}}, $type;
279 if($type eq 'result') {
280 $self->{'_values'} = {};
281 $self->{'_result'}= undef;
287 =head2 end_element
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'
296 =cut
298 sub end_element {
299 my ($self,$data) = @_;
300 my $nm = $data->{'Name'};
301 my $type = $MODEMAP{$nm};
302 my $rc;
304 if( $type = $MODEMAP{$nm} ) {
305 if( $self->_eventHandler->will_handle($type) ) {
306 my $func = sprintf("end_%s",lc $type);
307 $rc = $self->_eventHandler->$func($self->{'_reporttype'},
308 $self->{'_values'});
310 shift @{$self->{'_elements'}};
312 } elsif( $MAPPING{$nm} ) {
314 if ( ref($MAPPING{$nm}) =~ /hash/i ) {
315 my $key = (keys %{$MAPPING{$nm}})[0];
316 $self->{'_values'}->{$key}->{$MAPPING{$nm}->{$key}} = $self->{'_last_data'};
317 } else {
318 $self->{'_values'}->{$MAPPING{$nm}} = $self->{'_last_data'};
320 } else {
321 $self->debug( "unknown nm $nm, ignoring\n");
323 $self->{'_last_data'} = ''; # remove read data if we are at
324 # end of an element
325 $self->{'_result'} = $rc if( defined $type && $type eq 'result' );
326 return $rc;
329 =head2 element
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'
338 =cut
340 sub element{
341 my ($self,$data) = @_;
342 $self->start_element($data);
343 $self->characters($data);
344 $self->end_element($data);
347 =head2 characters
349 Title : characters
350 Usage : $eventgenerator->characters($str)
351 Function: Send a character events
352 Returns : none
353 Args : string
356 =cut
358 sub characters{
359 my ($self,$data) = @_;
361 return unless ( defined $data->{'Data'} && $data->{'Data'} !~ /^\s+$/ );
363 $self->{'_last_data'} = $data->{'Data'};
366 =head2 within_element
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
377 =cut
379 sub within_element{
380 my ($self,$name) = @_;
381 return 0 if ( ! defined $name &&
382 ! defined $self->{'_elements'} ||
383 scalar @{$self->{'_elements'}} == 0) ;
384 foreach ( @{$self->{'_elements'}} ) {
385 if( $_ eq $name ) {
386 return 1;
389 return 0;
393 =head2 in_element
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
404 =cut
406 sub in_element{
407 my ($self,$name) = @_;
408 return 0 if ! defined $self->{'_elements'}->[0];
409 return ( $self->{'_elements'}->[0] eq $name)
412 =head2 start_document
414 Title : start_document
415 Usage : $eventgenerator->start_document
416 Function: Handle a start document event
417 Returns : none
418 Args : none
421 =cut
423 sub start_document{
424 my ($self) = @_;
425 $self->{'_lasttype'} = '';
426 $self->{'_values'} = {};
427 $self->{'_result'}= undef;
428 $self->{'_elements'} = [];
429 $self->{'_reporttype'} = 'exonerate';
433 =head2 end_document
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
442 =cut
444 sub end_document{
445 my ($self,@args) = @_;
446 return $self->{'_result'};
450 sub write_result {
451 my ($self, $blast, @args) = @_;
453 if( not defined($self->writer) ) {
454 $self->warn("Writer not defined. Using a $DEFAULT_WRITER_CLASS");
455 $self->writer( $DEFAULT_WRITER_CLASS->new() );
457 $self->SUPER::write_result( $blast, @args );
460 sub result_count {
461 my $self = shift;
462 return $self->{'_result_count'};
465 sub report_count { shift->result_count }
468 =head2 wise
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)
477 =cut
479 sub wise{
480 my $self = shift;
481 return $self->{'wise'} = shift if @_;
482 return $self->{'wise'};
485 =head2 wisetype
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)
494 =cut
496 sub wisetype{
497 my $self = shift;
499 return $self->{'wisetype'} = shift if @_;
500 return $self->{'wisetype'};