branch-1-6/Bio/Ontology/OntologyStore.pm

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