[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Wed Jun 18 22:57:02 UTC 2003
mwilkinson
Wed Jun 18 18:57:01 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv12078/Perl/MOBY
Modified Files:
Central.html Central.pm OntologyServer.pm
Log Message:
new method 'Relationships' will retrieve the top-level relationships (ISA, HASA, HAS) for the given Object or Service ontology term. Wrapped in MOBY::Client::Central. Documentation updated.
moby-live/Perl/MOBY Central.html,1.3,1.4 Central.pm,1.77,1.78 OntologyServer.pm,1.15,1.16
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.html,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- /home/repository/moby/moby-live/Perl/MOBY/Central.html 2003/06/11 20:36:59 1.3
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.html 2003/06/18 22:57:01 1.4
@@ -41,7 +41,7 @@
<li><a href="#retrieveobjectdefinition">retrieveObjectDefinition</a></li>
<li><a href="#retrievenamespaces">retrieveNamespaces</a></li>
<li><a href="#retrieveobject">retrieveObject</a></li>
- <li><a href="#isa">ISA</a></li>
+ <li><a href="#relationships">Relationships</a></li>
<li><a href="#dump">DUMP</a></li>
</ul>
@@ -656,6 +656,7 @@
</p>
<h2><a name="retrieveobject">retrieveObject</a></h2>
<pre>
+ NOT YET IMPLEMENTED
Title : retrieveObject
Usage : $objects = $MOBY->retrieveObject($inputXML)
Function : get the object xsd
@@ -677,33 +678,44 @@
</Objects></pre>
<p>
</p>
-<h2><a name="isa">ISA</a></h2>
+<h2><a name="relationships">Relationships</a></h2>
<pre>
- Title : ISA
- Usage : $objects = $MOBY->ISA($input_XML)
- Function : get the object xsd
- Returns : XML (see below)
- Args : $name - object name (from ontology) or "all" to get all objects
-
- inputXML :
- <ISA>
- <objectType>QueryObject</objectType>
- <ISA>
-
- outputXML :
+ Title : Relationships
+ Usage : $ns = $MOBY->Relationships()
+ Function : get the fist level of relationships for the given term
+ Returns : output XML (see below)
+ Args : Input XML (see below)
+ input XML :
<Relationships>
- <objectType>QueryObject</objectType>
- <ISA>
- <objectType>ParentObject</objectType>
- ...
- ...
- </ISA>
- <HASA>
- <objectType>ContainedObject</objectType>
- ...
- ...
- </HASA>
+ <objectType>$term</objectType>
+ </Relationships>
+ OR
+ <Relationships>
+ <serviceType>$term</serviceType>
</Relationships></pre>
+<pre>
+ outputXML :
+ <Relationships>
+ <Relationship relationshipType="RelationshipOntologyTerm">
+ <objectType>ExistingServiceType</objectType>
+ <objectType>ExistingServiceType</objectType>
+ </Relationship>
+ <Relationship relationshipType="AnotherRelationshipTerm">
+ ....
+ </Relationship>
+ </Relationships>
+
+ OR</pre>
+<pre>
+ <Relationships>
+ <Relationship relationshipType="RelationshipOntologyTerm">
+ <serviceType>ExistingServiceType</serviceType>
+ <serviceType>ExistingServiceType</serviceType>
+ </Relationship>
+ <Relationship relationshipType="AnotherRelationshipTerm">
+ ....
+ </Relationship>
+ </Relationships></pre>
<p>
</p>
<h2><a name="dump">DUMP</a></h2>
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.pm,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -r1.77 -r1.78
--- /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/06/11 20:36:59 1.77
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/06/18 22:57:01 1.78
@@ -2220,44 +2220,9 @@
}
-
-#=head2 objectClassDetails
-#
-# Title : objectClassDetails
-# Usage : $outputXML = $MOBY->objectClassDetails($inputXML)
-# Function : get the object details
-# Returns : XML (see below)
-# Args : $name - object name (from ontology) or "all" to get all objects
-#
-# inputXML :
-# <retrieveObject>
-# <objectType>ObjectType</objectType>
-# </retrieveObject>
-#
-# outputXML :
-# <Objects>
-# <Object name="namespace">
-# <Schema><XSD schema fragment here></Schema>
-# </Object>
-# ...
-# ...
-# </Objects>
-#
-#=cut
-
-
-sub objectClassDetails {
- my ($pkg, $payload) = @_;
- my $response = "<Objects>\n";
- $response .="<NOT_YET_IMPLEMENTED/>\n";
- $response .= "</Objects>\n";
- return $response;
-}
-
-
-
=head2 retrieveObject
+ NOT YET IMPLEMENTED
Title : retrieveObject
Usage : $objects = $MOBY->retrieveObject($inputXML)
Function : get the object xsd
@@ -2304,79 +2269,152 @@
-=head2 ISA
+=head2 Relationships
- Title : ISA
- Usage : $objects = $MOBY->ISA($input_XML)
- Function : get the object xsd
- Returns : XML (see below)
- Args : $name - object name (from ontology) or "all" to get all objects
-
- inputXML :
- <ISA>
- <objectType>QueryObject</objectType>
- <ISA>
-
- outputXML :
+ Title : Relationships
+ Usage : $ns = $MOBY->Relationships()
+ Function : get the fist level of relationships for the given term
+ Returns : output XML (see below)
+ Args : Input XML (see below)
+ input XML :
+ <Relationships>
+ <objectType>$term</objectType>
+ </Relationships>
+ OR
<Relationships>
- <objectType>QueryObject</objectType>
- <ISA>
- <objectType>ParentObject</objectType>
- ...
- ...
- </ISA>
- <HASA>
- <objectType>ContainedObject</objectType>
- ...
- ...
- </HASA>
+ <serviceType>$term</serviceType>
</Relationships>
-=cut
+ outputXML :
+ <Relationships>
+ <Relationship relationshipType="RelationshipOntologyTerm">
+ <objectType>ExistingServiceType</objectType>
+ <objectType>ExistingServiceType</objectType>
+ </Relationship>
+ <Relationship relationshipType="AnotherRelationshipTerm">
+ ....
+ </Relationship>
+ </Relationships>
+
+ OR
+
+ <Relationships>
+ <Relationship relationshipType="RelationshipOntologyTerm">
+ <serviceType>ExistingServiceType</serviceType>
+ <serviceType>ExistingServiceType</serviceType>
+ </Relationship>
+ <Relationship relationshipType="AnotherRelationshipTerm">
+ ....
+ </Relationship>
+ </Relationships>
-sub ISA {
- my ($pkg, $payload) = @_;
+=cut
- my $response = "<Objects>\n";
- $response .="<NOT_YET_IMPLEMENTED/>\n";
- $response .= "</Objects>\n";
- return $response;
- my $obj = &_ISAPayload($payload);
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
- my ($isa) = $dbh->selectrow_array("select id from RelationshipType where type = 'is a'");
- my ($hasa) = $dbh->selectrow_array("select id from RelationshipType where type = 'has a'");
-
- my %isa; my %hasa;
- &_flatten($dbh, $isa, $obj, \%isa);
- &_flatten($dbh, $hasa, $obj, \%isa);
-
- $response = "
- <Relationships>
- <objectType>$obj</objectType>
- <ISA>
- ";
- foreach (keys %isa){
- $response .= "<objectType>$_</objectType>";
- }
- $response .= "
- </ISA>
- <HASA>
- ";
- foreach (keys %hasa){
- $response .= "<objectType>$_</objectType>";
+sub Relationships {
+ my ($pkg, $payload) = @_;
+ my $ontology;
+ my $Parser = new XML::DOM::Parser;
+ my $doc = $Parser->parse($payload);
+ 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
+ return undef unless $term; # and bail out if we didn't succeed
+ $ontology ||="service"; # if we have now succeeded and haven't already taken the ontology then it must be the service ontology
+ my $OS = MOBY::OntologyServer->new(ontology => $ontology);
+ my %rels = %{$OS->Relationships(term => $term)};
+
+ my $response="<Relationships>\n";
+ while (my ($rel, $lsids) = each %rels){
+ $response .="<Relationship relationshipType='$rel'>\n";
+ foreach (@{$lsids}){
+ $response .="<${ontology}Type>$_</${ontology}Type>\n";
+ }
+ $response .= "</Relationship>\n";
}
- $response .= "
- </HASA>
- </Relationships>
- ";
+ $response .="</Relationships>\n";
+ return $response;
+}
- return $response;
-}
+
+#
+#
+#=head2 ISA
+#
+# Title : ISA
+# Usage : $objects = $MOBY->ISA($input_XML)
+# Function : get the object xsd
+# Returns : XML (see below)
+# Args : $name - object name (from ontology) or "all" to get all objects
+#
+# inputXML :
+# <ISA>
+# <objectType>QueryObject</objectType>
+# <ISA>
+#
+# outputXML :
+# <Relationships>
+# <objectType>QueryObject</objectType>
+# <ISA>
+# <objectType>ParentObject</objectType>
+# ...
+# ...
+# </ISA>
+# <HASA>
+# <objectType>ContainedObject</objectType>
+# ...
+# ...
+# </HASA>
+# </Relationships>
+#
+#=cut
+#
+#
+#
+#sub ISA {
+# my ($pkg, $payload) = @_;
+#
+# my $response = "<Objects>\n";
+# $response .="<NOT_YET_IMPLEMENTED/>\n";
+# $response .= "</Objects>\n";
+# return $response;
+#
+# my $obj = &_ISAPayload($payload);
+# my ($dbh, $sth_hash) = &_dbAccess;
+# my %sth = %{$sth_hash};
+# my ($isa) = $dbh->selectrow_array("select id from RelationshipType where type = 'is a'");
+# my ($hasa) = $dbh->selectrow_array("select id from RelationshipType where type = 'has a'");
+#
+# my %isa; my %hasa;
+# &_flatten($dbh, $isa, $obj, \%isa);
+# &_flatten($dbh, $hasa, $obj, \%isa);
+#
+# $response = "
+# <Relationships>
+# <objectType>$obj</objectType>
+# <ISA>
+# ";
+# foreach (keys %isa){
+# $response .= "<objectType>$_</objectType>";
+# }
+# $response .= "
+# </ISA>
+# <HASA>
+# ";
+# foreach (keys %hasa){
+# $response .= "<objectType>$_</objectType>";
+# }
+# $response .= "
+# </HASA>
+# </Relationships>
+# ";
+#
+# return $response;
+#
+#}
=head2 DUMP
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2003/06/10 23:01:26 1.15
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2003/06/18 22:57:01 1.16
@@ -72,6 +72,8 @@
use strict;
use Carp;
use vars qw($AUTOLOAD);
+use DBI;
+use DBD::mysql;
{
#Encapsulated class data
@@ -754,6 +756,7 @@
sub getServiceURI {
my ($self, $term) = @_;
+ return $term if $term =~ /urn\:lsid/;
my ($id) = $self->dbh->selectrow_array(q{select service_lsid from service where service_type = ?},undef,$term);
return $id;
}
@@ -764,6 +767,7 @@
sub getObjectURI {
my ($self, $term) = @_;
+ return $term if $term =~ /urn\:lsid/;
my ($id) = $self->dbh->selectrow_array(q{select object_lsid from object where object_type = ?},undef,$term);
return $id;
}
@@ -774,6 +778,7 @@
sub getNamespaceURI {
my ($self, $term) = @_;
+ return $term if $term =~ /urn\:lsid/;
my ($id) = $self->dbh->selectrow_array(q{select namespace_lsid from namespace where namespace_type = ?},undef,$term);
return $id;
}
@@ -782,7 +787,6 @@
=cut
-
sub getRelationshipTypes {
my ($self, %args) = @_;
my $ontology = $args{'ontology'};
@@ -794,13 +798,40 @@
return \%result;
}
-=head2 ISA
+=head2 Relationships
=cut
-sub ISA {
- my ($self, $expand) = @_;
+sub Relationships {
+ my ($self, %args) = @_;
+ my $ontology = $args{ontology}?$args{ontology}:$self->ontology;
+ my $term = $args{term};
+ my $expand = $args{expand};
+ return unless ($ontology && $term && (($ontology eq 'service') || ($ontology eq 'object')));
+ # convert $term into an LSID if it isn't already
+ if ($ontology eq 'service'){
+ $term = $self->getServiceURI($term);
+ } elsif ($ontology eq 'object'){
+ $term = $self->getObjectURI($term);
+ }
+
+ my $defs = $self->dbh->selectall_arrayref("
+ select s2.${ontology}_lsid, relationship_type from
+ ${ontology}_term2term as t2t,
+ $ontology as s1,
+ $ontology as s2
+ where
+ s1.${ontology}_id = t2t.${ontology}1_id and
+ s2.${ontology}_id = t2t.${ontology}2_id and
+ s1.${ontology}_lsid = ?", undef, $term); # ")
+ my %results;
+ foreach (@{$defs}){
+ my $lsid = $_->[0];
+ my $rel = $_->[1];
+ push @{$results{$rel}}, $lsid;
+ }
+ return \%results; #results(relationship} = [lsid1, lsid2, lsid3]
}
=head2 setURI
More information about the MOBY-guts
mailing list