|
0
|
1 # $Id: FTHelper.pm,v 1.55 2002/11/05 02:55:12 lapp Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::SeqIO::FTHelper
|
|
|
4 #
|
|
|
5 # Cared for by Ewan Birney <birney@ebi.ac.uk>
|
|
|
6 #
|
|
|
7 # Copyright Ewan Birney
|
|
|
8 #
|
|
|
9 # You may distribute this module under the same terms as perl itself
|
|
|
10
|
|
|
11 # POD documentation - main docs before the code
|
|
|
12
|
|
|
13 =head1 NAME
|
|
|
14
|
|
|
15 Bio::SeqIO::FTHelper - Helper class for Embl/Genbank feature tables
|
|
|
16
|
|
|
17 =head1 SYNOPSIS
|
|
|
18
|
|
|
19 Used by Bio::SeqIO::EMBL to help process the Feature Table
|
|
|
20
|
|
|
21 =head1 DESCRIPTION
|
|
|
22
|
|
|
23 Represents one particular Feature with the following fields
|
|
|
24
|
|
|
25 key - the key of the feature
|
|
|
26 loc - the location string of the feature
|
|
|
27 <other fields> - other fields
|
|
|
28
|
|
|
29 =head1 FEEDBACK
|
|
|
30
|
|
|
31 =head2 Mailing Lists
|
|
|
32
|
|
|
33 User feedback is an integral part of the evolution of this and other
|
|
|
34 Bioperl modules. Send your comments and suggestions preferably to one
|
|
|
35 of the Bioperl mailing lists. Your participation is much appreciated.
|
|
|
36
|
|
|
37 bioperl-l@bioperl.org - General discussion
|
|
|
38 http://www.bioperl.org/MailList.shtml - About the mailing lists
|
|
|
39
|
|
|
40 =head2 Reporting Bugs
|
|
|
41
|
|
|
42 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
|
43 the bugs and their resolution. Bug reports can be submitted via email
|
|
|
44 or the web:
|
|
|
45
|
|
|
46 bioperl-bugs@bio.perl.org
|
|
|
47 http://bugzilla.bioperl.org/
|
|
|
48
|
|
|
49 =head1 AUTHOR - Ewan Birney
|
|
|
50
|
|
|
51 Email birney@ebi.ac.uk
|
|
|
52
|
|
|
53 Describe contact details here
|
|
|
54
|
|
|
55 =head1 CONTRIBUTORS
|
|
|
56
|
|
|
57 Jason Stajich jason@bioperl.org
|
|
|
58
|
|
|
59 =head1 APPENDIX
|
|
|
60
|
|
|
61 The rest of the documentation details each of the object
|
|
|
62 methods. Internal methods are usually preceded with a _
|
|
|
63
|
|
|
64 =cut
|
|
|
65
|
|
|
66
|
|
|
67 # Let the code begin...
|
|
|
68
|
|
|
69
|
|
|
70 package Bio::SeqIO::FTHelper;
|
|
|
71 use vars qw(@ISA);
|
|
|
72 use strict;
|
|
|
73
|
|
|
74 use Bio::SeqFeature::Generic;
|
|
|
75 use Bio::Location::Simple;
|
|
|
76 use Bio::Location::Fuzzy;
|
|
|
77 use Bio::Location::Split;
|
|
|
78
|
|
|
79
|
|
|
80 use Bio::Root::Root;
|
|
|
81
|
|
|
82 @ISA = qw(Bio::Root::Root);
|
|
|
83
|
|
|
84 sub new {
|
|
|
85 my ($class, @args) = @_;
|
|
|
86
|
|
|
87 # no chained new because we make lots and lots of these.
|
|
|
88 my $self = {};
|
|
|
89 bless $self,$class;
|
|
|
90 $self->{'_field'} = {};
|
|
|
91 return $self;
|
|
|
92 }
|
|
|
93
|
|
|
94 =head2 _generic_seqfeature
|
|
|
95
|
|
|
96 Title : _generic_seqfeature
|
|
|
97 Usage : $fthelper->_generic_seqfeature($annseq, "GenBank")
|
|
|
98 Function: processes fthelper into a generic seqfeature
|
|
|
99 Returns : TRUE on success and otherwise FALSE
|
|
|
100 Args : The Bio::Factory::LocationFactoryI object to use for parsing
|
|
|
101 location strings. The ID (e.g., display_id) of the sequence on which
|
|
|
102 this feature is located, optionally a string indicating the source
|
|
|
103 (GenBank/EMBL/SwissProt)
|
|
|
104
|
|
|
105
|
|
|
106 =cut
|
|
|
107
|
|
|
108 sub _generic_seqfeature {
|
|
|
109 my ($fth, $locfac, $seqid, $source) = @_;
|
|
|
110 my ($sf);
|
|
|
111
|
|
|
112 # set a default if not specified
|
|
|
113 if(! defined($source)) {
|
|
|
114 $source = "EMBL/GenBank/SwissProt";
|
|
|
115 }
|
|
|
116
|
|
|
117 # initialize feature object
|
|
|
118 $sf = Bio::SeqFeature::Generic->direct_new();
|
|
|
119
|
|
|
120 # parse location; this may cause an exception, in which case we gently
|
|
|
121 # recover and ignore this feature
|
|
|
122 my $loc;
|
|
|
123 eval {
|
|
|
124 $loc = $locfac->from_string($fth->loc);
|
|
|
125 };
|
|
|
126 if(! $loc) {
|
|
|
127 $fth->warn("exception while parsing location line [" . $fth->loc .
|
|
|
128 "] in reading $source, ignoring feature " .
|
|
|
129 $fth->key() . " (seqid=" . $seqid . "): " . $@);
|
|
|
130 return;
|
|
|
131 }
|
|
|
132
|
|
|
133 # set additional location attributes
|
|
|
134 if($seqid && (! $loc->is_remote())) {
|
|
|
135 $loc->seq_id($seqid); # propagates if it is a split location
|
|
|
136 }
|
|
|
137
|
|
|
138 # set attributes of feature
|
|
|
139 $sf->location($loc);
|
|
|
140 $sf->primary_tag($fth->key);
|
|
|
141 $sf->source_tag($source);
|
|
|
142 foreach my $key ( keys %{$fth->field} ){
|
|
|
143 foreach my $value ( @{$fth->field->{$key}} ) {
|
|
|
144 $sf->add_tag_value($key,$value);
|
|
|
145 }
|
|
|
146 }
|
|
|
147 return $sf;
|
|
|
148 }
|
|
|
149
|
|
|
150
|
|
|
151 =head2 from_SeqFeature
|
|
|
152
|
|
|
153 Title : from_SeqFeature
|
|
|
154 Usage : @fthelperlist = Bio::SeqIO::FTHelper::from_SeqFeature($sf,
|
|
|
155 $context_annseq);
|
|
|
156 Function: constructor of fthelpers from SeqFeatures
|
|
|
157 :
|
|
|
158 : The additional annseq argument is to allow the building of FTHelper
|
|
|
159 : lines relevant to particular sequences (ie, when features are spread over
|
|
|
160 : enteries, knowing how to build this)
|
|
|
161 Returns : an array of FThelpers
|
|
|
162 Args : seq features
|
|
|
163
|
|
|
164
|
|
|
165 =cut
|
|
|
166
|
|
|
167 sub from_SeqFeature {
|
|
|
168 my ($sf, $context_annseq) = @_;
|
|
|
169 my @ret;
|
|
|
170
|
|
|
171 #
|
|
|
172 # If this object knows how to make FThelpers, then let it
|
|
|
173 # - this allows us to store *really* weird objects that can write
|
|
|
174 # themselves to the EMBL/GenBank...
|
|
|
175 #
|
|
|
176
|
|
|
177 if ( $sf->can("to_FTHelper") ) {
|
|
|
178 return $sf->to_FTHelper($context_annseq);
|
|
|
179 }
|
|
|
180
|
|
|
181 my $fth = Bio::SeqIO::FTHelper->new();
|
|
|
182 my $key = $sf->primary_tag();
|
|
|
183 my $locstr = $sf->location->to_FTstring;
|
|
|
184
|
|
|
185 # ES 25/06/01 Commented out this code, Jason to double check
|
|
|
186 #The location FT string for all simple subseqfeatures is already
|
|
|
187 #in the Split location FT string
|
|
|
188
|
|
|
189 # going into sub features
|
|
|
190 #foreach my $sub ( $sf->sub_SeqFeature() ) {
|
|
|
191 #my @subfth = &Bio::SeqIO::FTHelper::from_SeqFeature($sub);
|
|
|
192 #push(@ret, @subfth);
|
|
|
193 #}
|
|
|
194
|
|
|
195 $fth->loc($locstr);
|
|
|
196 $fth->key($key);
|
|
|
197 $fth->field->{'note'} = [];
|
|
|
198 #$sf->source_tag && do { push(@{$fth->field->{'note'}},"source=" . $sf->source_tag ); };
|
|
|
199
|
|
|
200 ($sf->can('score') && $sf->score) && do { push(@{$fth->field->{'note'}},
|
|
|
201 "score=" . $sf->score ); };
|
|
|
202 ($sf->can('frame') && $sf->frame) && do { push(@{$fth->field->{'note'}},
|
|
|
203 "frame=" . $sf->frame ); };
|
|
|
204 #$sf->strand && do { push(@{$fth->field->{'note'}},"strand=" . $sf->strand ); };
|
|
|
205
|
|
|
206 foreach my $tag ( $sf->all_tags ) {
|
|
|
207 # Tags which begin with underscores are considered
|
|
|
208 # private, and are therefore not printed
|
|
|
209 next if $tag =~ /^_/;
|
|
|
210 if ( !defined $fth->field->{$tag} ) {
|
|
|
211 $fth->field->{$tag} = [];
|
|
|
212 }
|
|
|
213 foreach my $val ( $sf->each_tag_value($tag) ) {
|
|
|
214 push(@{$fth->field->{$tag}},$val);
|
|
|
215 }
|
|
|
216 }
|
|
|
217 push(@ret, $fth);
|
|
|
218
|
|
|
219 unless (@ret) {
|
|
|
220 $context_annseq->throw("Problem in processing seqfeature $sf - no fthelpers. Error!");
|
|
|
221 }
|
|
|
222 foreach my $ft (@ret) {
|
|
|
223 if ( !$ft->isa('Bio::SeqIO::FTHelper') ) {
|
|
|
224 $sf->throw("Problem in processing seqfeature $sf - made a $fth!");
|
|
|
225 }
|
|
|
226 }
|
|
|
227
|
|
|
228 return @ret;
|
|
|
229
|
|
|
230 }
|
|
|
231
|
|
|
232
|
|
|
233 =head2 key
|
|
|
234
|
|
|
235 Title : key
|
|
|
236 Usage : $obj->key($newval)
|
|
|
237 Function:
|
|
|
238 Example :
|
|
|
239 Returns : value of key
|
|
|
240 Args : newvalue (optional)
|
|
|
241
|
|
|
242
|
|
|
243 =cut
|
|
|
244
|
|
|
245 sub key {
|
|
|
246 my ($obj, $value) = @_;
|
|
|
247 if ( defined $value ) {
|
|
|
248 $obj->{'key'} = $value;
|
|
|
249 }
|
|
|
250 return $obj->{'key'};
|
|
|
251
|
|
|
252 }
|
|
|
253
|
|
|
254 =head2 loc
|
|
|
255
|
|
|
256 Title : loc
|
|
|
257 Usage : $obj->loc($newval)
|
|
|
258 Function:
|
|
|
259 Example :
|
|
|
260 Returns : value of loc
|
|
|
261 Args : newvalue (optional)
|
|
|
262
|
|
|
263
|
|
|
264 =cut
|
|
|
265
|
|
|
266 sub loc {
|
|
|
267 my ($obj, $value) = @_;
|
|
|
268 if ( defined $value ) {
|
|
|
269 $obj->{'loc'} = $value;
|
|
|
270 }
|
|
|
271 return $obj->{'loc'};
|
|
|
272 }
|
|
|
273
|
|
|
274
|
|
|
275 =head2 field
|
|
|
276
|
|
|
277 Title : field
|
|
|
278 Usage :
|
|
|
279 Function:
|
|
|
280 Example :
|
|
|
281 Returns :
|
|
|
282 Args :
|
|
|
283
|
|
|
284
|
|
|
285 =cut
|
|
|
286
|
|
|
287 sub field {
|
|
|
288 my ($self) = @_;
|
|
|
289
|
|
|
290 return $self->{'_field'};
|
|
|
291 }
|
|
|
292
|
|
|
293 =head2 add_field
|
|
|
294
|
|
|
295 Title : add_field
|
|
|
296 Usage :
|
|
|
297 Function:
|
|
|
298 Example :
|
|
|
299 Returns :
|
|
|
300 Args :
|
|
|
301
|
|
|
302
|
|
|
303 =cut
|
|
|
304
|
|
|
305 sub add_field {
|
|
|
306 my ($self, $key, $val) = @_;
|
|
|
307
|
|
|
308 if ( !exists $self->field->{$key} ) {
|
|
|
309 $self->field->{$key} = [];
|
|
|
310 }
|
|
|
311 push( @{$self->field->{$key}} , $val);
|
|
|
312
|
|
|
313 }
|
|
|
314
|
|
|
315 1;
|
