[MOBY-guts] biomoby commit

[Mark Wilkinson]

mwilkinson
Mon Jun  9 21:30:12 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY/Client
In directory pub.open-bio.org:/tmp/cvs-serv27376/MOBY/Client

Modified Files:
	Central.pm 
Log Message:
the client side wrapper for the new MOBY Cental function

moby-live/Perl/MOBY/Client Central.pm,1.29,1.30
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Client/Central.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- /home/repository/moby/moby-live/Perl/MOBY/Client/Central.pm	2003/06/06 00:45:47	1.29
+++ /home/repository/moby/moby-live/Perl/MOBY/Client/Central.pm	2003/06/10 01:30:12	1.30
@@ -113,13 +113,10 @@
 				default_MOBY_uri	=> ['http://mobycentral.cbr.nrc.ca/MOBY/Central',				'read/write'],
 				Registries              => [undef, 														'read/write'],
 				multiple_registries		=> [undef,														'read/write'],
-				#SOAP_connections		=> [undef, 														'read/write'],
-				#default_MOBY_servername => ['MOBYCentral',												'read/write'],
-				#default_MOBY_server 	=> ['http://66.92.95.2:mobycentral.cbr.nrc.ca/cgi-bin/MOBY-Central.pl', 	'read/write'],
-				#default_MOBY_uri		=> ['http://mobycentral.cbr.nrc.ca/MOBY/Central',				'read/write'],
-				#Registries              => [undef, 														'read/write'],
-				#multiple_registries		=> [undef,														'read/write'],
-		        
+				# SWITCH TO THESE FOR A LOCAL MOBY CENTRAL REGISTRY
+				#default_MOBY_server 	=> ['http://localhost/cgi-bin/MOBY-Central.pl', 	'read/write'],
+				#default_MOBY_uri		=> ['http://localhost/MOBY/Central',				'read/write'],
+				
 				);
 
    #_____________________________________________________________
@@ -1069,6 +1066,82 @@
 
 
 
+
+=head2 retrieveObjectDefinition
+
+ Title     :	retrieveObjectDefinition
+ Usage     :	$def = $MOBY->retrieveObjectDefinition($name, [$regname])
+ Function  :	To get the full definition of an object
+ Returns   :    returns hashref to an identical hash to the one that was passed to
+                registerObjectClass during initial registration of the object
+ Args      :	$name - object name (from ontology)
+
+=cut
+
+
+sub retrieveObjectDefinition {
+	# this contacts the ontology server to register
+	# the ontology and writes the resulting URI into
+	# the MOBY Central database
+	my ($self, $name, $reg) = @_;
+	my ($success, $message);
+	my %reghash;
+	return \%reghash unless defined $name && (!ref($name));
+	$message = "
+	<retrieveObjectDefinition>
+		 <objectType>$name</objectType>
+	</retrieveObjectDefinition>";
+	$reg =$reg?$reg:$self->default_MOBY_servername;
+	return undef unless ($self->SOAP_connection($reg));
+	my $payload = $self->SOAP_connection($reg)->call('retrieveObjectDefinition' => ($message))->paramsall;	
+	my ($term, $desc, $relationships, $email, $auth, $clobber) = &_registerObjectPayload($payload);
+	unless (defined $term && defined $desc && defined $auth && defined $email){
+		if ($term =~ /FAILED/){return undef}
+	}
+	$reghash{objectType} = $term;
+	$reghash{description} = $desc;
+	$reghash{contactEmail} = $email;
+	$reghash{authURI} = $auth;
+	$reghash{Relationships} = $relationships;
+	return \%reghash;
+}
+
+sub _registerObjectPayload {
+	my ($payload) = @_;
+	my $Parser = new XML::DOM::Parser;
+	my $doc = $Parser->parse($payload);
+	my $Object = $doc->getDocumentElement();
+	my $obj = $Object->getTagName;
+	return undef unless ($obj eq 'registerObjectClass');
+	
+	my $term = &_nodeTextContent($Object, "objectType");
+	my $desc = &_nodeTextContent($Object, "Description");
+	my $authURI = &_nodeTextContent($Object, "authURI");
+	my $email = &_nodeTextContent($Object, "contactEmail");
+	my %att_value; my %relationships;
+    my $x = $doc->getElementsByTagName("Relationship");
+    my $no_relationships = $x->getLength;
+    for (my $n=0; $n<$no_relationships; ++$n){
+		my $relationshipType = $x->item($n)->getAttributeNode('relationshipType');  # may or may not have a name
+		if ($relationshipType){$relationshipType = $relationshipType->getValue()} else {return "FAILED! must include a relationshipType in every relationship\n"}		
+		my @child = $x->item($n)->getChildNodes;
+		foreach (@child){
+			next unless $_->getNodeType == ELEMENT_NODE;
+			my $article = $_->getAttributeNode('articleName');  # may or may not have a name
+			if ($article){$article = $article->getValue()}
+
+			my @child2 = $_->getChildNodes;
+			foreach (@child2){
+				next unless $_->getNodeType == TEXT_NODE;
+				push @{$relationships{$relationshipType}}, [$_->toString, $article];
+			}
+		}
+	}
+	return ($term, $desc, \%relationships, $email,$authURI);
+
+}
+
+
 =head2 DUMP
 
  Title     :	DUMP