annotate variant_effect_predictor/Bio/Tools/Genscan.pm @ 1:d6778b5d8382 draft default tip

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