4 # BioPerl module for Bio::Annotation::Collection.pm
6 # Cared for by Ewan Birney <birney@ebi.ac.uk>
8 # Copyright Ewan Birney
10 # You may distribute this module under the same terms as perl itself
12 # POD documentation - main docs before the code
16 Bio::Annotation::Collection - Default Perl implementation of AnnotationCollectionI
20 # get an AnnotationCollectionI somehow, eg
22 $ac = $seq->annotation();
24 foreach $key ( $ac->get_all_annotation_keys() ) {
25 @values = $ac->get_Annotations($key);
26 foreach $value ( @values ) {
27 # value is an Bio::AnnotationI, and defines a "as_text" method
28 print "Annotation ",$key," stringified value ",$value->as_text,"\n";
30 # also defined hash_tree method, which allows data orientated
31 # access into this object
32 $hash = $value->hash_tree();
38 Bioperl implementation for Bio::AnnotationCollecitonI
44 User feedback is an integral part of the evolution of this and other
45 Bioperl modules. Send your comments and suggestions preferably to one
46 of the Bioperl mailing lists. Your participation is much appreciated.
48 bioperl-l@bioperl.org - General discussion
49 http://bio.perl.org/MailList.html - About the mailing lists
53 Report bugs to the Bioperl bug tracking system to help us keep track
54 the bugs and their resolution. Bug reports can be submitted via email
57 bioperl-bugs@bioperl.org
58 http://bugzilla.bioperl.org/
60 =head1 AUTHOR - Ewan Birney
62 Email birney@ebi.ac.uk
66 The rest of the documentation details each of the object
67 methods. Internal methods are usually preceded with a _
72 # Let the code begin...
75 package Bio
::Annotation
::Collection
;
80 # Object preamble - inherits from Bio::Root::Root
82 use Bio::AnnotationCollectionI;
85 use Bio::Annotation::TypeManager;
86 use Bio::Annotation::SimpleValue;
89 @ISA = qw(Bio::Root::Root Bio::AnnotationCollectionI Bio::AnnotationI);
95 Usage : $coll = Bio::Annotation::Collection->new()
96 Function: Makes a new Annotation::Collection object.
97 Returns : Bio::Annotation::Collection
103 my ($class,@args) = @_;
105 my $self = $class->SUPER::new
(@args);
107 $self->{'_annotation'} = {};
108 $self->_typemap(Bio
::Annotation
::TypeManager
->new());
114 =head1 L<Bio::AnnotationCollectionI> implementing methods
118 =head2 get_all_annotation_keys
120 Title : get_all_annotation_keys
121 Usage : $ac->get_all_annotation_keys()
122 Function: gives back a list of annotation keys, which are simple text strings
123 Returns : list of strings
128 sub get_all_annotation_keys
{
130 return keys %{$self->{'_annotation'}};
133 =head2 get_Annotations
135 Title : get_Annotations
136 Usage : my @annotations = $collection->get_Annotations('key')
137 Function: Retrieves all the Bio::AnnotationI objects for one or more
140 If no key is given, returns all annotation objects.
142 The returned objects will have their tagname() attribute set to
143 the key under which they were attached, unless the tagname was
146 Returns : list of Bio::AnnotationI - empty if no objects stored for a key
147 Args : keys (list of strings) for annotations (optional)
152 my ($self,@keys) = @_;
155 @keys = $self->get_all_annotation_keys() unless @keys;
156 foreach my $key (@keys) {
157 if(exists($self->{'_annotation'}->{$key})) {
160 $_->tagname($key) if ! $_->tagname(); $_;
161 } @
{$self->{'_annotation'}->{$key}});
167 =head2 get_all_Annotations
169 Title : get_all_Annotations
171 Function: Similar to get_Annotations, but traverses and flattens nested
172 annotation collections. This means that collections in the
173 tree will be replaced by their components.
175 Keys will not be passed on to nested collections. I.e., if the
176 tag name of a nested collection matches the key, it will be
177 flattened in its entirety.
179 Hence, for un-nested annotation collections this will be identical
182 Returns : an array of L<Bio::AnnotationI> compliant objects
183 Args : keys (list of strings) for annotations (optional)
188 sub get_all_Annotations
{
189 my ($self,@keys) = @_;
192 $_->isa("Bio::AnnotationCollectionI") ?
193 $_->get_all_Annotations() : $_;
194 } $self->get_Annotations(@keys);
197 =head2 get_num_of_annotations
199 Title : get_num_of_annotations
200 Usage : my $count = $collection->get_num_of_annotations()
201 Function: Returns the count of all annotations stored in this collection
208 sub get_num_of_annotations
{
211 map { $count += scalar @
$_ } values %{$self->{'_annotation'}};
215 =head1 Implementation specific functions - mainly for adding
219 =head2 add_Annotation
221 Title : add_Annotation
222 Usage : $self->add_Annotation('reference',$object);
223 $self->add_Annotation($object,'Bio::MyInterface::DiseaseI');
224 $self->add_Annotation($object);
225 $self->add_Annotation('disease',$object,'Bio::MyInterface::DiseaseI');
226 Function: Adds an annotation for a specific key.
228 If the key is omitted, the object to be added must provide a value
231 If the archetype is provided, this and future objects added under
232 that tag have to comply with the archetype and will be rejected
236 Args : annotation key ('disease', 'dblink', ...)
237 object to store (must be Bio::AnnotationI compliant)
238 [optional] object archetype to map future storage of object
244 my ($self,$key,$object,$archetype) = @_;
246 # if there's no key we use the tagname() as key
247 if(ref($key) && $key->isa("Bio::AnnotationI") &&
248 (! ($object && ref($object)))) {
249 $archetype = $object if $object;
251 $key = $object->tagname();
252 $key = $key->name() if $key && ref($key); # OntologyTermI
253 $self->throw("Annotation object must have a tagname if key omitted")
257 if( !defined $object ) {
258 $self->throw("Must have at least key and object in add_Annotation");
262 $self->throw("Must add an object. Use Bio::Annotation::{Comment,SimpleValue,OntologyTerm} for simple text additions");
265 if( !$object->isa("Bio::AnnotationI") ) {
266 $self->throw("object must be AnnotationI compliant, otherwise we wont add it!");
269 # ok, now we are ready! If we don't have an archetype, set it
270 # from the type of the object
272 if( !defined $archetype ) {
273 $archetype = ref $object;
276 # check typemap, storing if needed.
277 my $stored_map = $self->_typemap->type_for_key($key);
279 if( defined $stored_map ) {
280 # check validity, irregardless of archetype. A little cheeky
281 # this means isa stuff is executed correctly
283 if( !$self->_typemap()->is_valid($key,$object) ) {
284 $self->throw("Object $object was not valid with key $key. If you were adding new keys in, perhaps you want to make use of the archetype method to allow registration to a more basic type");
287 $self->_typemap->_add_type_map($key,$archetype);
292 if( !defined $self->{'_annotation'}->{$key} ) {
293 $self->{'_annotation'}->{$key} = [];
296 push(@
{$self->{'_annotation'}->{$key}},$object);
301 =head2 remove_Annotations
303 Title : remove_Annotations
305 Function: Remove the annotations for the specified key from this collection.
307 Returns : an array Bio::AnnotationI compliant objects which were stored
308 under the given key(s)
309 Args : the key(s) (tag name(s), one or more strings) for which to
310 remove annotations (optional; if none given, flushes all
316 sub remove_Annotations
{
317 my ($self, @keys) = @_;
319 @keys = $self->get_all_annotation_keys() unless @keys;
320 my @anns = $self->get_Annotations(@keys);
323 delete $self->{'_annotation'}->{$_};
328 =head2 flatten_Annotations
330 Title : flatten_Annotations
332 Function: Flattens part or all of the annotations in this collection.
334 This is a convenience method for getting the flattened
335 annotation for the given keys, removing the annotation for
336 those keys, and adding back the flattened array.
338 This should not change anything for un-nested collections.
340 Returns : an array Bio::AnnotationI compliant objects which were stored
341 under the given key(s)
342 Args : list of keys (strings) the annotation for which to flatten,
343 defaults to all keys if not given
348 sub flatten_Annotations
{
349 my ($self,@keys) = @_;
351 my @anns = $self->get_all_Annotations(@keys);
352 my @origanns = $self->remove_Annotations(@keys);
354 $self->add_Annotation($_);
359 =head1 Bio::AnnotationI methods implementations
361 This is to allow nested annotation: you can a collection as an
362 annotation object to an annotation collection.
370 Function: See L<Bio::AnnotationI>
381 my $txt = "Collection consisting of ";
383 foreach my $ann ($self->get_Annotations()) {
384 push(@texts, $ann->as_text());
387 $txt .= join(", ", map { '['.$_.']'; } @texts);
389 $txt .= "no elements";
398 Function: See L<Bio::AnnotationI>
400 Returns : a hash reference
410 foreach my $key ($self->get_all_annotation_keys()) {
411 # all contained objects will support hash_tree()
412 # (they are AnnotationIs)
413 $tree->{$key} = [$self->get_Annotations($key)];
421 Usage : $obj->tagname($newval)
422 Function: Get/set the tagname for this annotation value.
424 Setting this is optional. If set, it obviates the need to
425 provide a tag to Bio::AnnotationCollectionI when adding
426 this object. When obtaining an AnnotationI object from the
427 collection, the collection will set the value to the tag
428 under which it was stored unless the object has a tag
432 Returns : value of tagname (a scalar)
433 Args : new value (a scalar, optional)
441 return $self->{'tagname'} = shift if @_;
442 return $self->{'tagname'};
446 =head1 Backward compatible functions
448 Functions put in for backward compatibility with old
449 Bio::Annotation.pm stuff
466 my ($self,$value) = @_;
468 $self->deprecated("Using old style annotation call on new Annotation::Collection object");
470 if( defined $value ) {
471 my $val = Bio
::Annotation
::SimpleValue
->new();
473 $self->add_Annotation('description',$val);
476 my ($desc) = $self->get_Annotations('description');
478 # If no description tag exists, do not attempt to call value on undef:
479 return $desc ?
$desc->value : undef;
485 Title : add_gene_name
496 my ($self,$value) = @_;
498 $self->deprecated("Old style add_gene_name called on new style Annotation::Collection");
500 my $val = Bio
::Annotation
::SimpleValue
->new();
502 $self->add_Annotation('gene_name',$val);
505 =head2 each_gene_name
507 Title : each_gene_name
520 $self->deprecated("Old style each_gene_name called on new style Annotation::Collection");
523 my @gene = $self->get_Annotations('gene_name');
525 foreach my $g ( @gene ) {
526 push(@out,$g->value);
534 Title : add_Reference
545 my ($self, @values) = @_;
547 $self->deprecated("add_Reference (old style Annotation) on new style Annotation::Collection");
549 # Allow multiple (or no) references to be passed, as per old method
550 foreach my $value (@values) {
551 $self->add_Annotation('reference',$value);
555 =head2 each_Reference
557 Title : each_Reference
570 $self->deprecated("each_Reference (old style Annotation) on new style Annotation::Collection");
572 return $self->get_Annotations('reference');
589 my ($self,$value) = @_;
591 $self->deprecated("add_Comment (old style Annotation) on new style Annotation::Collection");
593 $self->add_Annotation('comment',$value);
612 $self->deprecated("each_Comment (old style Annotation) on new style Annotation::Collection");
614 return $self->get_Annotations('comment');
632 my ($self,$value) = @_;
634 $self->deprecated("add_DBLink (old style Annotation) on new style Annotation::Collection");
636 $self->add_Annotation('dblink',$value);
655 $self->deprecated("each_DBLink (old style Annotation) on new style Annotation::Collection - use get_Annotations('dblink')");
657 return $self->get_Annotations('dblink');
662 =head1 Implementation management functions
669 Usage : $obj->_typemap($newval)
672 Returns : value of _typemap
673 Args : newvalue (optional)
679 my ($self,$value) = @_;
680 if( defined $value) {
681 $self->{'_typemap'} = $value;
683 return $self->{'_typemap'};