[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Fri Feb 21 00:15:44 UTC 2003
mwilkinson
Thu Feb 20 19:15:44 EST 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv26952/Perl/MOBY
Modified Files:
Central.pm
Log Message:
implemented GOOBY :-) MOBY-Central is now able to register CGI services, and provide you with a URL and a GET string in sprintf format ready for you to pass parameters to. This is trez cool :-) I will commit a sample GOOBY client script in a minute and will register a few CGI services for you to GOOBY for yourself.
moby-live/Perl/MOBY Central.pm,1.5,1.6
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/02/20 02:23:33 1.5
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/02/21 00:15:44 1.6
@@ -17,7 +17,7 @@
-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;}
@@ -187,7 +187,7 @@
$sth{check_namespace} = ("select OE.id from OntologyEntry as OE, Ontology as O where term=? and ontology_id = O.id and O.name='MOBY_Namespace'");
$sth{check_service_type} = ("select OE.id from OntologyEntry as OE, Ontology as O where OE.term = ? and O.id = OE.ontology_id and O.name = 'MOBY_Service'");
$sth{check_service} = ("select S.id from Service as S where auth_uri = ? and service_name = ?");
- $sth{insert_service} = ("insert into Service (service_name, service_type_id, auth_uri, url, description, catagory, registration_identifier) values (?,?,?,?,?,?,?)");
+ $sth{insert_service} = ("insert into Service (service_name, service_type_id, auth_uri, url, description, category, registration_identifier) values (?,?,?,?,?,?,?)");
$sth{insert_parameter} = ("insert into ServiceParameter (service_id, ontologyentry_id, type) values (?,?,?)");
# queries required for Deregistration
@@ -683,9 +683,10 @@
my $type = &_nodeTextContent($Object, "serviceType");
my $desc = &_nodeTextContent($Object, "Description");
my @ISA = &_nodeArrayContent($Object, "ISA");
- my $clobber = &_nodeTextContent($Object, "Clobber");
+# my $clobber = &_nodeTextContent($Object, "Clobber");
$debug && &_LOG("got $type, $desc, @ISA from registerServiceTypePayload\n");
- return ($type, $desc, \@ISA, $clobber);
+# return ($type, $desc, \@ISA, $clobber);
+ return ($type, $desc, \@ISA);
}
@@ -1001,6 +1002,7 @@
return &_nodeTextContent($Object, "namespaceAcc");
}
+
=head2 registerService
Title : registerService
@@ -1084,7 +1086,7 @@
sub registerService {
my ($pkg, $payload) = @_;
- my ($serviceName, $serviceType, $AuthURI, $INS, $OUTS, $NSS, $URL, $desc, $Category) = &_registerServicePayload($payload);
+ my ($serviceName, $serviceType, $AuthURI, $URL, $desc, $Category) = &_registerServicePayload($payload);
unless ($Category){ # throw error if parameter missing
$debug && &_LOG("Category missing from $payload\n");
@@ -1095,7 +1097,7 @@
});
return $reg;
}
- unless (grep {/$Category/} ("est", "cgi", "moby")){ # throw error if parameter missing
+ unless (($Category eq "est") || ($Category eq "cgi") || ($Category eq "moby")){ # throw error if parameter missing
$debug && &_LOG("Category $Category invalid\n");
my $reg = &Registration({
success => 0,
@@ -1104,12 +1106,13 @@
});
return $reg;
}
- my ($moby, $cgi, $soap);
- $moby = $Category eq "moby"?1:0;
- $cgi = $Category eq "cgi"?1:0;
- $soap = $Category eq "soap"?1:0;
-
- if ($moby){
+
+ my ($INS, $OUTS, $NSS);
+
+ $debug && &_LOG("Entering switch with $Category method\n");
+
+ if ($Category eq "moby") {
+ ($INS, $OUTS, $NSS ) = &_registerMOBYServicePayload($payload);
unless ($serviceName && $serviceType && $AuthURI && $INS && $OUTS && $URL && $desc){ # throw error if parameter missing
$debug && &_LOG("$serviceName && $serviceType && $AuthURI && $INS && $OUTS && $URL && $desc");
my $reg = &Registration({
@@ -1119,7 +1122,8 @@
});
return $reg;
}
- } elsif ($cgi){
+ } elsif ($Category eq "cgi") {
+ ($INS ) = &_registerCGIServicePayload($payload);
unless ($serviceName && $serviceType && $AuthURI && $INS && $URL && $desc){ # throw error if parameter missing
$debug && &_LOG("$serviceName && $serviceType && $AuthURI && $INS && $URL && $desc");
my $reg = &Registration({
@@ -1129,9 +1133,9 @@
});
return $reg;
}
- } elsif ($soap){
+ } elsif ($Category eq "soap") {
unless ($serviceName && $serviceType && $AuthURI && $URL && $desc){ # throw error if parameter missing
- $debug && &_LOG("$serviceName && $serviceType && $AuthURI && $INS && $OUTS && $URL && $desc");
+ $debug && &_LOG("$serviceName && $serviceType && $AuthURI && $desc");
my $reg = &Registration({
success => 0,
error_message => "not all required parameters present",
@@ -1139,17 +1143,26 @@
});
return $reg;
}
+ } else {
+ my $reg = &Registration({
+ success => 0,
+ error_message => "Category must be one of 'moby', 'cgi' or 'soap'",
+ registration_id => "",
+ });
+ return $reg;
}
my ($dbh, $sth_hash) = &_dbAccess;
+
+ if ($Category eq "soap"){return &_registerSOAPService($dbh, $sth_hash,$serviceName,$serviceType,$AuthURI,$URL,$desc)}
+ elsif ($Category eq "cgi"){return &_registerCGIService($dbh, $sth_hash,$serviceName , $serviceType, $AuthURI , $INS , $URL , $desc)}
+
+ # else - this is a MOBY service
my %sth = %{$sth_hash};
my @IN = @{$INS};
my @OUT = @{$OUTS};
my @NS = @{$NSS};
- if ($soap){&_registerSOAPService($dbh, $sth_hash,$serviceName,$serviceType,$AuthURI,$URL,$desc)}
- elsif ($cgi){&_registerCGIService($dbh, $sth_hash,$serviceName , $serviceType, $AuthURI , $INS , $URL , $desc)}
-
unless (scalar @IN && scalar @OUT){ # throw error if parameter missing
my $reg = &Registration({
success => 0,
@@ -1235,7 +1248,7 @@
}
$sth = $dbh->prepare($sth{insert_service});
- $sth->execute($serviceName,$service_type_id, $AuthURI, $URL, $desc, $reg_id);
+ $sth->execute($serviceName,$service_type_id, $AuthURI, $URL, $desc, $Category, $reg_id);
my $service_id = $dbh->{mysql_insertid};
foreach my $IN(@IN){
@@ -1283,9 +1296,6 @@
my $type = &_nodeTextContent($Object, "serviceType");
my $authURI = &_nodeTextContent($Object, "authURI");
- my $inputRoot = $Object->getElementsByTagName("inputObjects")->item(0);
-
- my @OUTS = &_nodeArrayContent($Object, "outputObjects");
my $URL = &_nodeTextContent($Object, "URL");
my $desc = &_nodeTextContent($Object, "Description");
@@ -1294,6 +1304,20 @@
# way to represent that in the database yet anyway
# so poop on it!
+
+ return ($name, $type, $authURI, $URL, $desc, $Category);
+}
+
+sub _registerMOBYServicePayload {
+ my ($payload) = @_;
+ $debug && &_LOG("Registering a MOBY Service\n");
+ my $Parser = new XML::DOM::Parser;
+ my $doc = $Parser->parse($payload);
+ my $Object = $doc->getDocumentElement();
+ my $obj = $Object->getTagName;
+ return undef unless ($obj eq 'registerService');
+ my $inputRoot = $Object->getElementsByTagName("inputObjects")->item(0);
+ my @OUTS = &_nodeArrayContent($Object, "outputObjects");
my @types = $inputRoot->getElementsByTagName("objectType");
my @namespaces = $inputRoot->getElementsByTagName("namespaceType");
my (@INS, @NSS);
@@ -1313,12 +1337,38 @@
push @NSS, $_->toString;
}
}
+ return (\@INS, \@OUTS, \@NSS);
+}
- return ($name, $type, $authURI, \@INS, \@OUTS, \@NSS, $URL, $desc);
+sub _registerCGIServicePayload {
+ my ($payload) = @_;
+ $debug && &_LOG("Registering a CGI Service\n");
+ my $Parser = new XML::DOM::Parser;
+ my $doc = $Parser->parse($payload);
+ my $Object = $doc->getDocumentElement();
+ my $obj = $Object->getTagName;
+ return undef unless ($obj eq 'registerService');
+ my $inputRoot = $Object->getElementsByTagName("inputObjects")->item(0);
+ my @types = $inputRoot->getElementsByTagName("Input");
+ my $IN;
+ foreach (@types){
+ $debug && &_LOG("register CGI type $_\n\n");
+ my @child2 = $_->getChildNodes;
+ foreach (@child2){
+ #print $_->getNodeTypeName, "\t", $_->toString,"\n";
+ next unless $_->getNodeType == TEXT_NODE;
+ $IN = $_->toString;
+ }
+ }
+ $debug && &_LOG("got string $IN\n\n");
+
+ return ($IN);
}
+
sub _registerSOAPService {
my ($dbh, $sths,$serviceName,$serviceType,$AuthURI,$URL,$desc) = @_;
+ $debug && &_LOG("Registering a SOAP Service\n");
my %sth = %{$sths};
my $sth = $dbh->prepare($sth{check_service_type});
$sth->execute($serviceType);
@@ -1365,8 +1415,8 @@
my ($dbh, $sths,$serviceName , $serviceType, $AuthURI , $INS , $URL , $desc) = @_;
my %sth = %{$sths};
- my @IN = @{$INS};
- unless (scalar @IN){ # throw error if parameter missing
+
+ unless ($INS){ # throw error if parameter missing
my $reg = &Registration({
success => 0,
error_message => "must include an sprintf formatted string indicating your HTTP GET query string",
@@ -1422,7 +1472,7 @@
}
$sth = $dbh->prepare($sth{insert_service});
- $sth->execute($serviceName,$service_type_id, $AuthURI, $URL, $desc, $reg_id);
+ $sth->execute($serviceName,$service_type_id, $AuthURI, $URL, $desc, "cgi", $reg_id);
my $service_id = $dbh->{mysql_insertid};
my $obj_id;
@@ -1441,15 +1491,13 @@
}
- foreach my $IN(@IN){
$sth = $dbh->prepare($sth{register_object_xsd});
- $sth->execute($obj_id,"$AuthURI-$serviceName" , $IN);
+ $sth->execute($obj_id,"$AuthURI-$serviceName" , $INS);
$sth = $dbh->prepare($sth{check_object});
- $sth->execute($IN);
+ $sth->execute("$AuthURI-$serviceName");
my ($ontologyentry_id) = $sth->fetchrow_array; # returns the index number, might be zero
$sth = $dbh->prepare($sth{insert_parameter});
$sth->execute($service_id, $ontologyentry_id, "in");
- }
my $reg = &Registration({
success => 1,
@@ -1540,6 +1588,129 @@
}
+
+=head2 locateServiceByKeywords
+
+ Title : locateServiceBykeywords
+ Usage : $services = $MOBY->locateServiceByKeywords($inputXML)
+ Function : get the service names/descriptions for a particular type of Service
+ (and child-types)
+ Returns : XML (see below)
+ inputXML :
+ <locateServiceByKeywords>
+ <keyword>keyword</keyword>
+ <keyword>keyword</keyword>
+ ...
+ ...
+ </locateServiceByKeywords>
+
+ outputXML :
+ <Services>
+ <Service authURI="authority.info.here" serviceName="MyService">
+ <serviceType>Service_Ontology_Term</serviceType>
+ <outputObject>Object_Ontology_Term</outputObject>
+ <Description><![CDATA[free text description here]]></Description>
+ </Service>
+ ...
+ ...
+ </Services>
+
+
+=cut
+
+
+sub locateServiceByKeywords{
+ my ($pkg, $payload) = @_;
+
+ my (@keywords) = @{&_locateServiceByKeywordPayload($payload)};
+ return undef unless scalar @keywords;
+ my ($dbh, $sth_hash) = &_dbAccess;
+ my %sth = %{$sth_hash};
+ my $response = "<Services>\n";
+ foreach (@keywords){
+ my $term = "%$_%";
+ # keys %ServiceIDs now contains the index number of all service types down the hierarchy from where we started (inclusive)
+ # now we need to find all service providors who which map to those types of services
+
+ my $query = "
+ Select
+ S.service_name,
+ OE.term,
+ S.auth_uri,
+ S.description,
+ OEtype.term,
+ S.category
+ from
+ Service as S,
+ OntologyEntry as OEtype,
+ OntologyEntry as OE,
+ ServiceParameter as SP,
+ Ontology as O
+ where
+ OEtype.is_obselete = 'n'
+ and OE.is_obselete = 'n'
+ and (SP.type = 'out' OR SP.type= 'in')
+ and SP.service_id = S.id
+ and OEtype.id = S.service_type_id
+ and OEtype.ontology_id = O.id
+ and OE.id = SP.ontologyentry_id
+ and O.name='MOBY_Service'
+ and (
+ (OEtype.term like '$term')
+ OR (OE.term like '$term')
+ OR (S.description like '$term')
+ OR (S.auth_uri like '$term')
+ OR (S.service_name like '$term')
+ )";
+
+ $debug && &_LOG("QURY IS $query\n");
+
+ my $this_query = $dbh->prepare($query);
+ $this_query->execute();
+# $this_query->execute($term, $term, $term, $term, $term, $term);
+ my %seen;
+ while (my ($serviceName, $objectOUT, $AuthURI,$desc, $type, $cat) =$this_query->fetchrow_array()){
+ $debug && &_LOG("$serviceName, $objectOUT, $AuthURI,$desc, $type, $cat\n");
+ next if $seen{"$AuthURI"."||"."$serviceName"} == 1; # non-redundant list please
+ $seen{"$AuthURI"."||"."$serviceName"} = 1;
+ $response .="<Service authURI='$AuthURI' serviceName='$serviceName'>\n";
+ $response .="<Catagory>$cat</Catagory>\n";
+ $response .="<serviceType>$type</serviceType>\n";
+ $response .="<outputObject>$objectOUT</outputObject>\n";
+ $response .= "<Description><![CDATA[$desc]]></Description>\n";
+ $response .= "</Service>\n";
+ }
+ }
+ $response .= "</Services>\n";
+ $debug && &_LOG("\nFINAL RESPONSE IS \n$response\n\n");
+ return $response;
+}
+
+
+sub _locateServiceByKeywordPayload {
+ my ($payload) = @_;
+ my $Parser = new XML::DOM::Parser;
+ $debug && &_LOG("parsing $payload\n");
+ my $doc = $Parser->parse("$payload");
+ $debug && &_LOG("parsed $payload\n");
+ my $Object = $doc->getDocumentElement();
+ my @kw;
+ my @x = $doc->getElementsByTagName("keyword");
+ foreach (@x){
+ my @child = $_->getChildNodes;
+ foreach (@child){
+ next unless $_->getNodeType == TEXT_NODE;
+ push @kw, $_->toString;
+ }
+ }
+
+ $debug && &_LOG("found keywords @kw\n");
+ return (\@kw);
+}
+
+
+
+
=head2 locateServiceByType
Title : locateServiceByType
@@ -1593,7 +1764,8 @@
OEout.term,
S.auth_uri,
S.description,
- OEtype.term
+ OEtype.term,
+ S.category
from
Service as S,
OntologyEntry as OEtype,
@@ -1720,7 +1892,8 @@
OEout.term,
S.auth_uri,
S.description,
- OEtype.term
+ OEtype.term,
+ S.category
from
Service as S,
OntologyEntry as OEtype,
@@ -1871,7 +2044,8 @@
OEout.term,
S.auth_uri,
S.description,
- OEtype.term
+ OEtype.term,
+ S.category
from
Service as S,
Ontology as O,
@@ -1937,8 +2111,18 @@
<serviceName>DesiredServiceName</serviceName>
<retrieveService>
- outputXML :
- <Service><![CDATA[WSDL document here]]</Service>
+ outputXML (by category):
+
+ moby: <Service><![CDATA[WSDL document here]]</Service>
+
+ cgi : <Service>
+ <serviceName>NameOfService</serviceName>
+ <URL>http://service.url.here</URL>
+ <GETstring>sprintf_formatted_GET_string</GETstring>
+ <Description>
+ <![CDATA[human readable description here]]>
+ </Description>
+ </Service>
=cut
@@ -1957,21 +2141,40 @@
my $query = "
select
S.id,
- S.service_name,
- S.auth_uri,
S.url,
- S.description
+ S.description,
+ S.category
from
Service as S
where
- service_name = '$serviceName'
- and S.auth_uri = '$AuthURI'";
- my $wsdl = &_getServiceWSDL($dbh, $sth_hash, $query);
- if ($wsdl){
- $wsdls .= "<Service><![CDATA[$wsdl]]></Service>\n";
- }
- #$debug && &_LOG("WSDL_________________$wsdls\n____________________");
- return $wsdls;
+ service_name = ?
+ and S.auth_uri = ?";
+ my $this_query = $dbh->prepare($query);
+ $this_query->execute($serviceName, $AuthURI);
+ my ($id, $URL, $desc, $category) =$this_query->fetchrow_array();
+
+ $debug && &_LOG( "getting $category service description\n");
+ if ($category eq 'moby'){
+ my $wsdl = &_getServiceWSDL($dbh, $sth_hash, $id, $serviceName, $AuthURI, $URL, $desc, $category);
+ if ($wsdl){
+ $wsdls .= "<Service><![CDATA[$wsdl]]></Service>\n";
+ }
+ #$debug && &_LOG("WSDL_________________$wsdls\n____________________");
+ return $wsdls;
+ } elsif ($category eq 'cgi'){
+ my $serviceString = &_getCGIService($dbh, $sth_hash, $id, $serviceName, $AuthURI, $URL, $desc, $category);
+ my $service = "<Service>
+ <CGIService>
+ <serviceName>$serviceName</serviceName>
+ <URL>$URL</URL>
+ $serviceString
+ <Description><![CDATA[$desc]]></Description>
+ </CGIService>
+ </Service>\n";
+ $debug && &_LOG( "got $service description\n");
+ return $service;
+
+ }
}
@@ -2259,10 +2462,14 @@
my $this_query = $dbh->prepare($query);
$this_query->execute;
my $response;
+ my %seen;
$response = "<Services>\n";
- while (my ($serviceName, $objectOUT, $AuthURI,$desc, $type) =$this_query->fetchrow_array()){
- $debug && &_LOG("$serviceName, $objectOUT, $AuthURI,$desc, $type\n");
+ while (my ($serviceName, $objectOUT, $AuthURI,$desc, $type, $cat) =$this_query->fetchrow_array()){
+ $debug && &_LOG("$serviceName, $objectOUT, $AuthURI,$desc, $type, $cat\n");
+ next if $seen{"$AuthURI"."||"."$serviceName"}; # non-redundant list please
+ $seen{"$AuthURI"."||"."$serviceName"} = 1;
$response .="<Service authURI='$AuthURI' serviceName='$serviceName'>\n";
+ $response .="<Catagory>$cat</Catagory>\n";
$response .="<serviceType>$type</serviceType>\n";
$response .="<outputObject>$objectOUT</outputObject>\n";
$response .= "<Description><![CDATA[$desc]]></Description>\n";
@@ -2288,16 +2495,14 @@
sub _getServiceWSDL {
- my ( $dbh, $sth_hash, $query) = @_;
+ my ( $dbh, $sth_hash, $id, $serviceName, $AuthURI,$URL, $desc, $category) = @_;
my %sth = %{$sth_hash};
- my $this_query = $dbh->prepare($query);
- $this_query->execute;
+
open (WSDL, "./MOBY/Central_WSDL_SandR.wsdl") || die "can't open WSDL file for search and replace\n";
my $wsdl = join "", (<WSDL>);
$wsdl =~ s/^\n//gs;
close WSDL;
- my ($id, $serviceName, $AuthURI, $URL, $desc) =$this_query->fetchrow_array();
- my $sth = $dbh->prepare($sth{get_server_parameters});
+ my $sth = $dbh->prepare($sth{get_server_parameters});
$sth->execute($id);
my (@in, @out);
while (my ($Object, $xsd, $in_out) = $sth->fetchrow_array()){
@@ -2308,8 +2513,9 @@
$wsdl =~ s/MOBY__SERVICE__NAME__/$serviceName/g; # replace all of the goofy portbindingpottype crap
$wsdl =~ s/\<\!\-\-\s*MOBY__SERVICE__DESCRIPTION\s*\-\-\>/Authority: $AuthURI - $desc/g; # add a sensible description
$wsdl =~ s/MOBY__SERVICE__URL/$URL/g; # the URL to the service
- my ($IN, $INxsd) = @{shift @in};
- my ($OUT, $OUTxsd) = @{shift @out};
+ my ($IN, $INxsd, $OUT, $OUTxsd);
+ if (scalar @in){my ($IN, $INxsd) = @{shift @in}};
+ if (scalar @out){my ($OUT, $OUTxsd) = @{shift @out}};
$wsdl =~ s/MOBY__INPUT__OBJECT__NAME/$IN/g; # SINGLE input object (for now)
$wsdl =~ s/MOBY__OUTPUT__OBJECT__NAME/$OUT/g; # SINGLE output object (for now)
$wsdl =~ s/\<\!\-\-\s*MOBY__INPUT__OBJECT__XSD\s*\-\-\>/$INxsd/g; # XSD stright from the database
@@ -2319,6 +2525,21 @@
}
+sub _getCGIService {
+ my ( $dbh, $sth_hash, $id, $serviceName, $AuthURI,$URL, $desc, $category) = @_;
+ my %sth = %{$sth_hash};
+ # "Select OE.term, O.xsd, SP.type
+ # from Object as O, OntologyEntry as OE, ServiceParameter as SP, Service as S
+ # where O.ontologyentry_id = OE.id
+ # AND SP.ontologyentry_id = OE.id
+ # and SP.service_id = ?
+
+ my $sth = $dbh->prepare($sth{get_server_parameters});
+ $sth->execute($id);
+ my ($Object, $sprintf, $in) = $sth->fetchrow_array();
+ return "<GETstring><![CDATA[$sprintf]]></GETstring>";
+}
+
=head2 _traverseServiceDAG
More information about the MOBY-guts
mailing list