Bio/Ontology/OntologyStore.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Ontology::OntologyStore
   4 #
   5 # Cared for by Hilmar Lapp <hlapp at gmx.net>
   6 #
   7 # Copyright Hilmar Lapp
   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::Ontology::OntologyStore - A repository of ontologies
  16
  17 =head1 SYNOPSIS
  18
  19   #----------
  20   #SCENARIO 1
  21   #----------
  22
  23   #make an ontology object manually. via OntologyIO
  24   my $io = Bio::OntologyIO->new(
  25                                 #params to fetch Cell Ontology here
  26                                );
  27   my $cell_ontology = $io->next_ontology;
  28
  29   #this is a singleton that caches the fact that you've created
  30   #a 'Cell Ontology' intance...
  31   my $store = Bio::Ontology::OntologyStore->get_instance();
  32
  33   #...and it can hand you back a copy of it at any time.
  34   my $cell_ontology_copy = $store->get_ontology('Cell Ontology');
  35
  36
  37   #----------
  38   #SCENARIO 2
  39   #----------
  40
  41   my $store = Bio::Ontology::OntologyStore->get_instance();
  42   #this use case allows the construction of an ontology on
  43   #demand just by supplying the name.
  44   my $ontology = $store->get_ontology('Sequence Ontology');
  45
  46
  47 =head1 DESCRIPTION
  48
  49 The primary purpose of this module is that of a singleton repository
  50 of L<Bio::Ontology::OntologyI> instances from which an Ontology
  51 instance can be retrieved by name or identifier. This enables TermI
  52 implementations to return their corresponding OntologyI through using
  53 this singleton store instead of storing a direct reference to the
  54 Ontology object. The latter would almost inevitably lead to memory
  55 cycles, and would therefore potentially blow up an application.
  56
  57 =head1 FEEDBACK
  58
  59 =head2 Mailing Lists
  60
  61 User feedback is an integral part of the evolution of this and other
  62 Bioperl modules. Send your comments and suggestions preferably to
  63 the Bioperl mailing list.  Your participation is much appreciated.
  64
  65   bioperl-l@bioperl.org                  - General discussion
  66   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  67
  68 =head2 Reporting Bugs
  69
  70 Report bugs to the Bioperl bug tracking system to help us keep track
  71 of the bugs and their resolution. Bug reports can be submitted via
  72 the web:
  73
  74   http://bugzilla.open-bio.org/
  75
  76 =head1 AUTHOR - Hilmar Lapp
  77
  78   Hilmar Lapp E<lt>hlapp@gmx.netE<gt>
  79   Allen Day E<lt>allenday@ucla.eduE<gt>
  80
  81 =head1 APPENDIX
  82
  83 The rest of the documentation details each of the object methods.
  84 Internal methods are usually preceded with a _
  85
  86 =cut
  87
  88
  89 # Let the code begin...
  90
  91
  92 package Bio::Ontology::OntologyStore;
  93 use strict;
  94
  95 # Object preamble - inherits from Bio::Root::Root
  96
  97 use Bio::Ontology::DocumentRegistry;
  98 use Bio::OntologyIO;
  99 use FileHandle;
 100 use File::Spec::Functions;
 101
 102
 103 use base qw(Bio::Root::Root);
 104
 105 # these are the static ontology stores by name and by identifier - there is
 106 # only one of each in any application
 107 my %ont_store_by_name = ();
 108 my %ont_store_by_id = ();
 109 my %ont_aliases = (
 110                    'Gene Ontology' => 'Gene_Ontology'
 111                     );
 112 # also, this is really meant as a singleton object, so we try to enforce it
 113 my $instance = undef;
 114
 115 =head2 new
 116
 117  Title   : new
 118  Usage   : my $obj = Bio::Ontology::OntologyStore->new();
 119  Function: Returns the Bio::Ontology::OntologyStore object.
 120
 121            Unlike usual implementations of new, this implementation
 122            will try to return a previously instantiated store, if
 123            there is any. It is just a synonym for get_instance. In
 124            order to avoid ambiguities in your code, you may rather
 125            want to call rather get_instance explicitly, which also
 126            usually is better associated with this kind of behaviour.
 127
 128  Returns : an instance of Bio::Ontology::OntologyStore
 129  Args    :
 130
 131 =cut
 132
 133 sub new {
 134     return shift->get_instance(@_);
 135 }
 136
 137 =head2 get_instance
 138
 139  Title   : get_instance
 140  Usage   :
 141  Function: Get an instance of this class for perusal.
 142
 143            Since by design this class is meant to be used as a
 144            singleton, the implementation will return a previously
 145            instantianted store if there is one, and instantiate a new
 146            one otherwise. In order to use this class by means of an
 147            instance, call this method for added code clarity, not
 148            new().
 149
 150  Example :
 151  Returns : an instance of this class
 152  Args    : named parameters, if any (currently, there are no
 153            class-specific parameters other than those accepted by
 154            Bio::Root::Root.
 155
 156 See L<Bio::Root::Root>.
 157
 158 =cut
 159
 160 sub get_instance{
 161    my ($self,@args) = @_;
 162
 163    if(! $instance) {
 164        $instance = $self->SUPER::new(@args);
 165    }
 166    return $instance;
 167 }
 168
 169 =head2 get_ontology
 170
 171  Title   : get_ontology
 172  Usage   :
 173  Function: Get a previously instantiated and registered instance of
 174            this class by name or by identifier.
 175
 176            One of the main purposes of this class is to enable TermI
 177            implementations to return their respective ontology without
 178            keeping a strong reference to the respective ontology
 179            object. Only objects previously registered objects can be
 180            retrieved.
 181
 182            This is a class method, hence you can call it on the class
 183            name, without dereferencing an object.
 184
 185  Example :
 186  Returns : a Bio::Ontology::OntologyI implementing object, or undef
 187            if the query could not be satisfied
 188  Args    : Named parameters specifying the query. The following parameters
 189            are recognized:
 190               -name   query the store for an ontology with the given name
 191               -id     query for an ontology with the given identifier
 192            If both are specified, an implicit AND logical operator is
 193            assumed.
 194
 195 See L<Bio::Ontology::OntologyI>.
 196
 197 =cut
 198
 199 sub get_ontology{
 200   my ($self,@args) = @_;
 201   my $ont;
 202
 203   my ($name,$id) = $self->_rearrange([qw(NAME ID)], @args);
 204   if($id) {
 205     $ont = $ont_store_by_id{$id};
 206     return unless $ont; # no AND can be satisfied in this case
 207   }
 208
 209   if($name) {
 210     my $o = $ont_store_by_name{$name};
 211
 212     if(!$o){
 213       my $doc_registry = Bio::Ontology::DocumentRegistry->get_instance();
 214       my($url,$def,$fmt) = $doc_registry->documents($name);
 215
 216       if(ref($url) eq 'ARRAY'){
 217         my $io = Bio::OntologyIO->new(-url      => $url,
 218                                       -defs_url => $def,
 219                                       -format   => $fmt,
 220                                      );
 221
 222         $o = $io->next_ontology();
 223         $ont_store_by_name{$name} = $o;
 224       } elsif($url){
 225         my $io = Bio::OntologyIO->new(-url      => $url,
 226                                       -defs_url => $def,
 227                                       -format   => $fmt,
 228                                      );
 229         $o = $io->next_ontology;
 230         $ont_store_by_name{$name} = $o;
 231       }
 232     }
 233
 234     if((! $ont) || ($ont->identifier() eq $o->identifier())) {
 235       $ont = $o;
 236     } else {
 237       $ont = undef;
 238     }
 239   }
 240
 241   return $ont;
 242 }
 243
 244 =head2 register_ontology
 245
 246  Title   : register_ontology
 247  Usage   :
 248  Function: Registers the given Ontology object for later retrieval
 249            by name and identifier.
 250
 251  Example :
 252  Returns : TRUE on success and FALSE otherwise
 253  Args    : the Bio::Ontology::OntologyI object(s) to register
 254
 255 See L<Bio::Ontology::OntologyI>.
 256
 257 =cut
 258
 259 sub register_ontology {
 260   my ($self,@args) = @_;
 261   my $ret = 1;
 262   foreach my $ont (@args) {
 263     if(ref($ont) && $ont->isa('Bio::Ontology::OntologyI')){
 264       $ont_store_by_name{$ont->name()} = $ont if $ont->name;
 265       next;
 266     }
 267
 268         if(! (ref($ont) && $ont->isa("Bio::Ontology::OntologyI"))) {
 269       $self->throw((ref($ont) ? ref($ont) : $ont)." does not implement ".
 270                    "Bio::Ontology::OntologyI or is not an object");
 271         }
 272         if($self->get_ontology(-name => $ont->name())) {
 273       $self->warn("ontology with name \"".$ont->name().
 274                   "\" already exists in the store, ignoring new one");
 275       $ret = 0;
 276       next;
 277         }
 278         if($self->get_ontology(-id => $ont->identifier())) {
 279       $self->warn("ontology with id \"".$ont->identifier().
 280                   "\" already exists in the store, ignoring new one");
 281       $ret = 0;
 282       next;
 283         }
 284         $ont_store_by_name{$ont->name()} = $ont;
 285         $ont_store_by_id{$ont->identifier()} = $ont;
 286   }
 287   return $ret;
 288 }
 289
 290 =head2 remove_ontology
 291
 292  Title   : remove_ontology
 293  Usage   :
 294  Function: Remove the specified ontology from the store.
 295  Example :
 296  Returns : TRUE on success and FALSE otherwise
 297  Args    : the Bio::Ontology::OntologyI implementing object(s)
 298            to be removed from the store
 299
 300 See L<Bio::Ontology::OntologyI>.
 301
 302 =cut
 303
 304 sub remove_ontology{
 305     my $self = shift;
 306     my $ret = 1;
 307
 308     foreach my $ont (@_) {
 309         $self->throw(ref($ont)." does not implement Bio::Ontology::OntologyI")
 310             unless $ont && ref($ont) && $ont->isa("Bio::Ontology::OntologyI");
 311         # remove it from both the id hash and the name hash
 312         delete $ont_store_by_id{$ont->identifier()};
 313         delete $ont_store_by_name{$ont->name()} if $ont->name();
 314     }
 315     return 1;
 316 }
 317
 318 =head2 guess_ontology()
 319
 320  Usage   : my $ontology =
 321            Bio::Ontology::OntologyStore->guess_ontology('GO:0000001');
 322  Function: tries to guess which ontology a term identifier comes from,
 323            loads it as necessary,
 324            and returns it as a Bio::Ontology::Ontology object.
 325  Example :
 326  Returns : a Bio::Ontology::Ontology object, or warns and returns undef
 327  Args    : an ontology term identifier in XXXX:DDDDDDD format.
 328            Guessing is based on the XXXX string before the colon.
 329
 330 =cut
 331
 332 sub guess_ontology {
 333   my ($self,$id) = @_;
 334
 335   my($prefix) = $id =~ /^(.+?):.+$/;
 336
 337   my %prefix = (
 338                 SO => 'Sequence Ontology',
 339                 SOFA => 'Sequence Ontology Feature Annotation',
 340                 GO => 'Gene Ontology',
 341                );
 342
 343   return $prefix{$prefix} || undef;
 344 }
 345
 346 1;