[MOBY-guts] biomoby commit

[Mark Wilkinson]

mwilkinson
Thu Jul 10 01:32:50 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv2358/Perl/MOBY

Modified Files:
	OntologyServer.pm 
Log Message:
adding debugging info into the OntologyServer as it isn't traversing the DAG properly to its root

moby-live/Perl/MOBY OntologyServer.pm,1.22,1.23
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm	2003/06/23 21:58:45	1.22
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm	2003/07/10 05:32:50	1.23
@@ -75,6 +75,8 @@
 use DBI;
 use DBD::mysql;
 
+my $debug = 1;
+
 {
 	#Encapsulated class data
 	
@@ -842,26 +844,28 @@
     }
     return {} unless $term =~ /^urn\:lsid/;  # now its a URI
     
-    my $relhash = $self->getRelationshipTypes(ontology => $ontology);
+    my $relhash = $self->getRelationshipTypes(ontology => $ontology);  # get teh types of relationships for the object/service ontology
     return {} unless $relhash;
-    my @rels = keys %{$relhash};
+    my @rels = keys %{$relhash};  #@rels is the list of relationship types for that ontology
     my %relationships;
     foreach my $relationship (@rels){
         my %IDS;
         my $OS = MOBY::OntologyServer->new(ontology => 'relationship');
-        my $reluri = $OS->getRelationshipURI($ontology, $relationship);
+        my $reluri = $OS->getRelationshipURI($ontology, $relationship);  # get the URI for that relationship type if it ins't already a URI
         $IDS{$term} = "untestedroot";    # mark the one in-hand as being untested
     	while (grep /untested/, (values %IDS)){  			# now, while there are untested services in our list...
-    		foreach my $service(keys %IDS){ 			# start parsing through the current list (hash keys)
-    			next if ($IDS{$service} eq "tested");  			# if it has been tested already then move on
+    		foreach my $termthingy(keys %IDS){ 			# start parsing through the current list (hash keys)
+                $debug && _LOG("testing TermThingy $termthingy\n");
+    			next if ($IDS{$termthingy} eq "tested");  			# if it has been tested already then move on
                 my $lsids = $self->Relationships(term => $term, relationship => $relationship, direction => $direction); # get the related terms for this type; this should return a single hash value
-                if ($IDS{$term} =~ /root/){
-                    delete $IDS{$term}
+                if ($IDS{$termthingy} =~ /root/){  # here is where we remove self
+                    delete $IDS{$termthingy}
                 } else {
-                    $IDS{$service} = "tested";   # mark the current one as now being "done"
+                    $IDS{$termthingy} = "tested";   # mark the current one as now being "done"
                 }
                 #${$lsids}{relationshiptype}=[lsid, lsid, lsid];
                 foreach my $lsid(@{$lsids->{$relationship}}){  # go through the related terms
+                    $debug && _LOG("setting $lsid as untested\n");
                     next if (defined $IDS{$lsid});   # if we have already seen that term, skip it
                     $IDS{$lsid} = "untested"   # otherwise add it to the list and loop again.
                 }
@@ -873,6 +877,19 @@
     return \%relationships;
 }
 
+
+
+sub _LOG {
+	#return unless $debug;
+	#print join "\n", @_;
+	#print  "\n---\n";
+	#return;
+	open LOG, ">>/tmp/OntologyServer.txt" or die "can't open logfile $!\n";
+	print LOG join "\n", @_;
+	print LOG "\n---\n";
+	close LOG;
+}
+
 sub DESTROY {}
 
 sub AUTOLOAD {