3 # BioPerl module for Bio::Annotation::Collection.pm
5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
7 # Cared for by Ewan Birney <birney@ebi.ac.uk>
9 # Copyright Ewan Birney
11 # You may distribute this module under the same terms as perl itself
13 # POD documentation - main docs before the code
17 Bio::Annotation::Collection - Default Perl implementation of
22 # get an AnnotationCollectionI somehow, eg
24 $ac = $seq->annotation();
26 foreach $key ( $ac->get_all_annotation_keys() ) {
27 @values = $ac->get_Annotations($key);
28 foreach $value ( @values ) {
29 # value is an Bio::AnnotationI, and defines a "as_text" method
30 print "Annotation ",$key," stringified value ",$value->as_text,"\n";
32 # also defined hash_tree method, which allows data orientated
33 # access into this object
34 $hash = $value->hash_tree();
40 Bioperl implementation for Bio::AnnotationCollectionI
46 User feedback is an integral part of the evolution of this and other
47 Bioperl modules. Send your comments and suggestions preferably to one
48 of the Bioperl mailing lists. Your participation is much appreciated.
50 bioperl-l@bioperl.org - General discussion
51 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
55 Please direct usage questions or support issues to the mailing list:
57 I<bioperl-l@bioperl.org>
59 rather than to the module maintainer directly. Many experienced and
60 reponsive experts will be able look at the problem and quickly
61 address it. Please include a thorough description of the problem
62 with code and data examples if at all possible.
66 Report bugs to the Bioperl bug tracking system to help us keep track
67 the bugs and their resolution. Bug reports can be submitted via
70 http://bugzilla.open-bio.org/
72 =head1 AUTHOR - Ewan Birney
74 Email birney@ebi.ac.uk
78 The rest of the documentation details each of the object
79 methods. Internal methods are usually preceded with a _
84 # Let the code begin...
87 package Bio
::Annotation
::Collection
;
91 # Object preamble - inherits from Bio::Root::Root
93 use Bio
::Annotation
::TypeManager
;
94 use Bio
::Annotation
::SimpleValue
;
97 use base
qw(Bio::Root::Root Bio::AnnotationCollectionI Bio::AnnotationI);
103 Usage : $coll = Bio::Annotation::Collection->new()
104 Function: Makes a new Annotation::Collection object.
105 Returns : Bio::Annotation::Collection
111 my ($class,@args) = @_;
113 my $self = $class->SUPER::new
(@args);
115 $self->{'_annotation'} = {};
116 $self->_typemap(Bio
::Annotation
::TypeManager
->new());
122 =head1 L<Bio::AnnotationCollectionI> implementing methods
126 =head2 get_all_annotation_keys
128 Title : get_all_annotation_keys
129 Usage : $ac->get_all_annotation_keys()
130 Function: gives back a list of annotation keys, which are simple text strings
131 Returns : list of strings
136 sub get_all_annotation_keys
{
138 return keys %{$self->{'_annotation'}};
141 =head2 get_Annotations
143 Title : get_Annotations
144 Usage : my @annotations = $collection->get_Annotations('key')
145 Function: Retrieves all the Bio::AnnotationI objects for one or more
148 If no key is given, returns all annotation objects.
150 The returned objects will have their tagname() attribute set to
151 the key under which they were attached, unless the tagname was
154 Returns : list of Bio::AnnotationI - empty if no objects stored for a key
155 Args : keys (list of strings) for annotations (optional)
160 my ($self,@keys) = @_;
163 @keys = $self->get_all_annotation_keys() unless @keys;
164 foreach my $key (@keys) {
165 if(exists($self->{'_annotation'}->{$key})) {
168 $_->tagname($key) if ! $_->tagname(); $_;
169 } @
{$self->{'_annotation'}->{$key}});
176 =head2 get_nested_Annotations
178 Title : get_nested_Annotations
179 Usage : my @annotations = $collection->get_nested_Annotations(
182 Function: Retrieves all the Bio::AnnotationI objects for one or more
183 specific key(s). If -recursive is set to true, traverses the nested
184 annotation collections recursively and returns all annotations
187 If no key is given, returns all annotation objects.
189 The returned objects will have their tagname() attribute set to
190 the key under which they were attached, unless the tagname was
193 Returns : list of Bio::AnnotationI - empty if no objects stored for a key
194 Args : -keys => arrayref of keys to search for (optional)
195 -recursive => boolean, whether or not to recursively traverse the
196 nested annotations and return annotations with matching keys.
200 sub get_nested_Annotations
{
201 my ($self, @args) = @_;
202 my ($keys, $recursive) = $self->_rearrange([qw(KEYS RECURSIVE)], @args);
206 # if not recursive behave exactly like get_Annotations()
208 my @keys = $keys? @
$keys : $self->get_all_annotation_keys();
209 foreach my $key (@keys) {
210 if(exists($self->{'_annotation'}->{$key})) {
213 $_->tagname($key) if ! $_->tagname(); $_;
214 } @
{$self->{'_annotation'}->{$key}});
218 # if recursive search for keys recursively
220 my @allkeys = $self->get_all_annotation_keys();
221 foreach my $key (@allkeys) {
223 foreach my $searchkey (@
$keys) {
224 if ($key eq $searchkey) { $keymatch = 1;}
227 if(exists($self->{'_annotation'}->{$key})) {
230 $_->tagname($key) if ! $_->tagname(); $_;
231 } @
{$self->{'_annotation'}->{$key}});
235 my @annotations = @
{$self->{'_annotation'}->{$key}};
236 foreach (@annotations) {
237 if ($_->isa("Bio::AnnotationCollectionI")) {
239 $_->get_nested_Annotations('-keys' => $keys, '-recursive' => 1)
249 =head2 get_all_Annotations
251 Title : get_all_Annotations
253 Function: Similar to get_Annotations, but traverses and flattens nested
254 annotation collections. This means that collections in the
255 tree will be replaced by their components.
257 Keys will not be passed on to nested collections. I.e., if the
258 tag name of a nested collection matches the key, it will be
259 flattened in its entirety.
261 Hence, for un-nested annotation collections this will be identical
264 Returns : an array of L<Bio::AnnotationI> compliant objects
265 Args : keys (list of strings) for annotations (optional)
270 sub get_all_Annotations
{
271 my ($self,@keys) = @_;
274 $_->isa("Bio::AnnotationCollectionI") ?
275 $_->get_all_Annotations() : $_;
276 } $self->get_Annotations(@keys);
280 =head2 get_num_of_annotations
282 Title : get_num_of_annotations
283 Usage : my $count = $collection->get_num_of_annotations()
284 Function: Returns the count of all annotations stored in this collection
291 sub get_num_of_annotations
{
294 map { $count += scalar @
$_ } values %{$self->{'_annotation'}};
298 =head1 Implementation specific functions - mainly for adding
302 =head2 add_Annotation
304 Title : add_Annotation
305 Usage : $self->add_Annotation('reference',$object);
306 $self->add_Annotation($object,'Bio::MyInterface::DiseaseI');
307 $self->add_Annotation($object);
308 $self->add_Annotation('disease',$object,'Bio::MyInterface::DiseaseI');
309 Function: Adds an annotation for a specific key.
311 If the key is omitted, the object to be added must provide a value
314 If the archetype is provided, this and future objects added under
315 that tag have to comply with the archetype and will be rejected
319 Args : annotation key ('disease', 'dblink', ...)
320 object to store (must be Bio::AnnotationI compliant)
321 [optional] object archetype to map future storage of object
327 my ($self,$key,$object,$archetype) = @_;
329 # if there's no key we use the tagname() as key
330 if(ref($key) && $key->isa("Bio::AnnotationI") && (!ref($object))) {
331 $archetype = $object if defined($object);
333 $key = $object->tagname();
334 $key = $key->name() if ref($key); # OntologyTermI
335 $self->throw("Annotation object must have a tagname if key omitted")
339 if( !defined $object ) {
340 $self->throw("Must have at least key and object in add_Annotation");
344 $self->throw("Must add an object. Use Bio::Annotation::{Comment,SimpleValue,OntologyTerm} for simple text additions");
347 if( !$object->isa("Bio::AnnotationI") ) {
348 $self->throw("object must be AnnotationI compliant, otherwise we won't add it!");
351 # ok, now we are ready! If we don't have an archetype, set it
352 # from the type of the object
354 if( !defined $archetype ) {
355 $archetype = ref $object;
358 # check typemap, storing if needed.
359 my $stored_map = $self->_typemap->type_for_key($key);
361 if( defined $stored_map ) {
362 # check validity, irregardless of archetype. A little cheeky
363 # this means isa stuff is executed correctly
365 if( !$self->_typemap()->is_valid($key,$object) ) {
366 $self->throw("Object $object was not valid with key $key. ".
367 "If you were adding new keys in, perhaps you want to make use\n".
368 "of the archetype method to allow registration to a more basic type");
371 $self->_typemap->_add_type_map($key,$archetype);
376 if( !defined $self->{'_annotation'}->{$key} ) {
377 $self->{'_annotation'}->{$key} = [];
380 push(@
{$self->{'_annotation'}->{$key}},$object);
385 =head2 remove_Annotations
387 Title : remove_Annotations
389 Function: Remove the annotations for the specified key from this collection.
391 Returns : an array Bio::AnnotationI compliant objects which were stored
392 under the given key(s)
393 Args : the key(s) (tag name(s), one or more strings) for which to
394 remove annotations (optional; if none given, flushes all
400 sub remove_Annotations
{
401 my ($self, @keys) = @_;
403 @keys = $self->get_all_annotation_keys() unless @keys;
404 my @anns = $self->get_Annotations(@keys);
406 foreach my $key (@keys) {
407 delete $self->{'_annotation'}->{$key};
408 delete $self->{'_typemap'}->{'_type'}->{$key};
413 =head2 flatten_Annotations
415 Title : flatten_Annotations
417 Function: Flattens part or all of the annotations in this collection.
419 This is a convenience method for getting the flattened
420 annotation for the given keys, removing the annotation for
421 those keys, and adding back the flattened array.
423 This should not change anything for un-nested collections.
425 Returns : an array Bio::AnnotationI compliant objects which were stored
426 under the given key(s)
427 Args : list of keys (strings) the annotation for which to flatten,
428 defaults to all keys if not given
433 sub flatten_Annotations
{
434 my ($self,@keys) = @_;
436 my @anns = $self->get_all_Annotations(@keys);
437 my @origanns = $self->remove_Annotations(@keys);
439 $self->add_Annotation($_);
444 =head1 Bio::AnnotationI methods implementations
446 This is to allow nested annotation: you can use a collection as an
447 annotation object for an annotation collection.
455 Function: See L<Bio::AnnotationI>
466 my $txt = "Collection consisting of ";
468 foreach my $ann ($self->get_Annotations()) {
469 push(@texts, $ann->as_text());
472 $txt .= join(", ", map { '['.$_.']'; } @texts);
474 $txt .= "no elements";
482 Usage : my $str = $ann->display_text();
483 Function: returns a string. Unlike as_text(), this method returns a string
484 formatted as would be expected for te specific implementation.
486 One can pass a callback as an argument which allows custom text
487 generation; the callback is passed the current instance and any text
491 Args : [optional] callback
496 # this just calls the default display_text output for
498 my $DEFAULT_CB = sub {
501 foreach my $ann ($obj->get_Annotations()) {
502 $txt .= $ann->display_text()."\n";
508 my ($self, $cb) = @_;
510 $self->throw("") if ref $cb ne 'CODE';
520 Function: See L<Bio::AnnotationI>
522 Returns : a hash reference
532 foreach my $key ($self->get_all_annotation_keys()) {
533 # all contained objects will support hash_tree()
534 # (they are AnnotationIs)
535 $tree->{$key} = [$self->get_Annotations($key)];
543 Usage : $obj->tagname($newval)
544 Function: Get/set the tagname for this annotation value.
546 Setting this is optional. If set, it obviates the need to
547 provide a tag to Bio::AnnotationCollectionI when adding
548 this object. When obtaining an AnnotationI object from the
549 collection, the collection will set the value to the tag
550 under which it was stored unless the object has a tag
554 Returns : value of tagname (a scalar)
555 Args : new value (a scalar, optional)
563 return $self->{'tagname'} = shift if @_;
564 return $self->{'tagname'};
568 =head1 Backward compatible functions
570 Functions put in for backward compatibility with old
571 Bio::Annotation.pm stuff
588 my ($self,$value) = @_;
590 $self->deprecated("Using old style annotation call on new Annotation::Collection object");
592 if( defined $value ) {
593 my $val = Bio
::Annotation
::SimpleValue
->new();
595 $self->add_Annotation('description',$val);
598 my ($desc) = $self->get_Annotations('description');
600 # If no description tag exists, do not attempt to call value on undef:
601 return $desc ?
$desc->value : undef;
607 Title : add_gene_name
618 my ($self,$value) = @_;
620 $self->deprecated("Old style add_gene_name called on new style Annotation::Collection");
622 my $val = Bio
::Annotation
::SimpleValue
->new();
624 $self->add_Annotation('gene_name',$val);
627 =head2 each_gene_name
629 Title : each_gene_name
642 $self->deprecated("Old style each_gene_name called on new style Annotation::Collection");
645 my @gene = $self->get_Annotations('gene_name');
647 foreach my $g ( @gene ) {
648 push(@out,$g->value);
656 Title : add_Reference
667 my ($self, @values) = @_;
669 $self->deprecated("add_Reference (old style Annotation) on new style Annotation::Collection");
671 # Allow multiple (or no) references to be passed, as per old method
672 foreach my $value (@values) {
673 $self->add_Annotation('reference',$value);
677 =head2 each_Reference
679 Title : each_Reference
692 $self->deprecated("each_Reference (old style Annotation) on new style Annotation::Collection");
694 return $self->get_Annotations('reference');
711 my ($self,$value) = @_;
713 $self->deprecated("add_Comment (old style Annotation) on new style Annotation::Collection");
715 $self->add_Annotation('comment',$value);
734 $self->deprecated("each_Comment (old style Annotation) on new style Annotation::Collection");
736 return $self->get_Annotations('comment');
754 my ($self,$value) = @_;
756 $self->deprecated("add_DBLink (old style Annotation) on new style Annotation::Collection");
758 $self->add_Annotation('dblink',$value);
777 $self->deprecated("each_DBLink (old style Annotation) on new style Annotation::Collection - use get_Annotations('dblink')");
779 return $self->get_Annotations('dblink');
784 =head1 Implementation management functions
791 Usage : $obj->_typemap($newval)
794 Returns : value of _typemap
795 Args : newvalue (optional)
801 my ($self,$value) = @_;
802 if( defined $value) {
803 $self->{'_typemap'} = $value;
805 return $self->{'_typemap'};