[MOBY-guts] biomoby commit

[Mark Wilkinson]

mwilkinson
Mon Jun 23 12:05:16 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv4125/MOBY

Modified Files:
	OntologyServer.pm 
Log Message:
added a findService test to MOBY::Client::Central.  It fails at the moment, and I'm not sure why.

moby-live/Perl/MOBY OntologyServer.pm,1.17,1.18
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm	2003/06/19 00:47:35	1.17
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm	2003/06/23 16:05:16	1.18
@@ -640,7 +640,7 @@
     # service1_id ISA service2_id?
     my (@isa) = $self->dbh->selectrow_array(q{select * from namespace_term2term where namespace2_id = ?},undef, $id);
     if (scalar @isa){
-        return (0, q{Namespace type $term has dependencies in the ontology},$lsid);
+        return (0, qq{Namespace type $term has dependencies in the ontology},$lsid);
     }
     
     $self->dbh->do(q{delete from namespace where namespace_id = ?}, undef,$id );
@@ -819,6 +819,7 @@
     my $ontology = $args{ontology}?$args{ontology}:$self->ontology;
     my $term = $args{term};
     my $expand = $args{expand};
+    my $relationship = $args{relationship};
     return unless ($ontology && $term && (($ontology eq 'service') || ($ontology eq 'object')));
     # convert $term into an LSID if it isn't already
     if ($ontology eq 'service'){
@@ -826,8 +827,9 @@
     } elsif ($ontology eq 'object'){
         $term = $self->getObjectURI($term);
     }
-    
-    my $defs = $self->dbh->selectall_arrayref("
+    my $defs;
+    unless (defined $relationship){
+        $defs = $self->dbh->selectall_arrayref("
         select s2.${ontology}_lsid, relationship_type from
             ${ontology}_term2term as t2t,
             $ontology as s1,
@@ -836,7 +838,18 @@
             s1.${ontology}_id = t2t.${ontology}1_id and
             s2.${ontology}_id = t2t.${ontology}2_id and
             s1.${ontology}_lsid = ?", undef, $term); # ")
-    
+    } else {
+        $defs = $self->dbh->selectall_arrayref("
+        select s2.${ontology}_lsid, relationship_type from
+            ${ontology}_term2term as t2t,
+            $ontology as s1,
+            $ontology as s2  
+        where
+            relationship_type = ? and 
+            s1.${ontology}_id = t2t.${ontology}1_id and
+            s2.${ontology}_id = t2t.${ontology}2_id and
+            s1.${ontology}_lsid = ?", undef, $relationship, $term); # ")        
+    }
     my %results;
     foreach (@{$defs}){
         my $lsid = $_->[0];
@@ -867,7 +880,58 @@
     }
     return $URI;
 }
+
+
+=head2 traverseDAG
+
+=cut
+
+sub traverseDAG {
+    my ($self, $term) = @_;
+    my $ontology = $self->ontology;
+    return {} unless $ontology;
+    return {} unless $term;
+    if ($ontology eq 'service'){
+        $term = $self->getServiceURI($term);
+    } elsif ($ontology eq 'object'){
+        $term = $self->getObjectURI($term);
+    }
+    return {} unless $term =~ /^urn\:lsid/;  # now its a URI
     
+    my $relhash = $self->getRelationshipTypes(ontology => $ontology);
+    return {} unless $relhash;
+    my @rels = keys %{$relhash};
+    my %IDS;
+    foreach my $relationship (@rels){
+        my $reluri = $self->getRelationshipURI($ontology, $relationship);
+        $IDS{$term} = "untested";
+    	while (grep /untested/, (values %IDS)){  			# now, while there are untested services in our list...
+    		foreach my $service(keys %IDS){ 			# start parsing through the list
+    			next if ($IDS{$service} eq "tested");  			# if it has been tested already then move on
+                my $lsids = $self->Relationships(term => $term, relationship => $relationship);
+                $IDS{$service} = "tested";
+                #${$lsids}{relationshiptype}=[lsid, lsid, lsid];
+                
+    		}
+    	}
+    }
+}
+
+
+	$ServiceIDs{$root_id} = "untested";  # mark the one in-hand as untested
+	while (grep /untested/, (values %ServiceIDs)){  			# now, while there are untested services in our list...
+		foreach my $service(keys %ServiceIDs){ 			# start parsing through the list
+			next if ($ServiceIDs{$service} eq "tested");  			# if it has been tested already then move on
+			my $sth = $dbh->prepare($sth{get_service_hierarchy_list});
+			$sth->execute($service);  				# execute the query for child nodes
+			$ServiceIDs{$service} = "tested";  				# mark it as tested
+			while (my $new = $sth->fetchrow_array){	# now get each of the child nodes
+				next if (defined $ServiceIDs{$new});  	# if we have already heard about it then move on
+				$ServiceIDs{$new} = "untested";  				#otherwise mark it as untested, and start all over again
+			}
+		}
+	}
+
 sub DESTROY {}
 
 sub AUTOLOAD {