diff variant_effect_predictor/Bio/Ontology/OntologyStore.pm @ 0:21066c0abaf5 draft

Uploaded
author willmclaren
date Fri, 03 Aug 2012 10:04:48 -0400
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/Ontology/OntologyStore.pm	Fri Aug 03 10:04:48 2012 -0400
@@ -0,0 +1,260 @@
+# $Id: OntologyStore.pm,v 1.1.2.2 2003/03/27 10:07:56 lapp Exp $
+#
+# BioPerl module for Bio::Ontology::OntologyStore
+#
+# Cared for by Hilmar Lapp <hlapp at gmx.net>
+#
+# Copyright Hilmar Lapp
+#
+# You may distribute this module under the same terms as perl itself
+
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::Ontology::OntologyStore - A repository of ontologies
+
+=head1 SYNOPSIS
+
+    # see documentation of methods
+
+=head1 DESCRIPTION
+
+The primary purpose of this module is that of a singleton repository
+of L<Bio::Ontology::OntologyI> instances from which an Ontology
+instance can be retrieved by name or identifier. This enables TermI
+implementations to return their corresponding OntologyI through using
+this singleton store instead of storing a direct reference to the
+Ontology object. The latter would almost inevitably lead to memory
+cycles, and would therefore potentially blow up an application.
+
+As a user of Ontology objects and Term objects you almost certainly
+will not need to deal with this module.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list.  Your participation is much appreciated.
+
+  bioperl-l@bioperl.org              - General discussion
+  http://bioperl.org/MailList.shtml  - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via
+the web:
+
+  http://bugzilla.bioperl.org/
+
+=head1 AUTHOR - Hilmar Lapp
+
+Email hlapp at gmx.net
+
+=head1 CONTRIBUTORS
+
+Additional contributors names and emails here
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+
+# Let the code begin...
+
+
+package Bio::Ontology::OntologyStore;
+use vars qw(@ISA);
+use strict;
+
+# Object preamble - inherits from Bio::Root::Root
+
+use Bio::Root::Root;
+
+
+@ISA = qw(Bio::Root::Root );
+
+# these are the static ontology stores by name and by identifier - there is
+# only one of each in any application
+my %ont_store_by_name = ();
+my %ont_store_by_id = ();
+# also, this is really meant as a singleton object, so we try to enforce it
+my $instance = undef;
+
+=head2 new
+
+ Title   : new
+ Usage   : my $obj = new Bio::Ontology::OntologyStore();
+ Function: Returns the Bio::Ontology::OntologyStore object.
+
+           Unlike usual implementations of new, this implementation
+           will try to return a previously instantiated store, if
+           there is any. It is just a synonym for get_instance. In
+           order to avoid ambiguities in your code, you may rather
+           want to call rather get_instance explicitly, which also
+           usually is better associated with this kind of behaviour.
+
+ Returns : an instance of Bio::Ontology::OntologyStore
+ Args    :
+
+
+=cut
+
+sub new {
+    return shift->get_instance(@_);
+}
+
+=head2 get_instance
+
+ Title   : get_instance
+ Usage   :
+ Function: Get an instance of this class for perusal.
+
+           Since by design this class is meant to be used as a
+           singleton, the implementation will return a previously
+           instantianted store if there is one, and instantiate a new
+           one otherwise. In order to use this class by means of an
+           instance, call this method for added code clarity, not
+           new().
+
+ Example :
+ Returns : an instance of this class
+ Args    : named parameters, if any (currently, there are no 
+           class-specific parameters other than those accepted by
+           L<Bio::Root::Root>.
+
+
+=cut
+
+sub get_instance{
+   my ($self,@args) = @_;
+
+   if(! $instance) {
+       $instance = $self->SUPER::new(@args);
+   }
+   return $instance;
+}
+
+=head2 get_ontology
+
+ Title   : get_ontology
+ Usage   :
+ Function: Get a previously instantiated and registered instance of
+           this class by name or by identifier. 
+
+           One of the main purposes of this class is to enable TermI
+           implementations to return their respective ontology without
+           keeping a strong reference to the respective ontology
+           object. Only objects previously registered objects can be
+           retrieved.
+
+           This is a class method, hence you can call it on the class
+           name, without dereferencing an object.
+
+ Example :
+ Returns : a L<Bio::Ontology::OntologyI> implementing object, or undef
+           if the query could not be satisfied
+ Args    : Named parameters specifying the query. The following parameters
+           are recognized:
+              -name   query the store for an ontology with the given name
+              -id     query for an ontology with the given identifier
+           If both are specified, an implicit AND logical operator is
+           assumed.
+
+=cut
+
+sub get_ontology{
+    my ($self,@args) = @_;
+    my $ont;
+
+    my ($name,$id) = $self->_rearrange([qw(NAME ID)], @args);
+    if($id) {
+	$ont = $ont_store_by_id{$id};
+	return unless $ont; # no AND can be satisfied in this case
+    }
+    if($name) {
+	my $o = $ont_store_by_name{$name};
+	if((! $ont) || ($ont->identifier() eq $o->identifier())) {
+	    $ont = $o;
+	} else {
+	    $ont = undef;
+	}
+    }
+    return $ont;
+}
+
+=head2 register_ontology
+
+ Title   : register_ontology
+ Usage   :
+ Function: Registers the given Ontology object for later retrieval
+           by name and identifier.
+
+ Example :
+ Returns : TRUE on success and FALSE otherwise
+ Args    : the L<Bio::Ontology::OntologyI> object(s) to register
+
+
+=cut
+
+sub register_ontology{
+    my ($self,@args) = @_;
+    my $ret = 1;
+
+    foreach my $ont (@args) {
+	if(! (ref($ont) && $ont->isa("Bio::Ontology::OntologyI"))) {
+	    $self->throw((ref($ont) ? ref($ont) : $ont)." does not implement ".
+			 "Bio::Ontology::OntologyI or is not an object");
+	}
+	if($self->get_ontology(-name => $ont->name())) {
+	    $self->warn("ontology with name \"".$ont->name().
+			"\" already exists in the store, ignoring new one");
+	    $ret = 0;
+	    next;
+	}
+	if($self->get_ontology(-id => $ont->identifier())) {
+	    $self->warn("ontology with id \"".$ont->identifier().
+			"\" already exists in the store, ignoring new one");
+	    $ret = 0;
+	    next;
+	}
+	$ont_store_by_name{$ont->name()} = $ont;
+	$ont_store_by_id{$ont->identifier()} = $ont;
+    }
+    return $ret;
+}
+
+=head2 remove_ontology
+
+ Title   : remove_ontology
+ Usage   :
+ Function: Remove the specified ontology from the store.
+ Example :
+ Returns : TRUE on success and FALSE otherwise
+ Args    : the L<Bio::Ontology::OntologyI> implementing object(s)
+           to be removed from the store
+
+
+=cut
+
+sub remove_ontology{
+    my $self = shift;
+    my $ret = 1;
+
+    foreach my $ont (@_) {
+	$self->throw(ref($ont)." does not implement Bio::Ontology::OntologyI")
+	    unless $ont && ref($ont) && $ont->isa("Bio::Ontology::OntologyI");
+	# remove it from both the id hash and the name hash
+	delete $ont_store_by_id{$ont->identifier()};
+	delete $ont_store_by_name{$ont->name()} if $ont->name();
+    }
+    return 1;
+}
+
+1;