| 0 | 1 # $Id: OntologyStore.pm,v 1.1.2.2 2003/03/27 10:07:56 lapp Exp $ | 
|  | 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     # see documentation of methods | 
|  | 20 | 
|  | 21 =head1 DESCRIPTION | 
|  | 22 | 
|  | 23 The primary purpose of this module is that of a singleton repository | 
|  | 24 of L<Bio::Ontology::OntologyI> instances from which an Ontology | 
|  | 25 instance can be retrieved by name or identifier. This enables TermI | 
|  | 26 implementations to return their corresponding OntologyI through using | 
|  | 27 this singleton store instead of storing a direct reference to the | 
|  | 28 Ontology object. The latter would almost inevitably lead to memory | 
|  | 29 cycles, and would therefore potentially blow up an application. | 
|  | 30 | 
|  | 31 As a user of Ontology objects and Term objects you almost certainly | 
|  | 32 will not need to deal with this module. | 
|  | 33 | 
|  | 34 =head1 FEEDBACK | 
|  | 35 | 
|  | 36 =head2 Mailing Lists | 
|  | 37 | 
|  | 38 User feedback is an integral part of the evolution of this and other | 
|  | 39 Bioperl modules. Send your comments and suggestions preferably to | 
|  | 40 the Bioperl mailing list.  Your participation is much appreciated. | 
|  | 41 | 
|  | 42   bioperl-l@bioperl.org              - General discussion | 
|  | 43   http://bioperl.org/MailList.shtml  - About the mailing lists | 
|  | 44 | 
|  | 45 =head2 Reporting Bugs | 
|  | 46 | 
|  | 47 Report bugs to the Bioperl bug tracking system to help us keep track | 
|  | 48 of the bugs and their resolution. Bug reports can be submitted via | 
|  | 49 the web: | 
|  | 50 | 
|  | 51   http://bugzilla.bioperl.org/ | 
|  | 52 | 
|  | 53 =head1 AUTHOR - Hilmar Lapp | 
|  | 54 | 
|  | 55 Email hlapp at gmx.net | 
|  | 56 | 
|  | 57 =head1 CONTRIBUTORS | 
|  | 58 | 
|  | 59 Additional contributors names and emails here | 
|  | 60 | 
|  | 61 =head1 APPENDIX | 
|  | 62 | 
|  | 63 The rest of the documentation details each of the object methods. | 
|  | 64 Internal methods are usually preceded with a _ | 
|  | 65 | 
|  | 66 =cut | 
|  | 67 | 
|  | 68 | 
|  | 69 # Let the code begin... | 
|  | 70 | 
|  | 71 | 
|  | 72 package Bio::Ontology::OntologyStore; | 
|  | 73 use vars qw(@ISA); | 
|  | 74 use strict; | 
|  | 75 | 
|  | 76 # Object preamble - inherits from Bio::Root::Root | 
|  | 77 | 
|  | 78 use Bio::Root::Root; | 
|  | 79 | 
|  | 80 | 
|  | 81 @ISA = qw(Bio::Root::Root ); | 
|  | 82 | 
|  | 83 # these are the static ontology stores by name and by identifier - there is | 
|  | 84 # only one of each in any application | 
|  | 85 my %ont_store_by_name = (); | 
|  | 86 my %ont_store_by_id = (); | 
|  | 87 # also, this is really meant as a singleton object, so we try to enforce it | 
|  | 88 my $instance = undef; | 
|  | 89 | 
|  | 90 =head2 new | 
|  | 91 | 
|  | 92  Title   : new | 
|  | 93  Usage   : my $obj = new Bio::Ontology::OntologyStore(); | 
|  | 94  Function: Returns the Bio::Ontology::OntologyStore object. | 
|  | 95 | 
|  | 96            Unlike usual implementations of new, this implementation | 
|  | 97            will try to return a previously instantiated store, if | 
|  | 98            there is any. It is just a synonym for get_instance. In | 
|  | 99            order to avoid ambiguities in your code, you may rather | 
|  | 100            want to call rather get_instance explicitly, which also | 
|  | 101            usually is better associated with this kind of behaviour. | 
|  | 102 | 
|  | 103  Returns : an instance of Bio::Ontology::OntologyStore | 
|  | 104  Args    : | 
|  | 105 | 
|  | 106 | 
|  | 107 =cut | 
|  | 108 | 
|  | 109 sub new { | 
|  | 110     return shift->get_instance(@_); | 
|  | 111 } | 
|  | 112 | 
|  | 113 =head2 get_instance | 
|  | 114 | 
|  | 115  Title   : get_instance | 
|  | 116  Usage   : | 
|  | 117  Function: Get an instance of this class for perusal. | 
|  | 118 | 
|  | 119            Since by design this class is meant to be used as a | 
|  | 120            singleton, the implementation will return a previously | 
|  | 121            instantianted store if there is one, and instantiate a new | 
|  | 122            one otherwise. In order to use this class by means of an | 
|  | 123            instance, call this method for added code clarity, not | 
|  | 124            new(). | 
|  | 125 | 
|  | 126  Example : | 
|  | 127  Returns : an instance of this class | 
|  | 128  Args    : named parameters, if any (currently, there are no | 
|  | 129            class-specific parameters other than those accepted by | 
|  | 130            L<Bio::Root::Root>. | 
|  | 131 | 
|  | 132 | 
|  | 133 =cut | 
|  | 134 | 
|  | 135 sub get_instance{ | 
|  | 136    my ($self,@args) = @_; | 
|  | 137 | 
|  | 138    if(! $instance) { | 
|  | 139        $instance = $self->SUPER::new(@args); | 
|  | 140    } | 
|  | 141    return $instance; | 
|  | 142 } | 
|  | 143 | 
|  | 144 =head2 get_ontology | 
|  | 145 | 
|  | 146  Title   : get_ontology | 
|  | 147  Usage   : | 
|  | 148  Function: Get a previously instantiated and registered instance of | 
|  | 149            this class by name or by identifier. | 
|  | 150 | 
|  | 151            One of the main purposes of this class is to enable TermI | 
|  | 152            implementations to return their respective ontology without | 
|  | 153            keeping a strong reference to the respective ontology | 
|  | 154            object. Only objects previously registered objects can be | 
|  | 155            retrieved. | 
|  | 156 | 
|  | 157            This is a class method, hence you can call it on the class | 
|  | 158            name, without dereferencing an object. | 
|  | 159 | 
|  | 160  Example : | 
|  | 161  Returns : a L<Bio::Ontology::OntologyI> implementing object, or undef | 
|  | 162            if the query could not be satisfied | 
|  | 163  Args    : Named parameters specifying the query. The following parameters | 
|  | 164            are recognized: | 
|  | 165               -name   query the store for an ontology with the given name | 
|  | 166               -id     query for an ontology with the given identifier | 
|  | 167            If both are specified, an implicit AND logical operator is | 
|  | 168            assumed. | 
|  | 169 | 
|  | 170 =cut | 
|  | 171 | 
|  | 172 sub get_ontology{ | 
|  | 173     my ($self,@args) = @_; | 
|  | 174     my $ont; | 
|  | 175 | 
|  | 176     my ($name,$id) = $self->_rearrange([qw(NAME ID)], @args); | 
|  | 177     if($id) { | 
|  | 178 	$ont = $ont_store_by_id{$id}; | 
|  | 179 	return unless $ont; # no AND can be satisfied in this case | 
|  | 180     } | 
|  | 181     if($name) { | 
|  | 182 	my $o = $ont_store_by_name{$name}; | 
|  | 183 	if((! $ont) || ($ont->identifier() eq $o->identifier())) { | 
|  | 184 	    $ont = $o; | 
|  | 185 	} else { | 
|  | 186 	    $ont = undef; | 
|  | 187 	} | 
|  | 188     } | 
|  | 189     return $ont; | 
|  | 190 } | 
|  | 191 | 
|  | 192 =head2 register_ontology | 
|  | 193 | 
|  | 194  Title   : register_ontology | 
|  | 195  Usage   : | 
|  | 196  Function: Registers the given Ontology object for later retrieval | 
|  | 197            by name and identifier. | 
|  | 198 | 
|  | 199  Example : | 
|  | 200  Returns : TRUE on success and FALSE otherwise | 
|  | 201  Args    : the L<Bio::Ontology::OntologyI> object(s) to register | 
|  | 202 | 
|  | 203 | 
|  | 204 =cut | 
|  | 205 | 
|  | 206 sub register_ontology{ | 
|  | 207     my ($self,@args) = @_; | 
|  | 208     my $ret = 1; | 
|  | 209 | 
|  | 210     foreach my $ont (@args) { | 
|  | 211 	if(! (ref($ont) && $ont->isa("Bio::Ontology::OntologyI"))) { | 
|  | 212 	    $self->throw((ref($ont) ? ref($ont) : $ont)." does not implement ". | 
|  | 213 			 "Bio::Ontology::OntologyI or is not an object"); | 
|  | 214 	} | 
|  | 215 	if($self->get_ontology(-name => $ont->name())) { | 
|  | 216 	    $self->warn("ontology with name \"".$ont->name(). | 
|  | 217 			"\" already exists in the store, ignoring new one"); | 
|  | 218 	    $ret = 0; | 
|  | 219 	    next; | 
|  | 220 	} | 
|  | 221 	if($self->get_ontology(-id => $ont->identifier())) { | 
|  | 222 	    $self->warn("ontology with id \"".$ont->identifier(). | 
|  | 223 			"\" already exists in the store, ignoring new one"); | 
|  | 224 	    $ret = 0; | 
|  | 225 	    next; | 
|  | 226 	} | 
|  | 227 	$ont_store_by_name{$ont->name()} = $ont; | 
|  | 228 	$ont_store_by_id{$ont->identifier()} = $ont; | 
|  | 229     } | 
|  | 230     return $ret; | 
|  | 231 } | 
|  | 232 | 
|  | 233 =head2 remove_ontology | 
|  | 234 | 
|  | 235  Title   : remove_ontology | 
|  | 236  Usage   : | 
|  | 237  Function: Remove the specified ontology from the store. | 
|  | 238  Example : | 
|  | 239  Returns : TRUE on success and FALSE otherwise | 
|  | 240  Args    : the L<Bio::Ontology::OntologyI> implementing object(s) | 
|  | 241            to be removed from the store | 
|  | 242 | 
|  | 243 | 
|  | 244 =cut | 
|  | 245 | 
|  | 246 sub remove_ontology{ | 
|  | 247     my $self = shift; | 
|  | 248     my $ret = 1; | 
|  | 249 | 
|  | 250     foreach my $ont (@_) { | 
|  | 251 	$self->throw(ref($ont)." does not implement Bio::Ontology::OntologyI") | 
|  | 252 	    unless $ont && ref($ont) && $ont->isa("Bio::Ontology::OntologyI"); | 
|  | 253 	# remove it from both the id hash and the name hash | 
|  | 254 	delete $ont_store_by_id{$ont->identifier()}; | 
|  | 255 	delete $ont_store_by_name{$ont->name()} if $ont->name(); | 
|  | 256     } | 
|  | 257     return 1; | 
|  | 258 } | 
|  | 259 | 
|  | 260 1; |