File Coverage

Bio/SeqFeature/AnnotationAdaptor.pm
Criterion Covered Total %
statement 71 91 78.0
branch 25 54 46.3
condition 10 24 41.6
subroutine 11 12 91.6
pod 9 9 100.0
total 126 190 66.3


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::SeqFeature::AnnotationAdaptor
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Hilmar Lapp
7             #
8             # Copyright Hilmar Lapp
9             #
10             # You may distribute this module under the same terms as perl itself
11              
12             #
13             # (c) Hilmar Lapp, hlapp at gmx.net, 2002.
14             # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
15             #
16             # You may distribute this module under the same terms as perl itself.
17             # Refer to the Perl Artistic License (see the license accompanying this
18             # software package, or see http://www.perl.com/language/misc/Artistic.html)
19             # for the terms under which you may use, modify, and redistribute this module.
20             #
21             # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
22             # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
23             # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
24             #
25              
26             # POD documentation - main docs before the code
27              
28             =head1 NAME
29              
30             Bio::SeqFeature::AnnotationAdaptor - integrates SeqFeatureIs annotation
31              
32             =head1 SYNOPSIS
33              
34             use Bio::SeqFeature::Generic;
35             use Bio::SeqFeature::AnnotationAdaptor;
36              
37             # obtain a SeqFeatureI implementing object somehow
38             my $feat = Bio::SeqFeature::Generic->new(-start => 10, -end => 20);
39              
40             # add tag/value annotation
41             $feat->add_tag_value("mytag", "value of tag mytag");
42             $feat->add_tag_value("mytag", "another value of tag mytag");
43              
44             # Bio::SeqFeature::Generic also provides annotation(), which returns a
45             # Bio::AnnotationCollectionI compliant object
46             $feat->annotation->add_Annotation("dbxref", $dblink);
47              
48             # to integrate tag/value annotation with AnnotationCollectionI
49             # annotation, use this adaptor, which also implements
50             # Bio::AnnotationCollectionI
51             my $anncoll = Bio::SeqFeature::AnnotationAdaptor->new(-feature => $feat);
52              
53             # this will now return tag/value pairs as
54             # Bio::Annotation::SimpleValue objects
55             my @anns = $anncoll->get_Annotations("mytag");
56             # other added before annotation is available too
57             my @dblinks = $anncoll->get_Annotations("dbxref");
58              
59             # also supports transparent adding of tag/value pairs in
60             # Bio::AnnotationI flavor
61             my $tagval = Bio::Annotation::SimpleValue->new(-value => "some value",
62             -tagname => "some tag");
63             $anncoll->add_Annotation($tagval);
64             # this is now also available from the feature's tag/value system
65             my @vals = $feat->get_tag_values("some tag");
66              
67             =head1 DESCRIPTION
68              
69             L defines light-weight annotation of features
70             through tag/value pairs. Conversely, L
71             together with L defines an annotation bag, which is
72             better typed, but more heavy-weight because it contains every single
73             piece of annotation as objects. The frequently used base
74             implementation of Bio::SeqFeatureI, Bio::SeqFeature::Generic, defines
75             an additional slot for AnnotationCollectionI-compliant annotation.
76              
77             This adaptor provides a L compliant,
78             unified, and integrated view on the annotation of L
79             objects, including tag/value pairs, and annotation through the
80             annotation() method, if the object supports it. Code using this
81             adaptor does not need to worry about the different ways of possibly
82             annotating a SeqFeatureI object, but can instead assume that it
83             strictly follows the AnnotationCollectionI scheme. The price to pay is
84             that retrieving and adding annotation will always use objects instead
85             of light-weight tag/value pairs.
86              
87             In other words, this adaptor allows us to keep the best of both
88             worlds. If you create tens of thousands of feature objects, and your
89             only annotation is tag/value pairs, you are best off using the
90             features' native tag/value system. If you create a smaller number of
91             features, but with rich and typed annotation mixed with tag/value
92             pairs, this adaptor may be for you. Since its implementation is by
93             double-composition, you only need to create one instance of the
94             adaptor. In order to transparently annotate a feature object, set the
95             feature using the feature() method. Every annotation you add will be
96             added to the feature object, and hence will not be lost when you set
97             feature() to the next object.
98              
99             =head1 FEEDBACK
100              
101             =head2 Mailing Lists
102              
103             User feedback is an integral part of the evolution of this and other
104             Bioperl modules. Send your comments and suggestions preferably to
105             the Bioperl mailing list. Your participation is much appreciated.
106              
107             bioperl-l@bioperl.org - General discussion
108             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
109              
110             =head2 Support
111              
112             Please direct usage questions or support issues to the mailing list:
113              
114             I
115              
116             rather than to the module maintainer directly. Many experienced and
117             reponsive experts will be able look at the problem and quickly
118             address it. Please include a thorough description of the problem
119             with code and data examples if at all possible.
120              
121             =head2 Reporting Bugs
122              
123             Report bugs to the Bioperl bug tracking system to help us keep track
124             of the bugs and their resolution. Bug reports can be submitted via the
125             web:
126              
127             https://github.com/bioperl/bioperl-live/issues
128              
129             =head1 AUTHOR - Hilmar Lapp
130              
131             Email hlapp at gmx.net
132              
133             =head1 APPENDIX
134              
135             The rest of the documentation details each of the object methods.
136             Internal methods are usually preceded with a _
137              
138             =cut
139              
140              
141             #' Let the code begin...
142              
143              
144             package Bio::SeqFeature::AnnotationAdaptor;
145 2     2   2004 use strict;
  2         4  
  2         55  
146              
147             # Object preamble - inherits from Bio::Root::Root
148              
149 2     2   10 use Bio::Annotation::SimpleValue;
  2         4  
  2         43  
150              
151 2     2   9 use base qw(Bio::Root::Root Bio::AnnotationCollectionI Bio::AnnotatableI);
  2         4  
  2         1757  
152              
153             =head2 new
154              
155             Title : new
156             Usage : my $obj = Bio::SeqFeature::AnnotationAdaptor->new();
157             Function: Builds a new Bio::SeqFeature::AnnotationAdaptor object
158             Returns : an instance of Bio::SeqFeature::AnnotationAdaptor
159             Args : Named parameters
160             -feature the Bio::SeqFeatureI implementing object to adapt
161             (mandatory to be passed here, or set via feature()
162             before calling other methods)
163             -annotation the Bio::AnnotationCollectionI implementing object
164             for storing richer annotation (this will default to
165             the $feature->annotation() if it supports it)
166             -tagvalue_factory the object factory to use for creating tag/value
167             pair representing objects
168              
169              
170             =cut
171              
172             sub new {
173 3     3 1 40 my($class,@args) = @_;
174              
175 3         27 my $self = $class->SUPER::new(@args);
176              
177 3         34 my ($feat,$anncoll,$fact) =
178             $self->_rearrange([qw(FEATURE
179             ANNOTATION
180             TAGVALUE_FACTORY)], @args);
181              
182 3 50       33 $self->feature($feat) if $feat;
183 3 50       22 $self->annotation($anncoll) if $feat;
184 3 50       13 $self->tagvalue_object_factory($fact) if $fact;
185              
186 3         12 return $self;
187             }
188              
189             =head2 feature
190              
191             Title : feature
192             Usage : $obj->feature($newval)
193             Function: Get/set the feature that this object adapts to an
194             AnnotationCollectionI.
195             Example :
196             Returns : value of feature (a Bio::SeqFeatureI compliant object)
197             Args : new value (a Bio::SeqFeatureI compliant object, optional)
198              
199              
200             =cut
201              
202             sub feature{
203 171     171 1 257 my ($self,$value) = @_;
204 171 100       300 if( defined $value) {
205 3         12 $self->{'feature'} = $value;
206             }
207 171         627 return $self->{'feature'};
208             }
209              
210             =head2 annotation
211              
212             Title : annotation
213             Usage : $obj->annotation($newval)
214             Function: Get/set the AnnotationCollectionI implementing object used by
215             this adaptor to store additional annotation that cannot be stored
216             by the SeqFeatureI itself.
217              
218             If requested before having been set, the value will default to the
219             annotation object of the feature if it has one.
220             Example :
221             Returns : value of annotation (a Bio::AnnotationCollectionI compliant object)
222             Args : new value (a Bio::AnnotationCollectionI compliant object, optional)
223              
224              
225             =cut
226              
227             sub annotation{
228 14     14 1 75 my ($self,$value) = @_;
229              
230 14 50       51 if( defined $value) {
231 0         0 $self->{'annotation'} = $value;
232             }
233 14 50 33     96 if((! exists($self->{'annotation'})) &&
234             $self->feature()->can('annotation')) {
235 14         46 return $self->feature()->annotation();
236             }
237 0         0 return $self->{'annotation'};
238             }
239              
240             =head1 AnnotationCollectionI implementing methods
241              
242             =cut
243              
244             =head2 get_all_annotation_keys
245              
246             Title : get_all_annotation_keys
247             Usage : $ac->get_all_annotation_keys()
248             Function: gives back a list of annotation keys, which are simple text strings
249             Returns : list of strings
250             Args : none
251              
252             =cut
253              
254             sub get_all_annotation_keys{
255 1     1 1 6 my ($self) = @_;
256 1         4 my @keys = ();
257              
258             # get the tags from the feature object
259 1 50       7 if ($self->feature()->can('get_all_tags')) {
260 1         5 push(@keys, $self->feature()->get_all_tags());
261             } else {
262 0         0 push(@keys, $self->feature()->all_tags());
263             }
264             # ask the annotation implementation in addition, while avoiding duplicates
265 1 50       8 if($self->annotation()) {
266             push(@keys,
267 1         5 grep { ! $self->feature->has_tag($_); }
  1         5  
268             $self->annotation()->get_all_annotation_keys());
269             }
270             # done
271 1         10 return @keys;
272             }
273              
274              
275             =head2 get_Annotations
276              
277             Title : get_Annotations
278             Usage : my @annotations = $collection->get_Annotations('key')
279             Function: Retrieves all the Bio::AnnotationI objects for a specific key
280             Returns : list of Bio::AnnotationI - empty if no objects stored for a key
281             Args : string which is key for annotations
282              
283             =cut
284              
285             sub get_Annotations{
286 3     3 1 1073 my ($self, @keys) = @_;
287 3         11 my @anns = ();
288              
289             # we need a annotation object factory
290 3         20 my $fact = $self->tagvalue_object_factory();
291              
292             # get all tags if no keys have been provided
293 3 50       18 @keys = $self->feature->all_tags() unless @keys;
294              
295             # build object for each value for each tag
296 3         11 foreach my $key (@keys) {
297             # protect against keys that aren't tags
298 3 50       16 next unless $self->feature->has_tag($key);
299             # add each tag/value pair as a SimpleValue object
300 3         15 foreach my $val ($self->feature()->get_tag_values($key)) {
301 5         14 my $ann;
302 5 50       50 if($fact) {
303 0         0 $ann = $fact->create_object(-value => $val, -tagname => $key);
304             } else {
305 5         43 $ann = Bio::Annotation::SimpleValue->new(-value => $val,
306             -tagname => $key);
307             }
308 5         27 push(@anns, $ann);
309             }
310             }
311              
312             # add what is in the annotation implementation if any
313 3 50       20 if($self->annotation()) {
314 3         16 push(@anns, $self->annotation->get_Annotations(@keys));
315             }
316              
317             # done
318 3         32 return @anns;
319             }
320              
321             =head2 get_num_of_annotations
322              
323             Title : get_num_of_annotations
324             Usage : my $count = $collection->get_num_of_annotations()
325             Function: Returns the count of all annotations stored in this collection
326             Returns : integer
327             Args : none
328              
329              
330             =cut
331              
332             sub get_num_of_annotations{
333 1     1 1 10 my ($self) = @_;
334              
335             # first, count the number of tags on the feature
336 1         4 my $num_anns = 0;
337              
338 1         6 foreach ($self->feature()->all_tags()) {
339 2         8 $num_anns += scalar( $self->feature()->get_tag_values($_));
340             }
341              
342             # add from the annotation implementation if any
343 1 50       7 if($self->annotation()) {
344 1         7 $num_anns += $self->annotation()->get_num_of_annotations();
345             }
346              
347             # done
348 1         12 return $num_anns;
349             }
350              
351             =head1 Implementation specific functions - to allow adding
352              
353             =cut
354              
355             =head2 add_Annotation
356              
357             Title : add_Annotation
358             Usage : $self->add_Annotation('reference',$object);
359             $self->add_Annotation($object,'Bio::MyInterface::DiseaseI');
360             $self->add_Annotation($object);
361             $self->add_Annotation('disease',$object,'Bio::MyInterface::DiseaseI');
362             Function: Adds an annotation for a specific key.
363              
364             If the key is omitted, the object to be added must provide a value
365             via its tagname().
366              
367             If the archetype is provided, this and future objects added under
368             that tag have to comply with the archetype and will be rejected
369             otherwise.
370              
371             This implementation will add all Bio::Annotation::SimpleValue
372             objects to the adapted features as tag/value pairs. Caveat: this
373             may potentially result in information loss if a derived object
374             is supplied.
375              
376             Returns : none
377             Args : annotation key ('disease', 'dblink', ...)
378             object to store (must be Bio::AnnotationI compliant)
379             [optional] object archetype to map future storage of object
380             of these types to
381              
382             =cut
383              
384             sub add_Annotation{
385 65     65 1 320 my ($self,$key,$object,$archetype) = @_;
386              
387             # if there's no key we use the tagname() as key
388 65 50 66     304 if(ref($key) && $key->isa("Bio::AnnotationI") &&
      33        
      66        
389             (! ($object && ref($object)))) {
390 64 50       105 $archetype = $object if $object;
391 64         67 $object = $key;
392 64         98 $key = $object->tagname();
393 64 50 33     172 $key = $key->name() if $key && ref($key); # OntologyTermI
394 64 50       91 $self->throw("Annotation object must have a tagname if key omitted")
395             unless $key;
396             }
397              
398 65 50       88 if( !defined $object ) {
399 0         0 $self->throw("Must have at least key and object in add_Annotation");
400             }
401              
402 65 50 33     227 if( ! (ref($object) && $object->isa("Bio::AnnotationI")) ) {
403 0         0 $self->throw("object must be a Bio::AnnotationI compliant object, otherwise we won't add it!");
404             }
405              
406             # ready to add -- if it's a SimpleValue, we add to the feature's tags,
407             # otherwise we'll add to the annotation collection implementation
408              
409 65 100 66     172 if($object->isa("Bio::Annotation::SimpleValue") &&
410             $self->feature()->can('add_tag_value')) {
411 64         95 return $self->feature()->add_tag_value($key, $object->value());
412             } else {
413 1         5 my $anncoll = $self->annotation();
414 1 50       6 if(! $anncoll) {
415 0         0 $anncoll = Bio::Annotation::Collection->new();
416 0         0 $self->annotation($anncoll);
417             }
418 1 50       15 if($anncoll->can('add_Annotation')) {
419 1         7 return $anncoll->add_Annotation($key,$object,$archetype);
420             }
421 0         0 $self->throw("Annotation implementation does not allow adding!");
422             }
423             }
424              
425             =head2 remove_Annotations
426              
427             Title : remove_Annotations
428             Usage :
429             Function: Remove the annotations for the specified key from this
430             collection.
431              
432             If the key happens to be a tag, then the tag is removed
433             from the feature.
434              
435             Example :
436             Returns : an array Bio::AnnotationI compliant objects which were stored
437             under the given key(s)
438             Args : the key(s) (tag name(s), one or more strings) for which to
439             remove annotations (optional; if none given, flushes all
440             annotations)
441              
442              
443             =cut
444              
445             sub remove_Annotations{
446 0     0 1 0 my ($self, @keys) = @_;
447              
448             # set to all keys if none are supplied
449 0 0       0 @keys = $self->get_all_annotation_keys() unless @keys;
450             # collect existing annotation
451 0         0 my @anns = $self->get_Annotations(@keys);
452             # flush
453 0         0 foreach my $key (@keys) {
454             # delete the tag if it is one
455 0 0       0 $self->feature->remove_tag($key) if $self->feature->has_tag($key);
456             # and delegate to the annotation implementation
457 0         0 my $anncoll = $self->annotation();
458 0 0 0     0 if($anncoll && $anncoll->can('remove_Annotations')) {
    0          
459 0         0 $anncoll->remove_Annotations($key);
460             } elsif($anncoll) {
461 0         0 $self->warn("Annotation bundle implementation ".ref($anncoll).
462             " does not allow remove!");
463             }
464             }
465 0         0 return @anns;
466             }
467              
468             =head1 Additional methods
469              
470             =cut
471              
472             =head2 tagvalue_object_factory
473              
474             Title : tagvalue_object_factory
475             Usage : $obj->tagval_object_factory($newval)
476             Function: Get/set the object factory to use for creating objects that
477             represent tag/value pairs (e.g.,
478             Bio::Annotation::SimpleValue).
479              
480             The object to be created is expected to follow
481             Bio::Annotation::SimpleValue in terms of supported
482             arguments at creation time, and the methods.
483              
484             Example :
485             Returns : A Bio::Factory::ObjectFactoryI compliant object
486             Args : new value (a Bio::Factory::ObjectFactoryI compliant object,
487             optional)
488              
489              
490             =cut
491              
492             sub tagvalue_object_factory{
493 3     3 1 11 my ($self,$value) = @_;
494 3 50       17 if( defined $value) {
495 0         0 $self->{'tagval_object_factory'} = $value;
496             }
497 3         15 return $self->{'tagval_object_factory'};
498             }
499              
500             1;