[Bioperl-guts-l] bioperl commit

[Allen Day]

allenday
Mon Oct  4 16:23:14 EDT 2004
Update of /home/repository/bioperl/bioperl-live/Bio/Ontology
In directory pub.open-bio.org:/tmp/cvs-serv25975/Bio/Ontology

Modified Files:
	DocumentRegistry.pm OntologyStore.pm 
Log Message:
modifications to allow url fetch of gene ontology.  this was not easy
b/c of the multiple .ontology files for each aspect.

Bio::SeqFeature::Annotated objects now instantiate Ontology_term tags
as Bio::Annotation::OntologyTerm objects, not Bio::Annotation::SimpleValue
objects (Scott!)


bioperl-live/Bio/Ontology DocumentRegistry.pm,1.3,1.4 OntologyStore.pm,1.5,1.6
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Ontology/DocumentRegistry.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- /home/repository/bioperl/bioperl-live/Bio/Ontology/DocumentRegistry.pm	2004/09/25 11:41:29	1.3
+++ /home/repository/bioperl/bioperl-live/Bio/Ontology/DocumentRegistry.pm	2004/10/04 20:23:14	1.4
@@ -88,8 +88,20 @@
                 definitions =>'http://umn.dl.sourceforge.net/sourceforge/song/sofa.definition',
                 format => 'soflat',
                                     },
+             'Gene Ontology' => {
+                ontology => [
+                             'http://www.geneontology.org/ontology/function.ontology',
+                             'http://www.geneontology.org/ontology/process.ontology',
+                             'http://www.geneontology.org/ontology/component.ontology'
+                            ],
+                definitions => 'http://www.geneontology.org/ontology/GO.defs',
+                format => 'soflat',
+                                },
             };
 
+#aliases
+$instance->{Gene_Ontology} = $instance->{'Gene Ontology'};
+
 bless $instance, __PACKAGE__;
 }
 

===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Ontology/OntologyStore.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- /home/repository/bioperl/bioperl-live/Bio/Ontology/OntologyStore.pm	2004/08/13 20:52:46	1.5
+++ /home/repository/bioperl/bioperl-live/Bio/Ontology/OntologyStore.pm	2004/10/04 20:23:14	1.6
@@ -109,6 +109,9 @@
 # only one of each in any application
 my %ont_store_by_name = ();
 my %ont_store_by_id = ();
+my %ont_aliases = (
+                   'Gene Ontology' => 'Gene_Ontology'
+                    );
 # also, this is really meant as a singleton object, so we try to enforce it
 my $instance = undef;
 
@@ -206,12 +209,19 @@
   if($name) {
     my $o = $ont_store_by_name{$name};
 
-
     if(!$o){
       my $doc_registry = Bio::Ontology::DocumentRegistry->get_instance();
       my($url,$def,$fmt) = $doc_registry->documents($name);
 
-      if($url){
+      if(ref($url) eq 'ARRAY'){
+        my $io = Bio::OntologyIO->new(-url      => $url,
+                                      -defs_url => $def,
+                                      -format   => $fmt,
+                                     );
+
+        $o = $io->next_ontology();
+        $ont_store_by_name{$name} = $o;
+      } elsif($url){
         my $io = Bio::OntologyIO->new(-url      => $url,
                                       -defs_url => $def,
                                       -format   => $fmt,
@@ -244,31 +254,35 @@
 
 =cut
 
-sub register_ontology{
-    my ($self, at args) = @_;
-    my $ret = 1;
+sub register_ontology {
+  my ($self, at args) = @_;
+  my $ret = 1;
+  foreach my $ont (@args) {
+    if(ref($ont) && $ont->isa('Bio::Ontology::OntologyI')){
+      $ont_store_by_name{$ont->name()} = $ont;
+      next;
+    }
 
-    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");
+      $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;
+      $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;
+      $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;
+  }
+  return $ret;
 }
 
 =head2 remove_ontology
@@ -298,4 +312,31 @@
     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;