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 use strict;
  80 use Symbol;
  81
  82 use Bio::Root::Root;
  83 use Bio::SeqFeature::Generic;
  84 use Bio::SeqFeature::Gene::Exon;
  85 use Bio::SeqFeature::FeaturePair;
  86 use Bio::SeqFeature::Gene::Transcript;
  87 use Bio::SeqFeature::Gene::GeneStructure;
  88
  89 use base qw(Bio::Tools::AnalysisResult);
  90
  91 sub _initialize_state {
  92     my ($self,@args) = @_;
  93
  94     # first call the inherited method!
  95     $self->SUPER::_initialize_state(@args);
  96
  97     # our private state variables
  98     $self->{'_preds_parsed'} = 0;
  99     $self->{'_has_cds'} = 0;
 100     # array of pre-parsed predictions
 101     $self->{'_preds'} = [];
 102     # seq stack
 103     $self->{'_seqstack'} = [];
 104 }
 105
 106 =head2 analysis_method
 107
 108  Usage     : $pseudowise->analysis_method();
 109  Purpose   : Inherited method. Overridden to ensure that the name matches
 110              /pseudowise/i.
 111  Returns   : String
 112  Argument  : n/a
 113
 114 =cut
 115
 116 #-------------
 117 sub analysis_method {
 118 #-------------
 119     my ($self, $method) = @_;
 120     if($method && ($method !~ /pseudowise/i)) {
 121         $self->throw("method $method not supported in " . ref($self));
 122     }
 123     return $self->SUPER::analysis_method($method);
 124 }
 125
 126 =head2 next_feature
 127
 128  Title   : next_feature
 129  Usage   : $seqfeature = $obj->next_feature();
 130  Function: Returns the next feature available in the analysis result, or
 131            undef if there are no more features.
 132  Example :
 133  Returns : A Bio::SeqFeatureI implementing object, or undef if there are no
 134            more features.
 135  Args    : none
 136
 137 See Also  L<Bio::SeqFeatureI>
 138
 139 =cut
 140
 141 sub next_feature {
 142     return shift->next_prediction(@_);
 143 }
 144
 145
 146 =head2 next_prediction
 147
 148  Title   : next_prediction
 149  Usage   : while($gene = $pseudowise->next_prediction()) {
 150                   # do something
 151            }
 152  Function: Returns the gene of the Pseudowise result
 153            file. Call this method repeatedly until FALSE is returned.
 154
 155  Example :
 156  Returns : a Bio::SeqFeature::Generic
 157  Args    : none
 158
 159 See Also L<Bio::SeqFeature::Generic>
 160
 161 =cut
 162
 163 sub next_prediction {
 164     my ($self) = @_;
 165     # if the prediction section hasn't been parsed yet, we do this now
 166     $self->_parse_predictions unless $self->_predictions_parsed;
 167
 168     # get next gene structure
 169     return $self->_prediction();
 170 }
 171
 172 =head2 _parse_predictions
 173
 174  Title   : _parse_predictions()
 175  Usage   : $obj->_parse_predictions()
 176  Function: Parses the prediction section. Automatically called by
 177            next_prediction() if not yet done.
 178  Example :
 179  Returns :
 180
 181 =cut
 182
 183 sub _parse_predictions {
 184     my ($self) = @_;
 185     my $gene;
 186     my @genes;
 187
 188     local $/= "\n";
 189     local($_);
 190     my %tags;
 191     while (defined( $_ = $self->_readline)){
 192         if( /^(Total codons|\S+)\s+:\s+(\S+)/ ) {
 193             $tags{$1} = $2;
 194         } elsif(m!^//! ) {
 195             if( $gene ) {
 196                 $gene = undef;
 197                 %tags = ();
 198             }
 199         } elsif (/Gene\s+(\d+)\s*$/i) {
 200             $gene = Bio::SeqFeature::Generic->new
 201                 ( -primary => 'pseudogene',
 202                   -source  => 'pseudowise',
 203                   -tag     => \%tags);
 204             push @genes, $gene;
 205         } elsif( /Gene\s+(\d+)\s+(\d+)/i ) {
 206             if( $1 < $2 ) {
 207                 $gene->start($1);
 208                 $gene->end($2);
 209                 $gene->strand(1);
 210             } else {
 211                 $gene->start($2);
 212                 $gene->end($1);
 213                 $gene->strand(-1);
 214             }
 215         } elsif (/Exon\s+(\d+)\s+(\d+)\s+phase\s+(\S+)/i) {
 216             my ($s,$e,$st) = ($1,$2,1);
 217             if( $s > $e) {
 218                 ($s,$e,$st)=($e,$s,-1);
 219             }
 220             my $exon = Bio::SeqFeature::Generic->new
 221                 ( -start   => $s,
 222                   -end     => $e,
 223                   -strand  => $st,
 224                   -primary => 'exon',
 225                   -source  => 'pseudowise',
 226                   -tag     => {'frame'  => $3});
 227             $gene->add_sub_SeqFeature($exon);
 228         }
 229     }
 230     $self->_add_prediction(\@genes);
 231     $self->_predictions_parsed(1);
 232 }
 233
 234 =head1 _prediction
 235
 236  Title   : _prediction()
 237  Usage   : $gene = $obj->_prediction()
 238  Function: internal
 239  Example :
 240  Returns :
 241
 242 =cut
 243
 244 sub _prediction {
 245     my ($self) = @_;
 246     return shift(@{$self->{'_preds'} || []});
 247 }
 248
 249 =head2 _add_prediction
 250
 251  Title   : _add_prediction()
 252  Usage   : $obj->_add_prediction($gene)
 253  Function: internal
 254  Example :
 255  Returns :
 256
 257 =cut
 258
 259 sub _add_prediction {
 260     my ($self, $gene) = @_;
 261     $self->{'_preds'} ||= [];
 262
 263     if( ref($gene) =~ /ARRAY/ ) {
 264         push(@{$self->{'_preds'}}, @$gene);
 265     } else {
 266         push(@{$self->{'_preds'}}, $gene);
 267     }
 268 }
 269
 270 =head2 _predictions_parsed
 271
 272  Title   : _predictions_parsed
 273  Usage   : $obj->_predictions_parsed
 274  Function: internal
 275  Example :
 276  Returns : TRUE or FALSE
 277
 278 =cut
 279
 280 sub _predictions_parsed {
 281     my ($self, $val) = @_;
 282
 283     $self->{'_preds_parsed'} = $val if $val;
 284     if(! exists($self->{'_preds_parsed'})) {
 285         $self->{'_preds_parsed'} = 0;
 286     }
 287     return $self->{'_preds_parsed'};
 288 }
 289
 290 1;