[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Wed Oct 22 11:27:46 EDT 2003
mwilkinson
Wed Oct 22 10:27:46 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY/Client
In directory pub.open-bio.org:/tmp/cvs-serv6731/Perl/MOBY/Client
Modified Files:
Central.pm
Log Message:
repaired the retrieveObjectDefinition method. It isn't yet written up in the online API, but it is available in the pod documentation for MOB::Central and MOBY::Client::Central. This method is used to retrieve the definition of an object (i.e. its ISA and HASA relationships and articleName attributes). It DOES NOT traverse the ontology, so you don't see the details of contained objects - they must be queried independently.
moby-live/Perl/MOBY/Client Central.pm,1.56,1.57
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Client/Central.pm,v
retrieving revision 1.56
retrieving revision 1.57
diff -u -r1.56 -r1.57
--- /home/repository/moby/moby-live/Perl/MOBY/Client/Central.pm 2003/10/18 20:34:58 1.56
+++ /home/repository/moby/moby-live/Perl/MOBY/Client/Central.pm 2003/10/22 14:27:46 1.57
@@ -378,6 +378,93 @@
}
+
+=head2 retrieveObjectDefinition
+
+ Title : retrieveObjectDefinition
+ Usage : $DEF = $MOBY->retrieveObjectDefinition($objectType[,$registry])
+ Function : retrieve the $XML that was used to register an object and its relationships
+ Returns : hashref, identical to the hash sent during Object registration, plus
+ an additional XML hash key that contains the actual XML containing
+ the object definition as sent by MOBY Central (used for a visual
+ overview, rather than parsing all of the hash keys)
+ objectType => "the name of the Object"
+ description => "a human-readable description of the object"
+ contactEmail => "your at email.address"
+ authURI => "URI of the registrar of this object"
+ Relationships => {
+ relationshipType1 => [
+ [Object1, articleName],
+ [Object2, articleName]],
+ relationshipType2 => [
+ [Object1, articleName]]}
+ XML => <....XML of object registration.../>
+
+ Args : objectType => the name or LSID URI for an object
+
+=cut
+
+sub retrieveObjectDefinition {
+
+ my ($self, $id, $reg) = @_;
+ return $self->errorRegXML("Function not allowed when querying multiple registries") if $self->multiple_registries;
+ my %def;
+ return \%def unless $id;
+
+ my $message = "
+ <retrieveObjectDefinition>
+ <objectType>$id</objectType>
+ </retrieveObjectDefinition>";
+ my ($return) = $self->_call('default', 'retrieveObjectDefinition', $message);
+
+ return \%def unless $return;
+ my ($term, $desc, $relationships, $email, $authURI) = &_ObjectDefinitionPayload($return);
+ $def{objectType} = $term;
+ $def{description} = $desc;
+ $def{contactEmail} = $email;
+ $def{authURI} = $authURI;
+ $def{Relationships} = $relationships;
+ $def{XML} = $return;
+ return (\%def);
+
+}
+
+sub _ObjectDefinitionPayload {
+ 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 'retrieveObjectDefinition');
+
+ 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){
+ #print $_->getNodeTypeName, "\t", $_->toString,"\n";
+ next unless $_->getNodeType == TEXT_NODE;
+ push @{$relationships{$relationshipType}}, [$_->toString, $article];
+ }
+ }
+ }
+ return ($term, $desc, \%relationships, $email,$authURI);
+}
+
+
=head2 registerServiceType
Title : registerServiceType
@@ -1195,85 +1282,6 @@
}
-
-
-=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->Connection($reg));
-# my $payload = $self->SOAP_connection($reg)->call('retrieveObjectDefinition' => ($message))->paramsall;
- my ($return) = $self->_call($reg, 'retrieveObjectDefinition', $message);
- my ($term, $desc, $relationships, $email, $auth, $clobber) = &_registerObjectPayload($return);
- 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 Relationships
Title : Relationships
@@ -1409,7 +1417,7 @@
$reg =$reg?$reg:$self->default_MOBY_servername;
return undef unless ($self->Connection($reg));
# return $self->SOAP_connection($reg)->call('DUMP')->paramsall;
- my $SQLs = $self->_call($reg, 'DUMP_MySQL', "");
+ my ($SQLs) = $self->_call($reg, 'DUMP_MySQL', "");
my ($mobycentral, $mobyobject, $mobyservice, $mobynamespace, $mobyrelationship) = @{$SQLs};
return ($mobycentral, $mobyobject, $mobyservice, $mobynamespace, $mobyrelationship);
}
More information about the MOBY-guts
mailing list