Bio/SearchIO/wise.pm

   1 #
   2 # BioPerl module for Bio::SearchIO::wise
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason-at-bioperl-dot-org>
   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<bioperl-l@bioperl.org>
  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://redmine.open-bio.org/projects/bioperl/
  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 use vars qw(%MAPPING %MODEMAP $DEFAULT_WRITER_CLASS);
  79 use strict;
  80
  81 # Object preamble - inherits from Bio::Root::Root
  82
  83 use base qw(Bio::SearchIO);
  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 use Bio::Tools::Genewise;
 123 use Bio::Tools::Genomewise;
 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     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;
 146         }
 147         push @newargs, $a, shift @args;
 148     }
 149     $self->SUPER::_initialize(@newargs);
 150
 151     # Optimization: caching the EventHandler
 152     # since it's use a lot during the parse.
 153     $self->{'_handler_cache'} = $self->_eventHandler;
 154
 155     $self->wisetype($wisetype);
 156     my @ioargs;
 157     if( $fh ) {
 158         push @ioargs, ('-fh' => $fh);
 159     } elsif( $file ) {
 160         push @ioargs, ('-file' => $file);
 161     }
 162
 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");
 169     }
 170     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    my ($self) = @_;
 186    local $/ = "\n";
 187    local $_;
 188
 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;
 199
 200    foreach my $transcript ( @transcripts ) {
 201        my @exons =  $transcript->exons;
 202        my $protid;
 203        $self->start_element({'Name' => 'Hit'});
 204
 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});
 210        }
 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});
 225            }
 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});
 241                }
 242            }
 243            $self->element({'Name' => 'Hsp_identity',
 244                            'Data' => 0});
 245            $self->element({'Name' => 'Hsp_positive',
 246                            'Data' => 0});
 247            $self->end_element({'Name' => 'Hsp'});
 248        }
 249        $self->end_element({'Name' => 'Hit'});
 250    }
 251    $self->end_element({'Name' => 'WiseOutput'});
 252    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    my ($self,$data) = @_;
 268    # we currently don't care about attributes
 269    my $nm = $data->{'Name'};
 270    my $type = $MODEMAP{$nm};
 271
 272    if( $type ) {
 273        if( $self->_eventHandler->will_handle($type) ) {
 274            my $func = sprintf("start_%s",lc $type);
 275            $self->_eventHandler->$func($data->{'Attributes'});
 276        }
 277        unshift @{$self->{'_elements'}}, $type;
 278
 279        if($type eq 'result') {
 280            $self->{'_values'} = {};
 281            $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     my ($self,$data) = @_;
 300     my $nm = $data->{'Name'};
 301     my $type = $MODEMAP{$nm};
 302     my $rc;
 303
 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'});
 309         }
 310         shift @{$self->{'_elements'}};
 311
 312     } elsif( $MAPPING{$nm} ) {
 313
 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'};
 319         }
 320     } else {
 321         $self->debug( "unknown nm $nm, ignoring\n");
 322     }
 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;
 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    my ($self,$data) = @_;
 342    $self->start_element($data);
 343    $self->characters($data);
 344    $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    my ($self,$data) = @_;
 360
 361    return unless ( defined $data->{'Data'} && $data->{'Data'} !~ /^\s+$/ );
 362
 363    $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    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;
 387        }
 388    }
 389    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    my ($self,$name) = @_;
 408    return 0 if ! defined $self->{'_elements'}->[0];
 409    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     my ($self) = @_;
 425     $self->{'_lasttype'} = '';
 426     $self->{'_values'} = {};
 427     $self->{'_result'}= undef;
 428     $self->{'_elements'} = [];
 429     $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    my ($self,@args) = @_;
 446    return $self->{'_result'};
 447 }
 448
 449
 450 sub write_result {
 451    my ($self, $blast, @args) = @_;
 452
 453    if( not defined($self->writer) ) {
 454        $self->warn("Writer not defined. Using a $DEFAULT_WRITER_CLASS");
 455        $self->writer( $DEFAULT_WRITER_CLASS->new() );
 456    }
 457    $self->SUPER::write_result( $blast, @args );
 458 }
 459
 460 sub result_count {
 461     my $self = shift;
 462     return $self->{'_result_count'};
 463 }
 464
 465 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     my $self = shift;
 481     return $self->{'wise'} = shift if @_;
 482     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     my $self = shift;
 498
 499     return $self->{'wisetype'} = shift if @_;
 500     return $self->{'wisetype'};
 501 }
 502
 503 1;