[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Mon Jun 23 21:58:45 UTC 2003
mwilkinson
Mon Jun 23 17:58:45 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv5434/MOBY
Modified Files:
Central.pm OntologyServer.pm
Log Message:
Whhhrrrrrrrr.... traversal of ontology kicks back into life. The flags 'expandServices' and 'expandObjects' should now be active on the findService call. expandObject will traverse the ISA relationship (only) all the way back to root so that you discover services that operate on that object or any parent object type. expandService will traverse the ISA relationship (only) of services all the way to the leaves so you get the general service type you requested, or service types that are more specific than the one you requested
moby-live/Perl/MOBY Central.pm,1.80,1.81 OntologyServer.pm,1.21,1.22
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.pm,v
retrieving revision 1.80
retrieving revision 1.81
diff -u -r1.80 -r1.81
--- /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/06/20 20:25:06 1.80
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/06/23 21:58:45 1.81
@@ -19,7 +19,7 @@
use MOBY::service_instance;
use MOBY::central_db_connection;
-my $debug = 0;
+my $debug = 1;
if ($debug){open (OUT, ">/tmp/CentralRegistryLogOut.txt") || die "cant open logfile\n";print OUT "created logfile\n";close OUT;}
@@ -1597,17 +1597,17 @@
sub findService {
my ($pkg, $payload) = @_;
$debug && &_LOG("\nLOOKING FOR SERVICES\n");
- #return ('serviceType' => $serviceType,
- # 'authURI' => $AuthURI,
- # 'servicename' => $AuthURI,
- # 'expandObjects' => $expandObjects,
- # 'expandServices' => $expandServices,
- # 'authoritative' => $authoritative,
- # 'category' => $Category,
- # 'inputObjects' => $INPUTS,
- # 'outputObjects' => $OUTPUTS,
- # 'keywords' => \@kw);
my %findme = &_findServicePayload($payload);
+
+ $debug && &_LOG ("'serviceType' => $findme{serviceType},
+ 'authURI' => $findme{AuthURI},
+ 'servicename' => $findme{servicename},
+ 'expandObjects' => $findme{expandObjects},
+ 'expandServices' => $findme{expandServices},
+ 'authoritative' => $findme{authoritative},
+ 'category' => $findme{Category},
+ ");
+
my %valid_service_ids;
my $criterion_count=0;
# we want to avoid joins, since they slow things down, so...
@@ -1634,7 +1634,16 @@
return &_serviceListResponse($dbh,undef);
}
++$criterion_count;
- my $ids = $dbh->selectall_arrayref(q{select service_instance_id from service_instance where service_type_uri=?}, undef, $URI);
+ my $children_string = "'$URI',";
+ if ($findme{'expandServices'}){
+ $debug && _LOG("Expanding Objects\n");
+ my $OS = MOBY::OntologyServer->new(ontology => 'service');
+ my %relationships = %{$OS->traverseDAG($URI, "leaves")};
+ my (@children) = @{$relationships{'urn:lsid:biomoby.org:servicerelation:isa'}};
+ $children_string .= (join ',', map {"\'$_\'"} @children);
+ }
+ $children_string =~ s/\,$//;
+ my $ids = $dbh->selectall_arrayref("select service_instance_id from service_instance where service_type_uri in ($children_string)");
foreach (@{$ids}){
++$valid_service_ids{$_->[0]}; # increment that particular id's count by one
}
@@ -1702,14 +1711,15 @@
++$criterion_count;
my $obj = (shift @{$findme{inputObjects}});
my @si_ids;
- @si_ids = &_searchForServicesWithArticle($dbh, "input", $obj,'') if defined $obj;
+ @si_ids = &_searchForServicesWithArticle($dbh, "input", $obj, $findme{'expandObjects'}, '') if defined $obj;
my %instances;
# we need to do a join, without doing a join...
if (scalar @si_ids){
map {$instances{$_}=1} @si_ids; # get an id of the good services from the first object
while (my $obj = shift(@{$findme{inputObjects}})){ # iterate through the rest of the objects
next unless $obj;
- my @new_ids = &_searchForServicesWithArticle($dbh, "input", $obj,''); # get their service ids
+ $debug && _LOG("FIRST: ", $dbh, "input", $obj, $findme{'expandObjects'}, '');
+ my @new_ids = &_searchForServicesWithArticle($dbh, "input", $obj, $findme{'expandObjects'}, ''); # get their service ids
my @good_ids;my %good_ids;
foreach my $id(@new_ids){ # check the new id set against the set we know is already valid
next unless defined $id;
@@ -1728,7 +1738,7 @@
++$criterion_count;
my $obj = (shift @{$findme{outputObjects}});
my @si_ids;
- @si_ids = &_searchForServicesWithArticle($dbh, "output", $obj,'') if defined $obj;
+ @si_ids = &_searchForServicesWithArticle($dbh, "output", $obj, '') if defined $obj;
my %instances;
# we need to do a join, without doing a join...
if (scalar @si_ids){
@@ -1761,12 +1771,12 @@
}
sub _searchForServicesWithArticle {
- my ($dbh, $inout, $node, $coll) = @_; # coll is set if we are already searching
+ my ($dbh, $inout, $node, $expand, $coll) = @_; # coll is set if we are already searching
# the Simple articles within a Collection
# if we are, then an additional criterion of a common collection_inout_id
# is added to the query.... somehow...
return () unless $node->getNodeType == ELEMENT_NODE; # this will erase all current successful service instances!
-
+ $debug && _LOG("searchServWthArticle ",$dbh, $inout, $node, $expand, $coll);
# this element node may be a Simple or a Collection object
my $simp_coll = $node->getTagName;
$debug && &_LOG("TAGNAME in _searchForArticle is $simp_coll");
@@ -1784,7 +1794,7 @@
#}
#@collids = &_searchForCollectedSimples($dbh, $inout, \@simples);
} elsif ($simp_coll eq "Simple") {
- @valid_ids = &_searchForSimple($dbh,$node, $inout);
+ @valid_ids = &_searchForSimple($dbh,$node, $expand, $inout);
}
return @valid_ids;
@@ -1793,18 +1803,27 @@
sub _searchForSimple {
# returns list of service_instance ID's
# that match this simple
- my ($dbh,$node, $inout) = @_;
+ my ($dbh,$node, $expand, $inout) = @_;
+ $debug && _LOG($dbh,$node, $expand, $inout);
my ($objectURI, $namespaceURIs) = &_extractObjectTypesAndNamespaces($node); # ref of $hash{type}=[ns1, ns2, ns3]
unless ($objectURI){return ()};
-
+ my $ancestor_string = "'$objectURI',";
+ if ($expand){
+ $debug && _LOG("Expanding Objects\n");
+ my $OS = MOBY::OntologyServer->new(ontology => 'object');
+ my %relationships = %{$OS->traverseDAG($objectURI, "root")};
+ my (@ancestors) = @{$relationships{'urn:lsid:biomoby.org:objectrelation:isa'}};
+ $ancestor_string .= (join ',', map {"\'$_\'"} @ancestors);
+ }
+ $ancestor_string =~ s/\,$//;
my $nsquery;
foreach my $ns(@{$namespaceURIs}){ # namespaces are already URI's
$nsquery .=" OR namespace_type_uri like '%$ns%' ";
}
if ($nsquery){$nsquery =~ s/OR//;} # just the first
- my $query = "select distinct service_instance_id from simple_$inout where object_type_uri = '$objectURI' and service_instance_id IS NOT NULL ";# if service_instance_id is null then it must be a collection input.
+ my $query = "select distinct service_instance_id from simple_$inout where object_type_uri in ($ancestor_string) and service_instance_id IS NOT NULL ";# if service_instance_id is null then it must be a collection input.
($nsquery) && ($query .=" AND ($nsquery) ");
- #print "\nQUERY $query\n";
+ $debug && _LOG("\nQUERY $query\n");
my $nsref = $dbh->selectall_arrayref($query);
my @ids;
foreach (@{$nsref}){
@@ -1818,7 +1837,7 @@
my ($dbh, $inout, $simples)= @_;
my $query;
foreach my $node(@{$simples}){
- my ($objectURI, $namespaceURIs) = &_extractObjectTypesAndNamespaces($node); # ref of $hash{type}=[ns1, ns2, ns3]
+ my ($objectURI, $namespaceURIs) = &_extractObjectTypesAndNamespaces($node);
my $nsquery;
foreach my $ns(@{$namespaceURIs}){ # namespaces are already URI's
$nsquery .=" OR namespace_type_uri like '%$ns%' ";
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2003/06/23 20:29:58 1.21
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2003/06/23 21:58:45 1.22
@@ -734,8 +734,9 @@
my ($self, %args) = @_;
my $ontology = $args{ontology}?$args{ontology}:$self->ontology;
my $term = $args{term};
- my $expand = $args{expand};
my $relationship = $args{relationship};
+ my $direction = $args{direction}?$args{direction}:'root';
+
return unless ($ontology && $term && (($ontology eq 'service') || ($ontology eq 'object')));
# convert $term into an LSID if it isn't already
if ($ontology eq 'service'){
@@ -744,27 +745,52 @@
$term = $self->getObjectURI($term);
}
my $defs;
- unless (defined $relationship){
- $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); # ")
+ if ($direction eq 'root'){
+ unless (defined $relationship){
+ $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); # ")
+ } else {
+ $defs = $self->dbh->selectall_arrayref("
+ select s2.${ontology}_lsid, relationship_type from
+ ${ontology}_term2term as t2t,
+ $ontology as s1,
+ $ontology as s2
+ where
+ relationship_type = ? and
+ s1.${ontology}_id = t2t.${ontology}1_id and
+ s2.${ontology}_id = t2t.${ontology}2_id and
+ s1.${ontology}_lsid = ?", undef, $relationship, $term); # ")
+ }
} else {
- $defs = $self->dbh->selectall_arrayref("
- select s2.${ontology}_lsid, relationship_type from
- ${ontology}_term2term as t2t,
- $ontology as s1,
- $ontology as s2
- where
- relationship_type = ? and
- s1.${ontology}_id = t2t.${ontology}1_id and
- s2.${ontology}_id = t2t.${ontology}2_id and
- s1.${ontology}_lsid = ?", undef, $relationship, $term); # ")
+ unless (defined $relationship){
+ $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
+ s2.${ontology}_lsid = ?", undef, $term); # ")
+ } else {
+ $defs = $self->dbh->selectall_arrayref("
+ select s2.${ontology}_lsid, relationship_type from
+ ${ontology}_term2term as t2t,
+ $ontology as s1,
+ $ontology as s2
+ where
+ relationship_type = ? and
+ s1.${ontology}_id = t2t.${ontology}1_id and
+ s2.${ontology}_id = t2t.${ontology}2_id and
+ s2.${ontology}_lsid = ?", undef, $relationship, $term); # ")
+ }
}
my %results;
foreach (@{$defs}){
@@ -803,10 +829,12 @@
=cut
sub traverseDAG {
- my ($self, $term) = @_;
+ my ($self, $term, $direction) = @_;
my $ontology = $self->ontology;
return {} unless $ontology;
return {} unless $term;
+ $direction="root" unless ($direction);
+ return {} unless (($direction eq 'root') || ($direction eq 'leaves'));
if ($ontology eq 'service'){
$term = $self->getServiceURI($term);
} elsif ($ontology eq 'object'){
@@ -826,7 +854,7 @@
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
- my $lsids = $self->Relationships(term => $term, relationship => $relationship); # get the related terms for this type; this should return a single hash value
+ 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}
} else {
More information about the MOBY-guts
mailing list