[MOBY-guts] biomoby commit

[Mark Wilkinson]

mwilkinson
Sun Sep 14 22:44:40 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv20093

Modified Files:
	Central.pm OntologyServer.pm 
Log Message:
writing in the expandRelationship function that is in the API but had not been implemented

moby-live/Perl/MOBY Central.pm,1.105,1.106 OntologyServer.pm,1.27,1.28
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.pm,v
retrieving revision 1.105
retrieving revision 1.106
diff -u -r1.105 -r1.106
--- /home/repository/moby/moby-live/Perl/MOBY/Central.pm	2003/09/01 17:21:14	1.105
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.pm	2003/09/15 02:44:40	1.106
@@ -2164,6 +2164,7 @@
  input XML :
 	<Relationships>
 	   <objectType>$term</objectType>
+	   <expandRelationship>1|0</expandRelationship>
 	   <relationshipType>$relationship_term</relationshipType>
 	   ... more relationship types
 	   ...
@@ -2171,6 +2172,7 @@
  OR
 	<Relationships>
 	   <serviceType>$term</serviceType>
+	   <expandRelationship>1|0</expandRelationship>
 	   <relationshipType>$relationship_term</relationshipType>
 	   ... more relationship types
 	   ...
@@ -2209,17 +2211,27 @@
 	my $ontology;
 	my $Parser = new XML::DOM::Parser;
 	my $doc = $Parser->parse($payload);
+
 	my $x = $doc->getElementsByTagName("relationshipType");
 	my $l = $x->getLength;  # might be a Collection object with multiple simples...
+
+	my $exp = $doc->getElementsByTagName("expandRelationship");
+	my $expl = $exp->getLength;  # might be a Collection object with multiple simples...
+
+	my $expand_relationship = &_nodeTextContent($doc, 'expandRelationship');
+	$expand_relationship =~ s/\s//g;
+	$expand_relationship ||=0;
+	
 	my @reltypes;
 	for (my $n=0; $n < $l; ++$n){
 		my @child = $x->item($n)->getChildNodes;
 		foreach (@child){
 			next unless ($_->getNodeType == TEXT_NODE);
-			my $name = $_->toString; chomp $name;
+			my $name .= $_->toString; $name =~ s/\s//g;
 			push @reltypes, $name;
 		}
 	}
+	
 	my $term =  &_nodeTextContent($doc, "objectType");
 	$ontology = "object" if $term;  # pick up the ontology "object" that we used here if we got an object term
 	$term ||= &_nodeTextContent($doc, "serviceType");  # if we didn't get anything using objectType try serviceType
@@ -2228,7 +2240,7 @@
 	$ontology ||="service";   # if we have now succeeded and haven't already taken the ontology then it must be the service ontology
 	&_LOG("Ontology was $ontology; Term was $term\n");
 	my $OS = MOBY::OntologyServer->new(ontology => $ontology);
-	my %rels = %{$OS->Relationships(term => $term)};
+	my %rels = %{$OS->Relationships(term => $term, expand => $expand_relationship)};
 
 	my $response="<Relationships>\n";
 	my $OSrel = MOBY::OntologyServer->new(ontology => 'relationship');

===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm	2003/08/16 15:51:32	1.27
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm	2003/09/15 02:44:40	1.28
@@ -643,20 +643,8 @@
     return \%response;
 }
 
-=head2 retrieveAllObjectTypes
-
-=cut
-
-sub retrieveAllObjectTypes {
-    my ($self) = @_;
-    my $types = $self->dbh->selectall_arrayref(q{select object_type, description from object});
-    my @types = @{$types};
-    my %response;    
-    foreach (@types){
-        $response{$_->[0]} = $_->[1];
-    }
-    return \%response;
-}
+*retrieveAllObjectTypes = \&retrieveAllObjectClasses;
+*retrieveAllObjectTypes = \&retrieveAllObjectClasses;
 
 =head2 getObjectCommonName
 
@@ -759,12 +747,14 @@
 =cut
 
 sub Relationships {
+    # this entire subroutine assumes that there is NOT multiple parenting!!
     my ($self, %args) = @_;
     my $ontology = $args{ontology}?$args{ontology}:$self->ontology;
     my $term = $args{term};
     my $relationship = $args{relationship};
     my $direction = $args{direction}?$args{direction}:'root';
-    
+    my $expand = $args{expand}?1:0;
+
     return unless ($ontology && $term && (($ontology eq 'service') || ($ontology eq 'object')));
     # convert $term into an LSID if it isn't already
     if ($ontology eq 'service'){
@@ -772,6 +762,25 @@
     } elsif ($ontology eq 'object'){
         $term = $self->getObjectURI($term);
     }
+    my %results;
+    while (($term ne 'urn:lsid:biomoby.org:objectclass:object') && ($term ne 'urn:lsid:biomoby.org:servicetype:service')){
+        my $defs = $self->_doRelationshipsQuery($ontology, $term, $relationship, $direction);
+        my $lsid; my $rel;
+        foreach (@{$defs}){
+            $lsid = $_->[0];
+            $rel = $_->[1];
+        $debug && _LOG("\t\tADDING RELATIONSHIP $_    :    $lsid to $rel\n");
+            push @{$results{$rel}}, $lsid;
+        }
+        last unless ($expand);
+        last unless ($direction eq "root");  # if we aren't going to root, then be careful or we'll loop infnitely
+        $term = $lsid;  # this entire subroutine assumes that there is NOT multiple parenting...
+    }
+    return \%results;  #results(relationship} = [lsid1, lsid2, lsid3]
+}
+
+sub _doRelationshipsQuery {
+    my ($self, $ontology, $term, $relationship, $direction) = @_;
     my $defs;
     if ($direction eq 'root'){
         unless (defined $relationship){
@@ -820,14 +829,7 @@
                 s2.${ontology}_lsid = ?", undef, $relationship, $term); # ")        
         }        
     }
-    my %results;
-    foreach (@{$defs}){
-        my $lsid = $_->[0];
-        my $rel = $_->[1];
-	$debug && _LOG("\t\tADDING RELATIONSHIP $_    :    $lsid to $rel\n");
-        push @{$results{$rel}}, $lsid;
-    }
-    return \%results;  #results(relationship} = [lsid1, lsid2, lsid3]
+    return $defs;
 }
 
 =head2 setURI