annotate variant_effect_predictor/Bio/Tools/Genscan.pm @ 3:d30fa12e4cc5 default tip

Merge heads 2:a5976b2dce6f and 1:09613ce8151e which were created as a result of a recently fixed bug.
author devteam <devteam@galaxyproject.org>
date Mon, 13 Jan 2014 10:38:30 -0500
parents 1f6dce3d34e0
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
1 # $Id: Genscan.pm,v 1.22 2002/10/22 07:38:46 lapp Exp $
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
2 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
3 # BioPerl module for Bio::Tools::Genscan
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
4 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
5 # Cared for by Hilmar Lapp <hlapp@gmx.net>
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
6 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
7 # Copyright Hilmar Lapp
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
8 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
9 # You may distribute this module under the same terms as perl itself
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
10
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
11 # POD documentation - main docs before the code
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
12
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
13 =head1 NAME
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
14
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
15 Bio::Tools::Genscan - Results of one Genscan run
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
16
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
17 =head1 SYNOPSIS
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
18
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
19 $genscan = Bio::Tools::Genscan->new(-file => 'result.genscan');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
20 # filehandle:
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
21 $genscan = Bio::Tools::Genscan->new( -fh => \*INPUT );
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
22
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
23 # parse the results
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
24 # note: this class is-a Bio::Tools::AnalysisResult which implements
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
25 # Bio::SeqAnalysisParserI, i.e., $genscan->next_feature() is the same
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
26 while($gene = $genscan->next_prediction()) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
27 # $gene is an instance of Bio::Tools::Prediction::Gene, which inherits
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
28 # off Bio::SeqFeature::Gene::Transcript.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
29 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
30 # $gene->exons() returns an array of
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
31 # Bio::Tools::Prediction::Exon objects
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
32 # all exons:
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
33 @exon_arr = $gene->exons();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
34
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
35 # initial exons only
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
36 @init_exons = $gene->exons('Initial');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
37 # internal exons only
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
38 @intrl_exons = $gene->exons('Internal');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
39 # terminal exons only
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
40 @term_exons = $gene->exons('Terminal');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
41 # singleton exons:
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
42 ($single_exon) = $gene->exons();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
43 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
44
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
45 # essential if you gave a filename at initialization (otherwise the file
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
46 # will stay open)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
47 $genscan->close();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
48
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
49 =head1 DESCRIPTION
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
50
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
51 The Genscan module provides a parser for Genscan gene structure prediction
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
52 output. It parses one gene prediction into a Bio::SeqFeature::Gene::Transcript-
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
53 derived object.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
54
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
55 This module also implements the Bio::SeqAnalysisParserI interface, and thus
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
56 can be used wherever such an object fits. See L<Bio::SeqAnalysisParserI>.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
57
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
58 =head1 FEEDBACK
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
59
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
60 =head2 Mailing Lists
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
61
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
62 User feedback is an integral part of the evolution of this and other
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
63 Bioperl modules. Send your comments and suggestions preferably to one
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
64 of the Bioperl mailing lists. Your participation is much appreciated.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
65
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
66 bioperl-l@bioperl.org - General discussion
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
67 http://bio.perl.org/MailList.html - About the mailing lists
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
68
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
69 =head2 Reporting Bugs
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
70
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
71 Report bugs to the Bioperl bug tracking system to help us keep track
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
72 the bugs and their resolution. Bug reports can be submitted via email
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
73 or the web:
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
74
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
75 bioperl-bugs@bio.perl.org
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
76 http://bugzilla.bioperl.org/
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
77
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
78 =head1 AUTHOR - Hilmar Lapp
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
79
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
80 Email hlapp@gmx.net
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
81
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
82 Describe contact details here
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
83
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
84 =head1 APPENDIX
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
85
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
86 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
87
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
88 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
89
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
90
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
91 # Let the code begin...
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
92
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
93
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
94 package Bio::Tools::Genscan;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
95 use vars qw(@ISA);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
96 use strict;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
97 use Symbol;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
98
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
99 use Bio::Root::Root;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
100 use Bio::Tools::AnalysisResult;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
101 use Bio::Tools::Prediction::Gene;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
102 use Bio::Tools::Prediction::Exon;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
103
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
104 @ISA = qw(Bio::Tools::AnalysisResult);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
105
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
106 sub _initialize_state {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
107 my ($self,@args) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
108
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
109 # first call the inherited method!
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
110 $self->SUPER::_initialize_state(@args);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
111
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
112 # our private state variables
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
113 $self->{'_preds_parsed'} = 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
114 $self->{'_has_cds'} = 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
115 # array of pre-parsed predictions
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
116 $self->{'_preds'} = [];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
117 # seq stack
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
118 $self->{'_seqstack'} = [];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
119 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
120
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
121 =head2 analysis_method
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
122
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
123 Usage : $genscan->analysis_method();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
124 Purpose : Inherited method. Overridden to ensure that the name matches
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
125 /genscan/i.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
126 Returns : String
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
127 Argument : n/a
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
128
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
129 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
130
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
131 #-------------
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
132 sub analysis_method {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
133 #-------------
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
134 my ($self, $method) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
135 if($method && ($method !~ /genscan/i)) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
136 $self->throw("method $method not supported in " . ref($self));
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
137 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
138 return $self->SUPER::analysis_method($method);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
139 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
140
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
141 =head2 next_feature
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
142
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
143 Title : next_feature
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
144 Usage : while($gene = $genscan->next_feature()) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
145 # do something
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
146 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
147 Function: Returns the next gene structure prediction of the Genscan result
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
148 file. Call this method repeatedly until FALSE is returned.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
149
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
150 The returned object is actually a SeqFeatureI implementing object.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
151 This method is required for classes implementing the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
152 SeqAnalysisParserI interface, and is merely an alias for
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
153 next_prediction() at present.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
154
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
155 Example :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
156 Returns : A Bio::Tools::Prediction::Gene object.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
157 Args :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
158
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
159 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
160
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
161 sub next_feature {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
162 my ($self,@args) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
163 # even though next_prediction doesn't expect any args (and this method
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
164 # does neither), we pass on args in order to be prepared if this changes
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
165 # ever
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
166 return $self->next_prediction(@args);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
167 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
168
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
169 =head2 next_prediction
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
170
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
171 Title : next_prediction
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
172 Usage : while($gene = $genscan->next_prediction()) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
173 # do something
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
174 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
175 Function: Returns the next gene structure prediction of the Genscan result
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
176 file. Call this method repeatedly until FALSE is returned.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
177
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
178 Example :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
179 Returns : A Bio::Tools::Prediction::Gene object.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
180 Args :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
181
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
182 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
183
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
184 sub next_prediction {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
185 my ($self) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
186 my $gene;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
187
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
188 # if the prediction section hasn't been parsed yet, we do this now
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
189 $self->_parse_predictions() unless $self->_predictions_parsed();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
190
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
191 # get next gene structure
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
192 $gene = $self->_prediction();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
193
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
194 if($gene) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
195 # fill in predicted protein, and if available the predicted CDS
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
196 #
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
197 my ($id, $seq);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
198 # use the seq stack if there's a seq on it
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
199 my $seqobj = pop(@{$self->{'_seqstack'}});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
200 if(! $seqobj) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
201 # otherwise read from input stream
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
202 ($id, $seq) = $self->_read_fasta_seq();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
203 # there may be no sequence at all, or none any more
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
204 if($id && $seq) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
205 $seqobj = Bio::PrimarySeq->new('-seq' => $seq,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
206 '-display_id' => $id,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
207 '-alphabet' => "protein");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
208 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
209 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
210 if($seqobj) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
211 # check that prediction number matches the prediction number
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
212 # indicated in the sequence id (there may be incomplete gene
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
213 # predictions that contain only signals with no associated protein
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
214 # and CDS, like promoters, poly-A sites etc)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
215 $gene->primary_tag() =~ /[^0-9]([0-9]+)$/;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
216 my $prednr = $1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
217 if($seqobj->display_id() !~ /_predicted_\w+_$prednr\|/) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
218 # this is not our sequence, so push back for next prediction
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
219 push(@{$self->{'_seqstack'}}, $seqobj);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
220 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
221 $gene->predicted_protein($seqobj);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
222 # CDS prediction, too?
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
223 if($self->_has_cds()) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
224 ($id, $seq) = $self->_read_fasta_seq();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
225 $seqobj = Bio::PrimarySeq->new('-seq' => $seq,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
226 '-display_id' => $id,
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
227 '-alphabet' => "dna");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
228 $gene->predicted_cds($seqobj);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
229 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
230 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
231 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
232 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
233
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
234 return $gene;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
235 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
236
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
237 =head2 _parse_predictions
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
238
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
239 Title : _parse_predictions()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
240 Usage : $obj->_parse_predictions()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
241 Function: Parses the prediction section. Automatically called by
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
242 next_prediction() if not yet done.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
243 Example :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
244 Returns :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
245
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
246 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
247
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
248 sub _parse_predictions {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
249 my ($self) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
250 my %exontags = ('Init' => 'Initial',
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
251 'Intr' => 'Internal',
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
252 'Term' => 'Terminal',
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
253 'Sngl' => '');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
254 my $gene;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
255 my $seqname;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
256
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
257 while(defined($_ = $self->_readline())) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
258 if(/^\s*(\d+)\.(\d+)/) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
259 # exon or signal
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
260 my $prednr = $1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
261 my $signalnr = $2; # not used presently
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
262 if(! defined($gene)) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
263 $gene = Bio::Tools::Prediction::Gene->new(
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
264 '-primary' => "GenePrediction$prednr",
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
265 '-source' => 'Genscan');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
266 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
267 # split into fields
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
268 chomp();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
269 my @flds = split(' ', $_);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
270 # create the feature object depending on the type of signal
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
271 my $predobj;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
272 my $is_exon = grep {$_ eq $flds[1];} (keys(%exontags));
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
273 if($is_exon) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
274 $predobj = Bio::Tools::Prediction::Exon->new();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
275 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
276 # PolyA site, or Promoter
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
277 $predobj = Bio::SeqFeature::Generic->new();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
278 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
279 # set common fields
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
280 $predobj->source_tag('Genscan');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
281 $predobj->score($flds[$#flds]);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
282 $predobj->strand((($flds[2] eq '+') ? 1 : -1));
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
283 my ($start, $end) = @flds[(3,4)];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
284 if($predobj->strand() == 1) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
285 $predobj->start($start);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
286 $predobj->end($end);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
287 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
288 $predobj->end($start);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
289 $predobj->start($end);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
290 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
291 # add to gene structure (should be done only when start and end
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
292 # are set, in order to allow for proper expansion of the range)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
293 if($is_exon) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
294 # first, set fields unique to exons
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
295 $predobj->start_signal_score($flds[8]);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
296 $predobj->end_signal_score($flds[9]);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
297 $predobj->coding_signal_score($flds[10]);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
298 $predobj->significance($flds[11]);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
299 $predobj->primary_tag($exontags{$flds[1]} . 'Exon');
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
300 $predobj->is_coding(1);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
301 # Figure out the frame of this exon. This is NOT the frame
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
302 # given by Genscan, which is the absolute frame of the base
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
303 # starting the first predicted complete codon. By comparing
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
304 # to the absolute frame of the first base we can compute the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
305 # offset of the first complete codon to the first base of the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
306 # exon, which determines the frame of the exon.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
307 my $cod_offset;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
308 if($predobj->strand() == 1) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
309 $cod_offset = $flds[6] - (($predobj->start()-1) % 3);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
310 # Possible values are -2, -1, 0, 1, 2. -1 and -2 correspond
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
311 # to offsets 2 and 1, resp. Offset 3 is the same as 0.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
312 $cod_offset += 3 if($cod_offset < 1);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
313 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
314 # On the reverse strand the Genscan frame also refers to
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
315 # the first base of the first complete codon, but viewed
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
316 # from forward, which is the third base viewed from
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
317 # reverse.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
318 $cod_offset = $flds[6] - (($predobj->end()-3) % 3);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
319 # Possible values are -2, -1, 0, 1, 2. Due to the reverse
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
320 # situation, {2,-1} and {1,-2} correspond to offsets
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
321 # 1 and 2, resp. Offset 3 is the same as 0.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
322 $cod_offset -= 3 if($cod_offset >= 0);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
323 $cod_offset = -$cod_offset;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
324 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
325 # Offsets 2 and 1 correspond to frame 1 and 2 (frame of exon
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
326 # is the frame of the first base relative to the exon, or the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
327 # number of bases the first codon is missing).
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
328 $predobj->frame(3 - $cod_offset);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
329 # then add to gene structure object
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
330 $gene->add_exon($predobj, $exontags{$flds[1]});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
331 } elsif($flds[1] eq 'PlyA') {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
332 $predobj->primary_tag("PolyAsite");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
333 $gene->poly_A_site($predobj);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
334 } elsif($flds[1] eq 'Prom') {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
335 $predobj->primary_tag("Promoter");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
336 $gene->add_promoter($predobj);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
337 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
338 next;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
339 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
340 if(/^\s*$/ && defined($gene)) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
341 # current gene is completed
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
342 $gene->seq_id($seqname);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
343 $self->_add_prediction($gene);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
344 $gene = undef;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
345 next;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
346 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
347 if(/^(GENSCAN)\s+(\S+)/) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
348 $self->analysis_method($1);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
349 $self->analysis_method_version($2);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
350 next;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
351 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
352 if(/^Sequence\s+(\S+)\s*:/) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
353 $seqname = $1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
354 next;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
355 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
356
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
357 if(/^Parameter matrix:\s+(\S+)/i) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
358 $self->analysis_subject($1);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
359 next;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
360 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
361
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
362 if(/^Predicted coding/) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
363 $self->_has_cds(1);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
364 next;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
365 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
366 /^>/ && do {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
367 # section of predicted sequences
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
368 $self->_pushback($_);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
369 last;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
370 };
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
371 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
372 $self->_predictions_parsed(1);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
373 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
374
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
375 =head2 _prediction
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
376
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
377 Title : _prediction()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
378 Usage : $gene = $obj->_prediction()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
379 Function: internal
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
380 Example :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
381 Returns :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
382
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
383 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
384
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
385 sub _prediction {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
386 my ($self) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
387
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
388 return undef unless(exists($self->{'_preds'}) && @{$self->{'_preds'}});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
389 return shift(@{$self->{'_preds'}});
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
390 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
391
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
392 =head2 _add_prediction
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
393
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
394 Title : _add_prediction()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
395 Usage : $obj->_add_prediction($gene)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
396 Function: internal
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
397 Example :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
398 Returns :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
399
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
400 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
401
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
402 sub _add_prediction {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
403 my ($self, $gene) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
404
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
405 if(! exists($self->{'_preds'})) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
406 $self->{'_preds'} = [];
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
407 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
408 push(@{$self->{'_preds'}}, $gene);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
409 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
410
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
411 =head2 _predictions_parsed
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
412
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
413 Title : _predictions_parsed
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
414 Usage : $obj->_predictions_parsed
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
415 Function: internal
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
416 Example :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
417 Returns : TRUE or FALSE
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
418
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
419 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
420
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
421 sub _predictions_parsed {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
422 my ($self, $val) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
423
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
424 $self->{'_preds_parsed'} = $val if $val;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
425 if(! exists($self->{'_preds_parsed'})) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
426 $self->{'_preds_parsed'} = 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
427 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
428 return $self->{'_preds_parsed'};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
429 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
430
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
431 =head2 _has_cds
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
432
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
433 Title : _has_cds()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
434 Usage : $obj->_has_cds()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
435 Function: Whether or not the result contains the predicted CDSs, too.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
436 Example :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
437 Returns : TRUE or FALSE
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
438
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
439 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
440
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
441 sub _has_cds {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
442 my ($self, $val) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
443
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
444 $self->{'_has_cds'} = $val if $val;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
445 if(! exists($self->{'_has_cds'})) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
446 $self->{'_has_cds'} = 0;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
447 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
448 return $self->{'_has_cds'};
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
449 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
450
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
451 =head2 _read_fasta_seq
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
452
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
453 Title : _read_fasta_seq()
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
454 Usage : ($id,$seqstr) = $obj->_read_fasta_seq();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
455 Function: Simple but specialised FASTA format sequence reader. Uses
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
456 $self->_readline() to retrieve input, and is able to strip off
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
457 the traling description lines.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
458 Example :
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
459 Returns : An array of two elements.
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
460
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
461 =cut
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
462
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
463 sub _read_fasta_seq {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
464 my ($self) = @_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
465 my ($id, $seq);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
466 local $/ = ">";
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
467
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
468 my $entry = $self->_readline();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
469 if($entry) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
470 $entry =~ s/^>//;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
471 # complete the entry if the first line came from a pushback buffer
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
472 while($entry !~ />$/) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
473 last unless $_ = $self->_readline();
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
474 $entry .= $_;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
475 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
476 # delete everything onwards from an intervening empty line (at the
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
477 # end there might be statistics stuff)
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
478 $entry =~ s/\n\n.*$//s;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
479 # id and sequence
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
480 if($entry =~ /^(\S+)\n([^>]+)/) {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
481 $id = $1;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
482 $seq = $2;
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
483 } else {
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
484 $self->throw("Can't parse Genscan predicted sequence entry");
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
485 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
486 $seq =~ s/\s//g; # Remove whitespace
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
487 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
488 return ($id, $seq);
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
489 }
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
490
1f6dce3d34e0 Uploaded
mahtabm
parents:
diff changeset
491 1;