branch-1-6/Bio/SearchIO/wise.pm

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