Bio/Ontology/OntologyStore.pm

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