view release on metacpan or  search on metacpan

Bio/Ontology/OntologyStore.pm  view on Meta::CPAN

sub register_ontology {
  my ($self,@args) = @_;
  my $ret = 1;
  foreach my $ont (@args) {
    if(ref($ont) && $ont->isa('Bio::Ontology::OntologyI')){
      $ont_store_by_name{$ont->name()} = $ont if $ont->name;
      next;
    }

	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 Bio::Ontology::OntologyI implementing object(s)
           to be removed from the store

See L<Bio::Ontology::OntologyI>.

=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;
}

=head2 guess_ontology()

 Usage   : my $ontology = 
           Bio::Ontology::OntologyStore->guess_ontology('GO:0000001');
 Function: tries to guess which ontology a term identifier comes from, 
           loads it as necessary,
           and returns it as a Bio::Ontology::Ontology object.
 Example :
 Returns : a Bio::Ontology::Ontology object, or warns and returns undef
 Args    : an ontology term identifier in XXXX:DDDDDDD format.  
           Guessing is based on the XXXX string before the colon.

=cut

sub guess_ontology {
  my ($self,$id) = @_;

  my($prefix) = $id =~ /^(.+?):.+$/;

  my %prefix = (
                SO => 'Sequence Ontology',
                SOFA => 'Sequence Ontology Feature Annotation',
                GO => 'Gene Ontology',
               );

  return $prefix{$prefix} || undef;
}

1;