lib/Bio/Tools/Pseudowise.pm

   1 # BioPerl module for Bio::Tools::Pseudowise
   2 #
   3 #
   4 # Copyright Jason Stajich, Fugu Team
   5 #
   6 # You may distribute this module under the same terms as perl itself
   7
   8 # POD documentation - main docs before the code
   9
  10 =head1 NAME
  11
  12 Bio::Tools::Pseudowise - Results of one Pseudowise run
  13
  14 =head1 SYNOPSIS
  15
  16   use Bio::Tools::Pseudowise;
  17
  18   my $parser = Bio::Tools::Pseudowise->new(-file=>"pw.out");
  19   while(my $feat = $parser->next_result){
  20       push @feat, $feat;
  21   }
  22
  23 =head1 DESCRIPTION
  24
  25 Pseudowise is a pseudogene prediction program written by Ewan Birney
  26 as part of the Wise Package. This module is the parser for the output
  27 of the program.
  28
  29 http://www.sanger.ac.uk/software/wise2
  30
  31 =head1 FEEDBACK
  32
  33 =head2 Mailing Lists
  34
  35 User feedback is an integral part of the evolution of this and other
  36 Bioperl modules. Send your comments and suggestions preferably to one
  37 of the Bioperl mailing lists.  Your participation is much appreciated.
  38
  39   bioperl-l@bioperl.org                  - General discussion
  40   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  41
  42 =head2 Support
  43
  44 Please direct usage questions or support issues to the mailing list:
  45
  46 I<bioperl-l@bioperl.org>
  47
  48 rather than to the module maintainer directly. Many experienced and
  49 reponsive experts will be able look at the problem and quickly
  50 address it. Please include a thorough description of the problem
  51 with code and data examples if at all possible.
  52
  53 =head2 Reporting Bugs
  54
  55 Report bugs to the Bioperl bug tracking system to help us keep track
  56 the bugs and their resolution.  Bug reports can be submitted via the
  57 web:
  58
  59   https://github.com/bioperl/bioperl-live/issues
  60
  61 =head1 AUTHOR - Jason Stajich
  62
  63 Previous committed by the Fugu Team
  64
  65 Re-written by Jason Stajich 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::Tools::Pseudowise;
  79
  80 use strict;
  81 use Symbol;
  82
  83 use Bio::Root::Root;
  84 use Bio::SeqFeature::Generic;
  85 use Bio::SeqFeature::Gene::Exon;
  86 use Bio::SeqFeature::FeaturePair;
  87 use Bio::SeqFeature::Gene::Transcript;
  88 use Bio::SeqFeature::Gene::GeneStructure;
  89
  90 use base qw(Bio::Tools::AnalysisResult);
  91
  92 sub _initialize_state {
  93     my ($self,@args) = @_;
  94
  95     # first call the inherited method!
  96     $self->SUPER::_initialize_state(@args);
  97
  98     # our private state variables
  99     $self->{'_preds_parsed'} = 0;
 100     $self->{'_has_cds'} = 0;
 101     # array of pre-parsed predictions
 102     $self->{'_preds'} = [];
 103     # seq stack
 104     $self->{'_seqstack'} = [];
 105 }
 106
 107 =head2 analysis_method
 108
 109  Usage     : $pseudowise->analysis_method();
 110  Purpose   : Inherited method. Overridden to ensure that the name matches
 111              /pseudowise/i.
 112  Returns   : String
 113  Argument  : n/a
 114
 115 =cut
 116
 117 #-------------
 118 sub analysis_method {
 119 #-------------
 120     my ($self, $method) = @_;
 121     if($method && ($method !~ /pseudowise/i)) {
 122         $self->throw("method $method not supported in " . ref($self));
 123     }
 124     return $self->SUPER::analysis_method($method);
 125 }
 126
 127 =head2 next_feature
 128
 129  Title   : next_feature
 130  Usage   : $seqfeature = $obj->next_feature();
 131  Function: Returns the next feature available in the analysis result, or
 132            undef if there are no more features.
 133  Example :
 134  Returns : A Bio::SeqFeatureI implementing object, or undef if there are no
 135            more features.
 136  Args    : none
 137
 138 See Also  L<Bio::SeqFeatureI>
 139
 140 =cut
 141
 142 sub next_feature {
 143     return shift->next_prediction(@_);
 144 }
 145
 146
 147 =head2 next_prediction
 148
 149  Title   : next_prediction
 150  Usage   : while($gene = $pseudowise->next_prediction()) {
 151                   # do something
 152            }
 153  Function: Returns the gene of the Pseudowise result
 154            file. Call this method repeatedly until FALSE is returned.
 155
 156  Example :
 157  Returns : a Bio::SeqFeature::Generic
 158  Args    : none
 159
 160 See Also L<Bio::SeqFeature::Generic>
 161
 162 =cut
 163
 164 sub next_prediction {
 165     my ($self) = @_;
 166     # if the prediction section hasn't been parsed yet, we do this now
 167     $self->_parse_predictions unless $self->_predictions_parsed;
 168
 169     # get next gene structure
 170     return $self->_prediction();
 171 }
 172
 173 =head2 _parse_predictions
 174
 175  Title   : _parse_predictions()
 176  Usage   : $obj->_parse_predictions()
 177  Function: Parses the prediction section. Automatically called by
 178            next_prediction() if not yet done.
 179  Example :
 180  Returns :
 181
 182 =cut
 183
 184 sub _parse_predictions {
 185     my ($self) = @_;
 186     my $gene;
 187     my @genes;
 188
 189     local $/= "\n";
 190     local($_);
 191     my %tags;
 192     while (defined( $_ = $self->_readline)){
 193         if( /^(Total codons|\S+)\s+:\s+(\S+)/ ) {
 194             $tags{$1} = $2;
 195         } elsif(m!^//! ) {
 196             if( $gene ) {
 197                 $gene = undef;
 198                 %tags = ();
 199             }
 200         } elsif (/Gene\s+(\d+)\s*$/i) {
 201             $gene = Bio::SeqFeature::Generic->new
 202                 ( -primary => 'pseudogene',
 203                   -source  => 'pseudowise',
 204                   -tag     => \%tags);
 205             push @genes, $gene;
 206         } elsif( /Gene\s+(\d+)\s+(\d+)/i ) {
 207             if( $1 < $2 ) {
 208                 $gene->start($1);
 209                 $gene->end($2);
 210                 $gene->strand(1);
 211             } else {
 212                 $gene->start($2);
 213                 $gene->end($1);
 214                 $gene->strand(-1);
 215             }
 216         } elsif (/Exon\s+(\d+)\s+(\d+)\s+phase\s+(\S+)/i) {
 217             my ($s,$e,$st) = ($1,$2,1);
 218             if( $s > $e) {
 219                 ($s,$e,$st)=($e,$s,-1);
 220             }
 221             my $exon = Bio::SeqFeature::Generic->new
 222                 ( -start   => $s,
 223                   -end     => $e,
 224                   -strand  => $st,
 225                   -primary => 'exon',
 226                   -source  => 'pseudowise',
 227                   -tag     => {'frame'  => $3});
 228             $gene->add_sub_SeqFeature($exon);
 229         }
 230     }
 231     $self->_add_prediction(\@genes);
 232     $self->_predictions_parsed(1);
 233 }
 234
 235 =head1 _prediction
 236
 237  Title   : _prediction()
 238  Usage   : $gene = $obj->_prediction()
 239  Function: internal
 240  Example :
 241  Returns :
 242
 243 =cut
 244
 245 sub _prediction {
 246     my ($self) = @_;
 247     return shift(@{$self->{'_preds'} || []});
 248 }
 249
 250 =head2 _add_prediction
 251
 252  Title   : _add_prediction()
 253  Usage   : $obj->_add_prediction($gene)
 254  Function: internal
 255  Example :
 256  Returns :
 257
 258 =cut
 259
 260 sub _add_prediction {
 261     my ($self, $gene) = @_;
 262     $self->{'_preds'} ||= [];
 263
 264     if( ref($gene) =~ /ARRAY/ ) {
 265         push(@{$self->{'_preds'}}, @$gene);
 266     } else {
 267         push(@{$self->{'_preds'}}, $gene);
 268     }
 269 }
 270
 271 =head2 _predictions_parsed
 272
 273  Title   : _predictions_parsed
 274  Usage   : $obj->_predictions_parsed
 275  Function: internal
 276  Example :
 277  Returns : TRUE or FALSE
 278
 279 =cut
 280
 281 sub _predictions_parsed {
 282     my ($self, $val) = @_;
 283
 284     $self->{'_preds_parsed'} = $val if $val;
 285     if(! exists($self->{'_preds_parsed'})) {
 286         $self->{'_preds_parsed'} = 0;
 287     }
 288     return $self->{'_preds_parsed'};
 289 }
 290
 291 1;