[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Wed May 7 19:20:28 UTC 2003
mwilkinson
Wed May 7 15:20:27 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv29016/Perl/MOBY
Modified Files:
Central.pm
Added Files:
OntologyServer.pm authority.pm central_db_connection.pm
mysql.pm service_instance.pm service_type.pm simple_input.pm
simple_output.pm
Log Message:
new MOBY Central API functionality. NO DOCUEMNTATION PRONE TO CHANGE IN THE NEXT 48 hours. DO NOT USE
moby-live/Perl/MOBY OntologyServer.pm,NONE,1.1 authority.pm,NONE,1.1 central_db_connection.pm,NONE,1.1 mysql.pm,NONE,1.1 service_instance.pm,NONE,1.1 service_type.pm,NONE,1.1 simple_input.pm,NONE,1.1 simple_output.pm,NONE,1.1 Central.pm,1.18,1.19
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/03/05 16:00:41 1.18
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/05/07 19:20:27 1.19
@@ -13,18 +13,20 @@
use DBI;
use DBD::mysql;
use XML::DOM;
-#use MOBY::Registration;
-
-
+use MOBY::OntologyServer;
+use MOBY::service_type;
+use MOBY::authority;
+use MOBY::service_instance;
+use MOBY::central_db_connection;
my $debug = 0;
if ($debug){open (OUT, ">/tmp/CentralRegistryLogOut.txt") || die "cant open logfile\n";print OUT "created logfile\n";close OUT;}
-
-
=head1 SYNOPSIS
+REQUIRES MYSQL 3.23 or later!!!!
+
If you are a Perl user, you should be using the
MOBY::Client:Central module to talk to MOBY-Central
@@ -57,29 +59,6 @@
my $Central = MOBY::Central->new;
my $reg = $Central->registerService("
- <registerService>
- <serviceName>YourServiceNameHere</serviceName>
- <serviceType>YourServiceTypeHere</serviceType>
- <authURI>your.URI.here</authURI>
- <inputObjects>
- <input>
- <objectType>ObjectType1</objectType>
- <namespaceType>NamespaceType1</namespaceType>
- </input>
- <input>
- <objectType>ObjectType2</objectType>
- <namespaceType>NamespaceType2</namespaceType>
- </input>
- </inputObjects>
- <outputObjects>
- <objectType>ObjectType1</objectType>
- <objectType>ObjectType2</objectType>
- </outputObjects>
- <URL>http://URL.to.your/Service.pl</URL>
- <description><![CDATA[
- human readable description of your service]]>
- </description>
- </registerService>"
);
print "success ", $reg->success;
print "\nerror_message ", $reg->error_message;
@@ -166,276 +145,174 @@
}
sub _dbAccess {
- my $filename = "./MOBY/central.cfg";# $self->config;
- $debug && &_LOG("trying to open file $filename\n");
- open (IN, $filename) || die "can't open configuration file $filename: $!";
- my $url = <IN>; chomp $url;
- my $dbname = <IN>; chomp $dbname;
- my $username = <IN>; chomp $username;
- my $password = <IN>; chomp $password;
-
- my ($dsn) = "DBI:mysql:$dbname:$url";
-
-
- $debug && &_LOG("connecting to db with params $dsn, $username, $password\n");
- my $dbh = DBI->connect($dsn, $username, $password, {RaiseError => 1}) or die "can't connect to database";
- $debug && &_LOG("CONNECTED!\n");
-
- my %sth;
- # queries required for registration
- $sth{check_object} = ("select OE.id from OntologyEntry as OE, Ontology as O where term=? and ontology_id = O.id and O.name='MOBY_Object' and OE.is_obselete = 'n'");
- $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, category, registration_identifier) values (?,?,?,?,?,?,?)");
- $sth{insert_parameter} = ("insert into ServiceParameter (service_id, ontologyentry_id, type) values (?,?,?)");
-
- # queries required for Deregistration
- $sth{service_id} = ("Select id from Service where registration_identifier = ?");
- $sth{remove_service} = ("DELETE FROM Service where id = ?");
- $sth{remove_service_params} = ("delete from ServiceParameter where service_id = ?");
-
-
- # queries required for getServiceByType
- $sth{get_service_type_id} = ("Select id from OntologyEntry where term = ?");
- $sth{get_service_hierarchy_list} = ("Select ontologyentry2_id from Term2Term where ontologyentry1_id = ?");
- $sth{get_server_parameters} = ("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 = ?");
-
- # queries required for _traverseObjectDAG
- $sth{get_object_type_id} = ("Select id from OntologyEntry where term = ?");
- $sth{get_object_parent_list} = ("Select ontologyentry1_id from Term2Term where ontologyentry2_id = ?");
- $sth{get_object_child_list} = ("Select ontologyentry2_id from Term2Term where ontologyentry1_id = ?");
-
-
- # retrieveServiceProviders
- $sth{return_service_providers} = ("Select distinct auth_uri from Service");
-
- #retrieveServiceNames
- $sth{return_service_names} = ("select service_name, auth_uri from Service");
-
- #retrieveServiceTypes
- $sth{return_service_types} = ("select OE.term, OE.description from OntologyEntry as OE, Ontology as O where OE.ontology_id = O.id and O.name = 'MOBY_Service'");
-
- #retrieveObjectNames
- $sth{retrieve_object_names} = ("select OE.term, OE.description from OntologyEntry as OE, Ontology as O where OE.ontology_id = O.id and O.name = 'MOBY_Object' and OE.is_obselete = 'n'");
-
- #retrieveNamespaces
- $sth{retrieve_namespaces} = ("select OE.term, OE.description from OntologyEntry as OE, Ontology as O where OE.ontology_id = O.id and O.name = 'MOBY_Namespace'");
-
- #registerObject
- $sth{check_object_registration} = ("select OE.accession, OE.id from OntologyEntry as OE, Ontology as O where OE.term = ? and OE.ontology_id = O.id and O.name='MOBY_Object' and OE.is_obselete = 'n'");
- $sth{get_last_object_accession} = ("select MAX(accession) from OntologyEntry as OE, Ontology as O where OE.ontology_id = O.id and O.name = 'MOBY_Object'");
- $sth{register_object} = ("insert into OntologyEntry (term, accession, ontology_id, description, authority, is_obselete) values (?,?,?,?,?, 'n')");
- $sth{deprecate_object} = ("update OntologyEntry set is_obselete = 'y' where id=?");
- $sth{clobber_object} = ("update OntologyEntry set term=?, ontology_id = ?, description = ?, authority=? where id = ?");
- $sth{register_object_xsd} = ("insert into Object (ontologyentry_id, name, xsd) values (?,?,?)");
- $sth{clobber_object_xsd} = ("update Object set name = ?, xsd = ? where ontologyentry_id = ?");
- $sth{register_object_relationship} = ("insert into Term2Term (ontologyentry1_id, ontologyentry2_id, relationship_type_id) values (?,?,?)");
-
- #deregisterObject
- $sth{validate_object_deregistration} = ("SELECT COUNT(S.id) FROM Service as S, OntologyEntry as OE, Ontology as O, ServiceParameter as SP where S.id = SP.service_id and SP.ontologyentry_id = OE.id and OE.ontology_id=O.id and O.name='MOBY_Object' and OE.accession=?");
- $sth{get_object_id} = ("Select OE.id from OntologyEntry as OE, Ontology as O where OE.accession = ? and OE.ontology_id = O.id and O.name='MOBY_Object'");
- $sth{deregister_object_relationships} = ("delete from Term2Term where ontologyentry1_id = ? or ontologyentry2_id = ?");
- $sth{deregister_object_xsd} = ("delete from Object where ontologyentry_id=?");
- $sth{deregister_object} = ("delete from OntologyEntry where id=?");
-
- #deregisterService
- $sth{validate_service_deregistration} = ("SELECT COUNT(S.id) FROM Service as S, OntologyEntry as OE, Ontology as O, ServiceParameter as SP where S.id = SP.service_id and SP.ontologyentry_id = OE.id and OE.ontology_id=O.id and O.name='MOBY_Service' and OE.accession=?");
- $sth{get_service_id} = ("Select OE.id from OntologyEntry as OE, Ontology as O where OE.accession = ? and OE.ontology_id = O.id and O.name='MOBY_Service'");
- $sth{deregister_service_relationships} = ("delete from Term2Term where ontologyentry1_id = ? or ontologyentry2_id = ?");
- $sth{deregister_service} = ("delete from OntologyEntry where id=?");
-
- #deregisterNamespace
- $sth{validate_namespace_deregistration} = ("SELECT COUNT(S.id) FROM Service as S, OntologyEntry as OE, Ontology as O, ServiceParameter as SP where S.id = SP.service_id and SP.ontologyentry_id = OE.id and OE.ontology_id=O.id and O.name='MOBY_Namespace' and OE.accession=?");
- $sth{get_namespace_id} = ("Select OE.id from OntologyEntry as OE, Ontology as O where OE.accession = ? and OE.ontology_id = O.id and O.name='MOBY_Namespace'");
- $sth{deregister_namespace} = ("delete from OntologyEntry where id=?");
-
- #registernamespace
- $sth{get_last_namespace_accession} = ("select MAX(accession) from OntologyEntry as OE, Ontology as O where OE.ontology_id = O.id and O.name = 'MOBY_Namespace'");
- $sth{get_existing_namespace_accession} = ("select accession from OntologyEntry as OE, Ontology as O where OE.ontology_id = O.id and O.name = 'MOBY_Namespace' AND OE.term=? and OE.authority = ?");
- $sth{register_namespace} = ("insert into OntologyEntry (term, authority, description, ontology_id, accession) values (?,?,?,?,?)");
- $sth{update_namespace} = ("update OntologyEntry set term = ?, authority = ?, description = ? where ontology_id = ? and accession = ?");
-
- #registerServicetype
- $sth{check_service_registration} = ("select OE.id, OE.accession from OntologyEntry as OE, Ontology as O where OE.term = ? and OE.ontology_id = O.id and O.name='MOBY_Service'");
- $sth{get_last_service_accession} = ("select MAX(accession) from OntologyEntry as OE, Ontology as O where OE.ontology_id = O.id and O.name = 'MOBY_Service'");
- $sth{register_service_type} = ("insert into OntologyEntry (term, accession, ontology_id, description) values (?,?,?,?)");
- $sth{register_service_relationship} = ("insert into Term2Term (ontologyentry1_id, ontologyentry2_id, relationship_type_id) values (?,?,?)");
-
- #retrieveObject
- $sth{retrieve_all_objects} = ("select term, xsd from OntologyEntry as OE, Ontology as O, Object as Ob where Ob.ontologyentry_id = OE.id AND OE.ontology_id = O.id and O.name = 'MOBY_Object' and OE.is_obselete = 'n'");
- $sth{retrieve_one_object} = ("select term, xsd from OntologyEntry as OE, Ontology as O, Object as Ob where Ob.ontologyentry_id = OE.id AND OE.ontology_id = O.id and O.name = 'MOBY_Object' AND OE.term =? and OE.is_obselete = 'n'");
+# my $filename = "./MOBY/central.cfg";# $self->config;
+# $debug && &_LOG("trying to open file $filename\n");
+# open (IN, $filename) || die "can't open configuration file $filename: $!";
+# my $url = <IN>; chomp $url;
+# my $dbname = <IN>; chomp $dbname;
+# my $username = <IN>; chomp $username;
+# my $password = <IN>; chomp $password;
+
+# my ($dsn) = "DBI:mysql:$dbname:$url";
+# my $dbh = DBI->connect($dsn, $username, $password, {RaiseError => 1}) or die "can't connect to database";
+ my $dsn = "DBI:mysql:mobycentral:localhost:3306";
+ my $dbh = DBI->connect($dsn, 'root', undef, {RaiseError => 1}) or die "can't connect to database";
- return ($dbh, \%sth);
+ return ($dbh);
}
-=head2 registerObject
+=head2 registerObjectClass
- Title : registerObject
- Usage : $REG = $MOBY->registerObject($InputXML)
+ Title : registerObjectClass
+ Usage : $REG = $MOBY->registerObjectClass($InputXML)
Function : register a new Object type, and its relationships, or modify existing
Returns : Registration XML object; registration_id is the new object's accession number
- InputXML :
- <registerObject>
- <objectType>NewObjectType</objectType>
- <Description><![CDATA[
- human readable description
- of data type]]>
- </Description>
- <ISA>
- <objectType>ExistingObjectType</objectType>
- <objectType>ExistingObjectType</objectType>
- </ISA>
- <authURI>Your.URI.here</authURI>
- <Clobber>0 | 1 | 2</Clobber>
- <xsd><the XSD for the new object goes here>
- </xsd>
- </registerObject>
-
- Notes: "Clobber": 0 means warn me that the object already exists
- 1 means deprecate the existing object and write a new entry
- 2 means really clobber the object if it exists
- OutputXML : see registration object XML
-
+ * used to register a new object Class into the
+ Class ontology
+ * you can envision this as simply registering
+ a new node into the Class ontology graph,
+ and creating the 1' connections from that node.
+ * notice that, in a HAS-A relationship, it is
+ necessary to indicate an article name for each
+ contained object type. Thus, for example, you
+ could have a sequence object that contained a
+ STRING object with name "nucleotideSequence"
+ and an INT object with the name "sequenceLength".
+ * "clobber" is used to control overwriting behaviour.
+ o 0 - default; you will get an error if
+ an object by that name exists.
+ o 1 - deprecate an existing node by this
+ name if it exists, and replace it
+ with the new information provided
+ (in practice, this will only be used
+ as a humam-readable way to track
+ changes to object definitions.
+ How/If this is implemented is
+ entirely up to the Registry designer)
+ o 2 - delete any existing node by that
+ name if it exists, and if it was
+ registered by ("owned by") you, and
+ replace it with the new information
+ provided. You will get an error if you
+ are not the owner of that object definition.
+
+Input XML :
+
+ <registerObjectClass>
+ <objectType>NewObjectType</objectType>
+ <Description><![CDATA[
+ human readable description
+ of data type]]>
+ </Description>
+ <ISA>
+ <objectType>ExistingObjectType</objectType>
+ <!-- at the moment we do not allow multiple
+ inheritence, but perhaps we should. It
+ raises some additional complexities -->
+ </ISA>
+ <HASA>
+ <objectType articleName="MyArticleName">ExistingObjectType</objectType>
+ <objectType articleName="MyOtherName">ExistingObjectType</objectType>
+ </HASA>
+ <authURI>Your.URI.here</authURI>
+ <contactEmail>You at your.address.com</contactEmail>
+ <Clobber>0 | 1 | 2</Clobber>
+ </registerObjectClass>
+
+Output XML :
+
+...Registration Object...
=cut
-sub registerObject {
- my ($pkg, $payload) = @_;
-
+sub registerObjectClass {
+ # this contacts the ontology server to register
+ # the ontology and writes the resulting URI into
+ # the MOBY Central database
+ my ($pkg, $payload) = @_;
+ my ($success, $message);
+ my $OntologyServer = &_getOntologyServer(ontology => 'object');
$debug && &_LOG("\n\npayload\n**********************\n$payload\n***********************\n\n");
- my ($term, $desc, $xsd, $ISA, $auth, $clobber) = &_registerObjectPayload($payload);
- $debug && &_LOG("\n\nterm $term\ndesc $desc\nxsd $xsd\nisa $ISA\nauth $auth\nclobber $clobber\n\n");
-
- unless (defined $term && defined $desc && defined $xsd && defined $auth){
- my $reg = &Registration({
- success => 0,
- error_message => "Term, Description, authURI and XSD are all required parameters ",
- registration_id => "",
- });
- return $reg;
- }
-
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
-
- # check that it doesn't already exist
- my $sth = $dbh->prepare($sth{check_object_registration});
- $sth->execute($term);
- my ($existing_acc, $existing_id) = $sth->fetchrow_array;
-
- $clobber = 0 unless ($existing_acc); # it makes no sense to clobber something that doesnt' exist
- if ($existing_acc){
- if ($clobber == 1){
- my $sth = $dbh->prepare($sth{deprecate_object});
- $sth->execute($existing_id);
- } elsif ($clobber == 2) { # this is a REAL clobber, it overwrites
- # do nothing here for the moment
- } else {
- my $reg = &Registration({
- success => 0,
- error_message => "Object Type $term already exists",
- registration_id => "$existing_acc",
- });
- return $reg;
- }
- }
+ my ($term, $desc, $ISA, $HASA, $email, $auth, $clobber) = &_registerObjectPayload($payload);
+ $debug && &_LOG("\n\nterm $term\ndesc $desc\nisa $ISA\n hasa %HASA\nemail $email\nauth $auth\nclobber $clobber\n\n");
+ unless (defined $term && defined $desc && defined $auth && defined $email){
+ return &_error("Malformed XML; may be missing required parameters objectType, Description, authURI or contactEmail","");
+ }
+ # validate that the final ontology will be valid
+ foreach (@{$ISA}){
+ my ($success, $message, $URI) = $OntologyServer->objectExists(term => $_); # success = 1 if it does
+ $success==0 && return &_error($message, $URI );
+ }
+ foreach (@{$HASA}){
+ my ($term, $attr) = @{$_};
+ my ($success, $message, $URI) = $OntologyServer->objectExists(term => $term); # success = 1 if it does
+ $success==0 && return &_error($message, $URI);
+ }
+
+ $clobber = 0 unless ($clobber eq 0 || $clobber eq 1 || $clobber eq 2); # safety!
+ my ($exists, $exists_message, $URI) = $OntologyServer->objectExists(term => $term); # success = 1 if it does
+ (($exists==1 && !$clobber) && return &_error("Object $term already exists", $URI));
- # prepare to get the highest object accession in the database
- my ($last_acc);
- $sth = $dbh->prepare($sth{get_last_object_accession});
- $sth->execute;
- $last_acc = $sth->fetchrow_array;
-
- # however, this is irrelevant if we want to clobber,
- # so if we want to clobber, and if the thing we want to clobber
- # actually exists, then take it's accession instead
- if ($clobber ==2 && $existing_acc){
- $last_acc = $existing_acc; # override the endmost accession to clobber an existing accession
- }
-
- # something has gone terribly wrong if this has happened...
- unless ($last_acc){
- my $reg = &Registration({
- success => 0,
- error_message => "unable to determine last object accession number",
- registration_id => "",
- });
- return $reg;
- }
-
- # prepare the new accession as increment 1 over the highest existing
- my $acc = (($last_acc =~ /0*(\d+)/) && $1);
- $acc++;
- my $new_acc = sprintf "%06u", $acc;
-
-
- my $obj_id;
- unless ($clobber ==2){ # create a new entry
- my $sth = $dbh->prepare($sth{register_object});
- $sth->execute($term, $new_acc, 1, $desc, $auth);
- $obj_id = $dbh->{mysql_insertid};
-
- unless ($obj_id){
- my $reg = &Registration({
- success => 0,
- error_message => "Failed to register object for unknown reason",
- registration_id => "",
- });
- return $reg;
- }
- } else { # or clobber the old one
- my $sth = $dbh->prepare($sth{clobber_object});
- $sth->execute($term, 1, $desc, $auth, $existing_id);
- $obj_id = $existing_id;
- $new_acc = $existing_acc;
- }
-
- unless ($clobber == 2){ # create a new entry
- my $sth = $dbh->prepare($sth{register_object_xsd});
- $sth->execute($obj_id, $term, $xsd);
- } else { # or clobber the old one
- my $sth = $dbh->prepare($sth{clobber_object_xsd});
- $sth->execute($term, $xsd, $obj_id);
- }
+ $clobber = 0 unless ($exists); # it makes no sense to clobber something that doesnt' exist
+ if ($exists){
+ if ($clobber == 1){
+ my ($success, $message) = $OntologyServer->deprecateObject(term => $term);
+ $success==0 && return &_error($message, $URI);
+ } elsif ($clobber == 2) {
+ my ($success, $message) = $OntologyServer->deleteObject(term => $term);
+ $success==0 && return &_error($message, $URI);
+ }
+ }
+
+ ($success, $message, $URI) = $OntologyServer->createObject(
+ node => $term,
+ description => $desc,
+ authority => $auth,
+ contact_email => $email);
+ $success==0 && return &_error($message, $URI);
+ my @isafailures;
+ my @hasafailures;
if ($ISA){
my @ISA = @{$ISA};
- my @isa_ids;
- foreach my $isa(@ISA){
- my $sth = $dbh->prepare($sth{check_object_registration});
- $sth->execute($isa);
- my ($isa_id) = $sth->fetchrow_array;
- unless ($isa_id){
- $dbh->do("delete from OntologyEntry where id = $obj_id");
- $dbh->do("delete from Object where ontologyentry_id = $obj_id");
- my $reg = &Registration({
- success => 0,
- error_message => "ISA Object Type '$isa' was not registered",
- registration_id => "",
- });
- return $reg;
- }
- push @isa_ids, $isa_id;
- }
- if ($clobber == 2){
- $dbh->do("delete from Term2Term where ontologyentry1_id = $obj_id"); # purge existing relationships
- }
-
- foreach (@isa_ids){
- my $sth = $dbh->prepare($sth{register_object_relationship});
- $sth->execute($_, $obj_id, 1);
- }
+ foreach my $isa_node(@ISA){
+ my ($success, $message) = $OntologyServer->addObjectISA(
+ node => $term,
+ ISA => $isa_node,
+ authority => $auth,
+ contact_email => $email);
+ $success==0 && push @isafailures, $isa_node;
+ }
+ }
+ if ($HASA){
+ # HASA structure:
+ # (['term', [articleName, value]],
+ # ['term2', [articleName, value2]])
+ my at HASAS= @{$HASA};
+ foreach my $hasa(@HASAS){
+ my ($keyvalue, $values) = @{$hasa};
+ my ($articleName,$has_term) = @{$keyvalue};
+ my ($success, $message) = $OntologyServer->addObjectHASA(
+ node => $term,
+ HASA => $has_term,
+ authority => $auth,
+ contact_email => $email,
+ articleName => $articleName);
+ $success==0 && push @hasafailures, $has_term;
+ }
+ }
+ if (scalar(@isafailures) || scalar(@hasafailures)){
+ my ($success, $message, $deleteURI) = $OntologyServer->deleteObject(term => $term); # hopefully this situation will never happen!
+ $success==0 && return &_error("object failed ISA and/or HASA connections,
+ and subsequently failed deletion. This is a critical error,
+ and may indicate corruption of the MOBY Central registry", $deleteURI);
+ return &_error("object failed to register due to failure during registration of ISA/HASA relationships".(join ",", (@isafailures, @hasafailures))."\n", "");
}
- my $reg = &Registration({
- success => 1,
- error_message => "",
- registration_id => $new_acc,
- });
- return $reg;
+
+ return &_success("Object $term registered successfully.", $URI);
}
@@ -445,42 +322,43 @@
my $doc = $Parser->parse($payload);
my $Object = $doc->getDocumentElement();
my $obj = $Object->getTagName;
- return undef unless ($obj eq 'registerObject');
+ 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 $clobber = &_nodeTextContent($Object, "Clobber");
- my $xsd = &_nodeTextContent($Object, "xsd");
my @ISA = &_nodeArrayContent($Object, "ISA");
- return ($term, $desc, $xsd, \@ISA, $authURI, $clobber);
+ my @HASA = &_nodeArrayExtraContent($Object, "HASA","articleName");
+ return ($term, $desc, \@ISA, \@HASA, $email,$authURI, $clobber);
}
=head2 deregisterObject
+ * used to remove an Object Class from the Class ontology
+ * this will not be successful until you respond positively to an email sent to the address that you provided when registering that object.
+ * you may only deregister Classes that you yourself registered!
+ * you may not deregister Object Classes that are being used as input or output by ANY service
+ * you may not deregister Object Classes that are in a ISA or HASA relationship to any other Object Class.
- Title : deregisterObject
- Usage : $REG = $MOBY->deregisterObject($inputXML)
- Function : de-register an Object type, and its relationships
- Returns : MOBY Registration XML object; registration_id was the acc of the
- now de-registered object.
- Notes : THIS WILL FAIL IF ANY SERVICES DEPEND ON THAT OBJECT (IN/OUT)!
- Use the accession number returned when you registered that object
-
- inputXML :
- <deregisterObject>
- <objectAcc>000016</objectAcc>
- </deregisterObject>
+Input XML :
- ouptutXML : see Registration XML object
+ <deregisterObjectClass>
+ <objectType>ObjectOntologyTerm</objectType>
+ </deregisterObjectClass>
+
+Ouptut XML :
+...Registration Object...
=cut
-sub deregisterObject {
+sub deregisterObjectClass {
my ($pkg, $payload) = @_;
+ my $OntologyServer = &_getOntologyServer(ontology => 'object');
unless ($payload){
my $reg = &Registration({
@@ -491,57 +369,72 @@
return $reg;
}
- my ($acc) = &_deregisterObjectPayload($payload);
- $debug && &_LOG("object accession $acc\n");
- unless ($acc){
+ my ($class) = &_deregisterObjectPayload($payload);
+ $debug && &_LOG("deregister object type $class\n");
+ unless ($class){
my $reg = &Registration({
success => 0,
- error_message => "Must include an accession number to deregister an object",
+ error_message => "Must include class of object to deregister",
registration_id => "",
});
return $reg;
}
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
-
- my $sth = $dbh->prepare($sth{validate_object_deregistration});
- $sth->execute($acc);
- my ($invalid) = $sth->fetchrow_array;
- if ($invalid){
+ my ($success, $message, $existingURI) = $OntologyServer->objectExists(term => $class);
+ unless ($existingURI){
my $reg = &Registration({
success => 0,
- error_message => "This object has Service dependancies ($invalid) and may not be deregistered",
- registration_id => "$acc",
+ error_message => "Object class $class does not exist",
+ registration_id => "",
});
return $reg;
}
- $sth = $dbh->prepare($sth{get_object_id});
- $sth->execute($acc);
- my ($id) = $sth->fetchrow_array;
- unless (defined $id){
+
+ my $dbh = MOBY::central_db_connection->new()->dbh;
+ my ($id) = $dbh->selectrow_array(q{select service_instance.service_instance_id from service_instance natural join simple_input where object_type_uri = ?},undef,$existingURI);
+ if ($id){
my $reg = &Registration({
success => 0,
- error_message => "Object does not exist",
- registration_id => "$acc",
+ error_message => "Object class $class is used by a service and may not be deregistered",
+ registration_id => "",
});
return $reg;
}
+ ($id) = $dbh->selectrow_array(q{select service_instance.service_instance_id from service_instance natural join simple_output where object_type_uri = ?},undef,$existingURI);
+ if ($id){
+ my $reg = &Registration({
+ success => 0,
+ error_message => "Object class $class is used by a service and may not be deregistered",
+ registration_id => "",
+ });
+ return $reg;
+ }
+
+ ($id) = $dbh->selectrow_array(q{select service_instance.service_instance_id from service_instance natural join collection_input natural join simple_input where object_type_uri = ?},undef,$existingURI);
+ if ($id){
+ my $reg = &Registration({
+ success => 0,
+ error_message => "Object class $class is used by a service and may not be deregistered",
+ registration_id => "",
+ });
+ return $reg;
+ }
+
+ ($id) = $dbh->selectrow_array(q{select service_instance.service_instance_id from service_instance natural join collection_output natural join simple_output where object_type_uri = ?},undef,$existingURI);
+ if ($id){
+ my $reg = &Registration({
+ success => 0,
+ error_message => "Object class $class is used by a service and may not be deregistered",
+ registration_id => "",
+ });
+ return $reg;
+ }
- $sth = $dbh->prepare($sth{deregister_object_relationships});
- $sth->execute($id, $id);
- $sth = $dbh->prepare($sth{deregister_object_xsd});
- $sth->execute($id);
- $sth = $dbh->prepare($sth{deregister_object});
- $sth->execute($id);
+ my ($success2, $message2, $URI) = $OntologyServer->deleteObject(term => $class);
+ $success2==0 && return &_error($message2, $URI);
+ return &_success($message2, $URI);
- my $reg = &Registration({
- success => 1,
- error_message => "",
- registration_id => $acc,
- });
- return $reg;
}
sub _deregisterObjectPayload {
@@ -550,124 +443,92 @@
my $doc = $Parser->parse($payload);
my $Object = $doc->getDocumentElement();
my $obj = $Object->getTagName;
- return undef unless ($obj eq 'deregisterObject');
+ return undef unless ($obj eq 'deregisterObjectClass');
- return &_nodeTextContent($Object, "objectAcc");
+ return &_nodeTextContent($Object, "objectType");
}
=head2 registerServiceType
- Title : registerServiceType
- Usage : $REG = $MOBY->registerServiceType($inputXML)
- Function : register a new Service type, and its relationships
- Returns : MOBY Registration XML object
- inputXML :
- <registerServiceType>
- <serviceType>NewServiceType</serviceType>
- <Description>
- <![CDATA[ human description of service type here]]>
- </Description>
- <ISA>
- <serviceType>ExistingServiceType</serviceType>
- <serviceType>ExistingServiceType</serviceType>
- </ISA>
- </registerServiceType>
+ * used to register a new node in the Service Ontology
+ * the ISA ontology terms must exist or this registration will fail.
+ * all parameters are required.
+ * email must be valid for later deregistration or updates
+
+Input XML :
+
+ <registerServiceType>
+ <serviceType>NewServiceType</serviceType>
+ <contactEmail>your_name at contact.address.com</contactEmail>
+ <authURI>Your.URI.here</authURI>
+ <Description>
+ <![CDATA[ human description of service type here]]>
+ </Description>
+ <ISA>
+ <serviceType>ExistingServiceType</serviceType>
+ <serviceType>ExistingServiceType</serviceType>
+ </ISA>
+ </registerServiceType>
- outputXML : see Registration XML object
+Output XML :
+...Registration Object...
=cut
sub registerServiceType {
- my ($pkg, $payload) = @_;
-
-# my ($term, $desc, $ISA, $clobber) = &_registerServiceTypePayload($payload);
- my ($term, $desc, $ISA) = &_registerServiceTypePayload($payload);
-
- unless ($term && $desc){
- my $reg = &Registration({
- success => 0,
- error_message => "Term and Description are both required parameters",
- registration_id => "",
- });
- return $reg;
- }
-
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
-
- my $sth = $dbh->prepare($sth{check_service_registration});
- $sth->execute($term);
- my ($existing_id, $acc) = $sth->fetchrow_array;
-# if ($existing_id && !$clobber){
- if ($existing_id){
- my $reg = &Registration({
- success => 0,
- error_message => "Service Type $term already exists - register failed.",
- registration_id => "$acc",
- });
- return $reg;
- }
-# $clobber = 0 unless $existing_id; # makes sense - can't clobber what isn't there.
-
- $sth = $dbh->prepare($sth{get_last_service_accession});
- $sth->execute;
- my ($last_acc) = $sth->fetchrow_array;
- unless ($last_acc){
- my $reg = &Registration({
- success => 0,
- error_message => "unable to determine last service accession number",
- registration_id => "",
- });
- return $reg;
- }
- $acc = (($last_acc =~ /0*(\d+)/) && $1);
- $acc++;
- my $new_acc = sprintf "%06u", $acc;
- $sth = $dbh->prepare($sth{register_service_type});
- $sth->execute($term, $new_acc, 2, $desc);
- my $obj_id = $dbh->{mysql_insertid};
-
- unless ($obj_id){
- my $reg = &Registration({
- success => 0,
- error_message => "Failed to register service type for unknown reason",
- registration_id => "",
- });
- return $reg;
- }
+ # this contacts the ontology server to register
+ # the ontology and writes the resulting URI into
+ # the MOBY Central database
+ my ($pkg, $payload) = @_;
+ my ($success, $message);
+ my $OntologyServer = &_getOntologyServer(ontology => 'service');
+ $debug && &_LOG("\n\npayload\n**********************\n$payload\n***********************\n\n");
+ my ($term, $desc, $ISA, $email, $auth) = &_registerServiceTypePayload($payload);
+ $debug && &_LOG("\n\nterm $term\ndesc $desc\nisa $ISA\nemail $email\nauth $auth");
+ unless (defined $term && defined $desc && defined $auth && defined $email){
+ return &_error("Malformed XML\n $payload\n may be missing required parameters serviceType=$term, Description=$desc, authURI=$auth or contactEmail=$email","");
+ }
+ # validate that the final ontology will be valid
+ foreach (@{$ISA}){
+ my ($success, $message, $URI) = $OntologyServer->serviceExists(term => $_); # success = 1 if it does
+ $success==0 && return &_error($message, $URI );
+ }
+
+ my ($exists, $exists_message, $URI) = $OntologyServer->serviceExists(term => $term); # success = 1 if it does
+ (($exists==1) && return &_error("Service type $term already exists", $URI));
+
+ ($success, $message, $URI) = $OntologyServer->createServiceType(
+ node => $term,
+ description => $desc,
+ authority => $auth,
+ contact_email => $email);
+ $success==0 && return &_error($message, $URI);
+ my @isafailures;
if ($ISA){
my @ISA = @{$ISA};
- my @isa_ids;
- foreach my $isa(@ISA){
- $sth = $dbh->prepare($sth{check_service_registration});
- $sth->execute($isa);
- my ($isa_id, $acc) = $sth->fetchrow_array;
- unless ($isa_id){
- $dbh->do("delete from OntologyEntry where id = '$obj_id'");
- my $reg = &Registration({
- success => 0,
- error_message => "ISA Service Type '$isa' is not registered",
- registration_id => "",
- });
- return $reg;
- }
- push @isa_ids, $isa_id;
- } # all are valid registered types, so now register them as ISA
- foreach (@isa_ids){
- my $sth = $dbh->prepare($sth{register_service_relationship});
- $sth->execute($_, $obj_id, 1);
- }
+ foreach my $isa_node(@ISA){
+ my ($success, $message) = $OntologyServer->addServiceISA(
+ node => $term,
+ ISA => $isa_node,
+ authority => $auth,
+ contact_email => $email);
+ $success==0 && push @isafailures, $isa_node;
+ }
+ }
+ if (scalar(@isafailures)){
+ my ($success, $message, $deleteURI) = $OntologyServer->deleteServiceType(term => $term); # hopefully this situation will never happen!
+ $success==0 && return &_error("Service registration failed ISA connections,
+ and subsequently failed deletion. This is a critical error,
+ and may indicate corruption of the MOBY Central registry", $deleteURI);
+ return &_error("Service failed to register due to failure during registration of ISA relationships".(join ",", (@isafailures))."\n", "");
}
- my $reg = &Registration({
- success => 1,
- error_message => "",
- registration_id => $new_acc,
- });
- return $reg;
+
+ return &_success("Service type $term registered successfully.", $URI);
+
}
@@ -681,12 +542,12 @@
return undef unless ($obj eq 'registerServiceType');
my $type = &_nodeTextContent($Object, "serviceType");
+ my $email = &_nodeTextContent($Object, "contactEmail");
+ my $auth = &_nodeTextContent($Object, "authURI");
my $desc = &_nodeTextContent($Object, "Description");
my @ISA = &_nodeArrayContent($Object, "ISA");
-# my $clobber = &_nodeTextContent($Object, "Clobber");
- $debug && &_LOG("got $type, $desc, @ISA from registerServiceTypePayload\n");
-# return ($type, $desc, \@ISA, $clobber);
- return ($type, $desc, \@ISA);
+ $debug && &_LOG("got $type, $desc, @ISA, $email, $auth from registerServiceTypePayload\n");
+ return ($type, $desc, \@ISA, $email, $auth);
}
@@ -695,27 +556,26 @@
=head2 deregisterServiceType
- Title : deregisterServiceType
- Usage : $REG = $MOBY->deregisterServiceType($inputXML)
- Function : de-register a Service type, and its relationships
- Returns : MOBY Registration XML object; registration_id was the acc of the
- now de-registered service.
- Notes : THIS WILL FAIL IF ANY SERVICES EXIST OF THAT SERVICE TYPE!
- Use the accession number returned when you registered that ServiceType
-
- inputXML :
- <deregisterServiceType>
- <serviceTypeAcc>000016</serviceTypeAcc>
- </deregisterServiceType>
+ * used to deregister a Service term from the Service ontology
+ * will fail if any services are instances of that Service Type
+ * will fail if any Service Types inherit from that Service Type.
- ouptutXML : see Registration XML object
+Input XML :
+ <deregisterServiceType>
+ <serviceType>ServiceOntologyTerm</serviceType>
+ </deregisterServiceType>
+
+Ouptut XML :
+
+...Registration Object...
=cut
sub deregisterServiceType {
my ($pkg, $payload) = @_;
+ my $OntologyServer = &_getOntologyServer(ontology => 'service');
unless ($payload){
my $reg = &Registration({
@@ -726,9 +586,9 @@
return $reg;
}
- my ($acc) = &_deregisterServiceTypePayload($payload);
- $debug && &_LOG("deregister serviceType accession $acc\n");
- unless ($acc){
+ my ($term) = &_deregisterServiceTypePayload($payload);
+ $debug && &_LOG("deregister serviceType accession $term\n");
+ unless ($term){
my $reg = &Registration({
success => 0,
error_message => "Must include an accession number to deregister a serviceType",
@@ -736,47 +596,32 @@
});
return $reg;
}
-
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
-
- my $sth = $dbh->prepare($sth{validate_service_deregistration});
- $sth->execute($acc);
- my ($invalid) = $sth->fetchrow_array;
- if ($invalid){
+ my ($success, $message, $existingURI) = $OntologyServer->serviceExists(term => $term); # hopefully this situation will never happen!
+ unless ($existingURI){
my $reg = &Registration({
success => 0,
- error_message => "This serviceType is currently used by $invalid existing Services and thus may not be deregistered",
- registration_id => "$acc",
+ error_message => "Service Type $term does not exist in the ontology",
+ registration_id => "",
});
return $reg;
}
- $sth = $dbh->prepare($sth{get_service_id});
- $sth->execute($acc);
- my ($id) = $sth->fetchrow_array;
- unless (defined $id){
+ my $dbh = MOBY::central_db_connection->new()->dbh;
+ my ($id) = $dbh->selectrow_array(q{select service_instance.service_instance_id from service_instance where service_type_uri = ?}, undef, $existingURI);
+ if ($id){
my $reg = &Registration({
success => 0,
- error_message => "Service with accession $acc does not exist",
- registration_id => "$acc",
+ error_message => "A registered service depends on this service type",
+ registration_id => "",
});
return $reg;
}
-
- $sth = $dbh->prepare($sth{deregister_service_relationships});
- $sth->execute($id, $id);
- $sth = $dbh->prepare($sth{deregister_service});
- $sth->execute($id);
-
- my $reg = &Registration({
- success => 1,
- error_message => "",
- registration_id => $acc,
- });
- return $reg;
+ my ($success2, $message2, $deleteURI) = $OntologyServer->deleteServiceType(term => $term); # hopefully this situation will never happen!
+ $success==0 && return &_error($message2, $deleteURI);
+ return &_success("Service type $term deleted.", $deleteURI);
}
+
sub _deregisterServiceTypePayload {
my ($payload) = @_;
my $Parser = new XML::DOM::Parser;
@@ -785,7 +630,7 @@
my $obj = $Object->getTagName;
return undef unless ($obj eq 'deregisterServiceType');
- return &_nodeTextContent($Object, "serviceTypeAcc");
+ return &_nodeTextContent($Object, "serviceType");
}
@@ -793,21 +638,24 @@
=head2 registerNamespace
- Title : registerNamespace
- Usage : $REG = $MOBY->registerNamespace($inputXML)
- Function : register a new Namespace
- Returns : MOBY Registration XML object
- inputXML :
- <registerNamespace>
- <namespaceType>NewNamespaceHere</namespaceType>
- <authURI>Your.URI.here</authURI>
- <Description>
- <![CDATA[human readable description]]>
- </Description>
- <Clobber>1 | 0</Clobber>
- </registerNamespace>
-
- outputXML : see Registration XML object
+ * used to register a new Namespace in the Namespace controlled vocabulary
+ * must provide a valid email address
+ * all parameters are required.
+
+Input XML :
+
+ <registerNamespace>
+ <namespaceType>NewNamespaceHere</namespaceType>
+ <contactEmail>your_name at contact.address.com</contactEmail>
+ <authURI>Your.URI.here</authURI>
+ <Description>
+ <![CDATA[human readable description]]>
+ </Description>
+ </registerNamespace>
+
+Output XML :
+
+...Registration Object...
=cut
@@ -815,79 +663,31 @@
sub registerNamespace {
- my ($pkg, $payload) = @_;
- my ($term, $auth, $desc, $clobber) = &_registerNamespacePayload($payload);
-
- unless ($term && $desc){
- my $reg = &Registration({
- success => 0,
- error_message => "Namespace identifier and description are required parameters",
- registration_id => "",
- });
- return $reg;
- }
-
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
-
- my $sth = $dbh->prepare($sth{get_existing_namespace_accession});
- $sth->execute($term, $auth);
- my ($existing_acc) = $sth->fetchrow_array;
-
- if ($clobber ne "clobber" && $existing_acc) {
- my $reg = &Registration({
- success => 0,
- error_message => "This namespace already exists",
- registration_id => $existing_acc,
- });
- return $reg;
- }
+ # this contacts the ontology server to register
+ # the ontology and writes the resulting URI into
+ # the MOBY Central database
+ my ($pkg, $payload) = @_;
+ my ($success, $message);
+ my $OntologyServer = &_getOntologyServer(ontology => 'namespace');
+ $debug && &_LOG("\n\npayload\n**********************\n$payload\n***********************\n\n");
+ my ($term, $auth, $desc, $email) = &_registerNamespacePayload($payload);
+ $debug && &_LOG("\n\nterm $term\ndesc $desc\nemail $email\nauth $auth");
+ unless (defined $term && defined $desc && defined $auth && defined $email){
+ return &_error("Malformed XML; may be missing required parameters namespaceType, Description, authURI or contactEmail","");
+ }
+
+ my ($exists, $exists_message, $URI) = $OntologyServer->namespaceExists(term => $term); # success = 1 if it does
+ (($exists==1) && return &_error("Namespace $term already exists", $URI));
+
+ ($success, $message, $URI) = $OntologyServer->createNamespace(
+ node => $term,
+ description => $desc,
+ authority => $auth,
+ contact_email => $email);
+ $success==0 && return &_error($message, $URI);
- if ($clobber eq "clobber" && $existing_acc){
- # update record
- my $sth = $dbh->prepare($sth{update_namespace});
- $sth->execute($term, $auth, $desc, 3, $existing_acc);
- my $reg = &Registration({
- success => 1,
- error_message => "",
- registration_id => $existing_acc,
- });
- return $reg;
-
- } else {
- # create new record
- my $sth = $dbh->prepare($sth{get_last_namespace_accession});
- $sth->execute;
- my ($last_acc) = $sth->fetchrow_array;
- unless ($last_acc){
- my $reg = &Registration({
- success => 0,
- error_message => "unable to determine last service accession number",registration_id => "",
- });
- return $reg;
- }
-
- my $acc = (($last_acc =~ /0*(\d+)/) && $1);
- $acc++;
- my $new_acc = sprintf "%06u", $acc;
- $sth = $dbh->prepare($sth{register_namespace});
- $sth->execute($term, $auth, $desc, 3, $new_acc);
- my $obj_id = $dbh->{mysql_insertid};
-
- unless ($obj_id){
- my $reg = &Registration({
- success => 0,
- error_message => "Failed to register new namespace for unknown reason",registration_id => "",
- });
- return $reg;
- }
- my $reg = &Registration({
- success => 1,
- error_message => "",
- registration_id => $new_acc,
- });
- return $reg;
- }
+ return &_success("Service type $term registered successfully.", $URI);
+
}
@@ -902,29 +702,27 @@
my $type = &_nodeTextContent($Object, "namespaceType");
my $authURI = &_nodeTextContent($Object, "authURI");
my $desc = &_nodeTextContent($Object, "Description");
- my $clobber = &_nodeTextContent($Object, "Clobber");
-
- return ($type, $authURI, $desc, $clobber);
+ my $contact = &_nodeTextContent($Object, "contactEmail");
+ return ($type, $authURI, $desc, $contact);
}
=head2 deregisterNamespace
- Title : deregisterNamespace
- Usage : $REG = $MOBY->deregisterNamespace($inputXML)
- Function : de-register a Namespace
- Returns : MOBY Registration XML object; registration_id was the acc of the
- now de-registered Namespace.
- Notes : THIS WILL FAIL IF ANY SERVICES EXIST WITHIN THAT NAMESPACE TYPE!
- Use the accession number returned when you registered that namespaceType
-
- inputXML :
- <deregisterNamespace>
- <namespaceAcc>000016</namespaceAcc>
- </deregisterNamespace>
+ * used to remove a Namespace from the controlled vocabulary
+ * will fail if that namespace is being used by any services
+ * you will recieve an email for confirmation of the deregistration
- ouptutXML : see Registration XML object
+Input XML :
+
+ <deregisterNamespace>
+ <namespaceType>MyNamespace</namespaceType>
+ </deregisterNamespace>
+
+Ouptut XML :
+
+...Registration Object...
=cut
@@ -932,7 +730,8 @@
sub deregisterNamespace {
my ($pkg, $payload) = @_;
-
+ my $OntologyServer = &_getOntologyServer(ontology => 'namespace');
+
unless ($payload){
my $reg = &Registration({
success => 0,
@@ -942,53 +741,74 @@
return $reg;
}
- my ($acc) = &_deregisterNamespacePayload($payload);
- $debug && &_LOG("deregister namespaceType accession $acc\n");
- unless ($acc){
+ my ($term) = &_deregisterNamespacePayload($payload);
+ $debug && &_LOG("deregister namespaceType accession $term\n");
+ unless ($term){
my $reg = &Registration({
success => 0,
- error_message => "Must include an accession number to deregister a Namespace",
+ error_message => "Must include a Namespace type to deregister.",
registration_id => "",
});
return $reg;
}
-
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
-
- my $sth = $dbh->prepare($sth{validate_namespace_deregistration});
- $sth->execute($acc);
- my ($invalid) = $sth->fetchrow_array;
- if ($invalid){
+
+
+ my ($success, $message, $existingURI) = $OntologyServer->namespaceExists(term => $term);
+ unless ($existingURI){
my $reg = &Registration({
success => 0,
- error_message => "This namespaceType is currently used by $invalid existing Services and thus may not be deregistered",
- registration_id => "$acc",
+ error_message => "Namespace Type $term does not exist",
+ registration_id => "",
});
return $reg;
}
- $sth = $dbh->prepare($sth{get_namespace_id});
- $sth->execute($acc);
- my ($id) = $sth->fetchrow_array;
- unless (defined $id){
+
+ my $dbh = MOBY::central_db_connection->new->dbh;
+ my ($id) = $dbh->selectrow_array("select service_instance.service_instance_id from service_instance natural join simple_input where namespace_type_uris like '%$existingURI%'");
+ if ($id){
my $reg = &Registration({
success => 0,
- error_message => "Namespace with accession $acc does not exist",
- registration_id => "$acc",
+ error_message => "Namespace Type $term is used by a service and may not be deregistered",
+ registration_id => "",
});
return $reg;
}
-
- $sth = $dbh->prepare($sth{deregister_namespace});
- $sth->execute($id);
+ ($id) = $dbh->selectrow_array("select service_instance.service_instance_id from service_instance natural join simple_output where namespace_type_uris like '%$existingURI%'");
+ if ($id){
+ my $reg = &Registration({
+ success => 0,
+ error_message => "Namespace Type $term is used by a service and may not be deregistered",
+ registration_id => "",
+ });
+ return $reg;
+ }
- my $reg = &Registration({
- success => 1,
- error_message => "",
- registration_id => $acc,
- });
- return $reg;
+ ($id) = $dbh->selectrow_array("select service_instance.service_instance_id from service_instance natural join collection_input natural join simple_input where namespace_type_uris like '%$existingURI%'");
+ if ($id){
+ my $reg = &Registration({
+ success => 0,
+ error_message => "Namespace Type $term is used by a service and may not be deregistered",
+ registration_id => "",
+ });
+ return $reg;
+ }
+
+ ($id) = $dbh->selectrow_array("select service_instance.service_instance_id from service_instance natural join collection_output natural join simple_output where namespace_type_uris like '%$existingURI%'");
+ if ($id){
+ my $reg = &Registration({
+ success => 0,
+ error_message => "Namespace Type $term is used by a service and may not be deregistered",
+ registration_id => "",
+ });
+ return $reg;
+ }
+
+ my ($success2, $message2, $URI) = $OntologyServer->deleteNamespace(
+ term => $term);
+ $success2==0 && return &_error($message2, $URI);
+
+ return &_success("Namespace $term registered successfully.", $URI);
}
sub _deregisterNamespacePayload {
@@ -999,96 +819,132 @@
my $obj = $Object->getTagName;
return undef unless ($obj eq 'deregisterNamespace');
- return &_nodeTextContent($Object, "namespaceAcc");
+ return &_nodeTextContent($Object, "namespaceType");
}
=head2 registerService
- Title : registerService
- Usage : $REG = $MOBY->registerService($inputXML)
- Function : register a new MOBY Service
- Returns : MOBY Registration XML object
- Notes : 1) serviceName, AuthURI combination must be unique in database
- 2) @in/@out why lists? Often a MOBY Service will accept a single
- MOBY object type as input and provide a single MOBY object
- type as output. N.B. MOBY Services should, however, expect
- Clients to send multiple such 'singletons' in a single query
- (e.g. a list of GenbankID's to get back a list of sequences).
- The Service should concatenate the MOBY objects results of such a query
- into a single MOBY wrapper. At times, the input to the query is a set
- of MOBY objects. e.g. a GO_ID object, and a Species object might be used
- to request members of a certain gene function from a certain species. In such
- a case, the input and/or output objects should be registered as a list. When
- these objects are passed to/from the service they should be wrapped in a
- "collection envelope" (described elsewhere) in order to preserve their
- relationship to each other; a list of input query-lists must be sent as a
- list of collections.
-
- inputXML (FOR MOBY SERVICES):
- <registerService>
- <Category>moby</Category>
- <serviceName>YourServiceNameHere</serviceName>
- <serviceType>YourServiceTypeHere</serviceType>
- <authURI>your.URI.here</authURI>
- <inputObjects>
- <Input>
- <objectType>ObjectType1</objectType>
- <namespaceType>NamespaceType1</namespaceType>
- </Input>
- <Input>
- <objectType>ObjectType2</objectType>
- <namespaceType>NamespaceType2</namespaceType>
- </Input>
- </inputObjects>
- <outputObjects>
- <objectType>ObjectType1</objectType>
- <objectType>ObjectType2</objectType>
- </outputObjects>
- <URL>http://URL.to.your/Service.pl</URL>
- <Description><![CDATA[
- human readable description of your service]]>
- </Description>
- </registerService>
-
-
- inputXML (FOR CGI GET SERVICES):
- <registerService>
- <Category>cgi</Category>
- <serviceName>YourServiceNameHere</serviceName>
- <serviceType>YourServiceTypeHere</serviceType>
- <authURI>your.URI.here</authURI>
- <URL>http://URL.to.your/CGI.pl</URL>
- <inputObjects>
- <Input>
- sprintf string of your GET line
- </Input>
- </inputObjects>
- <Description><![CDATA[
- human readable description of your service]]>
- </Description>
- </registerService>
-
- inputXML (FOR non-MOBY SOAP SERVICES):
- <registerService>
- <Category>soap</Category>
- <serviceName>YourServiceNameHere</serviceName>
- <serviceType>YourServiceTypeHere</serviceType>
- <authURI>your.URI.here</authURI>
- <URL>http://URL.to.your/definition.wsdl</URL>
- <Description><![CDATA[
- human readable description of your service]]>
- </Description>
- </registerService>
+ * all elements are required
+ * a service must have at least one Input OR Output Object Class.
+ * the contactEmail address must be valid, as it is used to authorize deregistrations and changes to the service you registered.
+ * the Object Classes, Namespaces, and Service Types must all exist for the registration to be successful, so make sure you register these first, or ensure that they already exist in their respective ontologies.
+ * the "authoritativeService" tag is used to indicate whether or not the registered service is "authoritative" for that transformation. i.e. if anyone else were to perform the same transformation they would have to have obtained the information to do so from you. This is similar to, but not necessarily identical to, mirroring someone elses data, since the data in question may not exist prior to service invocation.
+ * only Input Secondary articles are defined during registration; Output Secondary objects are entirely optional and may or may not be interpreted Client-side using their articleName tags.
+
+ Input XML :
+
+ <registerService>
+ <Category>moby</Category> <!-- one of 'moby', 'cgi', 'soap' ; currently only 'moby' services are fully supported -->
+ <serviceName>YourServiceNameHere</serviceName>
+ <serviceType>TypeOntologyTerm</serviceType>
+ <authURI>your.URI.here</authURI>
+ <URL>http://URL.to.your/Service.script</URL>;
+ <contactEmail>your_name at contact.address.com</contactEmail>
+ <authoritativeService>1 | 0 </authoritativeService>
+ <Description><![CDATA[
+ human readable COMPREHENSIVE description of your service]]>
+ </Description>
+ <Input>
+ <!-- zero or more Primary (Simple and/or Complex) articles -->
+ </Input>
+ <secondaryArticles>
+ <!-- zero or more INPUT Secondary articles -->
+ </secondaryArticles>
+ <Output>
+ <!-- zero or more Primary (Simple and/or Complex) articles -->
+ </Output>
+ </registerService>
+
+ Output XML :
+
+ ...Registration Object...
+
+ There are two forms of Primary articles:
+
+ * Simple - the article consists of a single MOBY Object
+ * Collection - the article consists of a collection ("bag") of MOBY Objects (not necessarily the same object type).
+ o Their number/order is not relevant, nor predictable
+ o If order is important to the service provider, then a collection should not be used, rather the collection should be broken into named Simple parameters. This may impose limitations on the the types of services that can be registered in MOBY Central. If it becomes a serious problem, a new Primary article type will be added in a future revision.
+ o The use of more than one Class in a collection is difficult to interpret, though it is equally difficult to envision a service that would require this. It is purposely left losely defined since any given Service Instance can tighten up this definition during the registration process.
+ o A collection may contain zero or more Objects of each of the Classes defined in the XML during Service Instance registration.
+ + Each distinct Object Class only needs to be included once in the XML. Additional entries of that Class within the same Collection definition must be ignored.
+
+ An example of the use of each of these might be another BLAST service, where you provide the sequences that make up the Blast database as well as the sequence to Blast against it. The sequences used to construct the database might be passed as a Collection input article containing multiple Sequence Objects, while the sequence to Blast against it would be a Simple input article consisting of a single Sequence Object.
+
+ There is currently only one form of Secondary article:
+
+ * Secondary - the article may or may not be specifically configured by the client as Input, and may or may not be returned by the Service as output.
+ o In the case of inputs, they are generally user-configurable immediately prior to service invocation.
+ o During service invocation a Client must send all Secondary articles defined in the Service Instance, even if no value has been provided either as default, or Client-side.
+ o Secondary articles that are considered "required" by the Service should be registered with a default value.
+ o The Service may fail if an unacceptable value is passed for any Secondary Article.
+
+
+
+ Articles are, optionally, named using the articleName attribute. This might be used if, for example, the service requires named inputs. The order of non-named articles in a single Input or Output set MUST not be meaningful.
+
+ The XML structure of these articles is as follows:
+
+ * Simple
+
+ <Simple articleName="NameOfArticle">
+ <objectType>ObjectOntologyTerm</objectType>
+ <Namespace>NamespaceTerm</Namespace>
+ <Namespace>...</Namespace><!-- one or more... -->
+ </Simple>
+
+ * Collection note that articleName of the contained Simple objects is not required, and is ignored.
+
+
+ <Collection articleName="NameOfArticle">
+ <Simple>......</Simple> <!-- Simple parameter type structure -->
+ <Simple>......</Simple> <!-- DIFFERENT Simple parameter type (used only when multiple Object Classes appear in a collection) -->
+ </Collection>
+
+ * Secondary
+
+
+ <Parameter articleName="NameOfArticle">
+ <datatype>INT|FLOAT|STRING</datatype>
+ <default>...</default> <!-- any/all of these -->
+ <max>...</max> <!-- ... -->
+ <min>...</min> <!-- ... -->
+ <enum>...<enum> <!-- ... -->
+ <enum>...<enum> <!-- ... -->
+ </Parameter>
-=cut
+=cut
+
+# inputXML (FOR CGI GET SERVICES):
+# <registerService>
+# <Category>cgi</Category>
+# <serviceName>YourServiceNameHere</serviceName>
+# <serviceType>YourServiceTypeHere</serviceType>
+# <authURI>your.URI.here</authURI>
+# <contactEmail>blah at blow.com</contactEmail>
+# <URL>http://URL.to.your/CGI.pl</URL>
+# <authoritativeService>your.URI.here</authoritativeService>
+# <Input>
+# <!-- zero or more pimary (simple or complex) articles -->
+# </Input>
+# <Output>
+# <!-- zero or more pimary (simple or complex) articles -->
+# </Output>
+# <secondaryArticles>
+# <!-- zero or more pimary (simple or complex) articles -->
+# </secondaryArticles>
+# <Description><![CDATA[
+# human readable description of your service]]>
+# </Description>
+# </registerService>
sub registerService {
my ($pkg, $payload) = @_;
- my ($serviceName, $serviceType, $AuthURI, $URL, $desc, $Category) = &_registerServicePayload($payload);
+ my ($serviceName, $serviceType, $AuthURI, $contactEmail, $URL, $authoritativeService, $desc, $Category, $INPUTS, $OUTPUTS, $SECONDARY) = &_registerServicePayload($payload);
- unless ($serviceName || $serviceType){
+ unless ($serviceName && $serviceType && $AuthURI && $contactEmail && $URL && $authoritativeService && $desc && $Category){
$debug && &_LOG("malformed payload $payload\n");
my $reg = &Registration({
success => 0,
@@ -1097,15 +953,6 @@
});
return $reg;
}
- unless ($Category){ # throw error if parameter missing
- $debug && &_LOG("Category missing from $payload\n");
- my $reg = &Registration({
- success => 0,
- error_message => "Category is a required parameter",
- registration_id => "",
- });
- return $reg;
- }
unless (($Category eq "est") || ($Category eq "cgi") || ($Category eq "moby")){ # throw error if parameter missing
$debug && &_LOG("Category $Category invalid\n");
my $reg = &Registration({
@@ -1116,405 +963,476 @@
return $reg;
}
- 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({
- success => 0,
- error_message => "not all required parameters present",
- registration_id => "",
- });
- return $reg;
- }
- } 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({
- success => 0,
- error_message => "not all required parameters present",
- registration_id => "",
- });
- return $reg;
- }
- } elsif ($Category eq "soap") {
- unless ($serviceName && $serviceType && $AuthURI && $URL && $desc){ # throw error if parameter missing
- $debug && &_LOG("$serviceName && $serviceType && $AuthURI && $desc");
- my $reg = &Registration({
- success => 0,
- error_message => "not all required parameters present",
- registration_id => "",
- });
- return $reg;
- }
- } else {
+ unless ($Category eq "moby") {
my $reg = &Registration({
- success => 0,
- error_message => "Category must be one of 'moby', 'cgi' or 'soap'",
- registration_id => "",
- });
+ success => 0,
+ error_message => "Service categories other than 'moby' are not yet implemented",
+ 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};
+ my @IN = @{$INPUTS};
+ my @OUT = @{$OUTPUTS};
+ my @SECS = @{$SECONDARY};
- unless (scalar @IN && scalar @OUT){ # throw error if parameter missing
+ unless (scalar @IN || scalar @OUT){ # throw error if parameter missing
my $reg = &Registration({
success => 0,
- error_message => "must include at least one input and one output object type",
+ error_message => "must include at least one input and/or one output object type",
registration_id => "",
});
return $reg;
}
-
- unless ((scalar @NS)){ # mark it as "any namespace" if they haven't included one
- push @NS, "any";
- }
-
- foreach my $IN(@IN){
- my $sth = $dbh->prepare($sth{check_object});
- $sth->execute($IN);
- my ($valid) = $sth->fetchrow_array; # returns the index number, might be zero
- unless (defined $valid){
- my $reg = &Registration({
- success => 0,
- error_message => "Input object $IN is not recognized as a valid MOBY_Object in the registry. Object may be deprecated.\n",
- registration_id => "",
- });
- return $reg;
- }
- }
- foreach my $OUT(@OUT){
- my $sth = $dbh->prepare($sth{check_object});
- $sth->execute($OUT);
- my ($valid) = $sth->fetchrow_array; # returns the index number, might be zero
- unless (defined $valid){
- my $reg = &Registration({
- success => 0,
- error_message => "Output object $OUT is not recognized as a valid MOBY_Object in the registry. Object may be deprecated.\n",
- registration_id => "",
- });
- return $reg;
+ my %objects_to_be_validated;
+ foreach (@IN, @OUT){
+ foreach my $objectName(&_extractObjectTypes($_)){
+ $objects_to_be_validated{$objectName} = 1;
}
}
+ my $OS = MOBY::OntologyServer->new(ontology => 'object');
- foreach my $NS(@NS){
- next if ($NS eq "any");
- my $sth = $dbh->prepare($sth{check_namespace});
- $sth->execute($NS);
- my ($valid) = $sth->fetchrow_array; # returns the index number, might be zero
- unless (defined $valid){
+ foreach (keys %objects_to_be_validated){
+ my ($valid, $message, $URI) = $OS->objectExists(term => $_);
+ unless ($valid){
my $reg = &Registration({
success => 0,
- error_message => "Output object $NS is not recognized as a valid MOBY_Namespace in the registry\n",
- registration_id => "",
+ error_message => "$message",
+ registration_id => "$URI",
});
return $reg;
}
}
-
- my $sth = $dbh->prepare($sth{check_service_type});
- $sth->execute($serviceType);
- my ($service_type_id) = $sth->fetchrow_array; # might return 0 as a valid table id
- unless (defined $service_type_id){
- my $reg = &Registration({
- success => 0,
- error_message => "Service Type $serviceType is not recognized as a valid MOBY_Service type in the registry\n",
- registration_id => "",
- });
- return $reg;
- }
-
+ $debug && &_LOG("\n\n\aall objects okay\n");
- my $reg_id;
- for (my $x = 1; $x <=50; ++$x){
- $reg_id .= int((rand) * 8) + 1;
- }
- $sth = $dbh->prepare($sth{check_service});
- $sth->execute($AuthURI, $serviceName);
- my ($existing_service) = $sth->fetchrow_array; # returns the index number, might be zero
- if (defined $existing_service){
- my $reg = &Registration({
- success => 0,
- error_message => "Service Type $serviceName is already registered in the $AuthURI namespace. Registration failed.\n",
- registration_id => "",
- });
- return $reg;
- }
-
- $sth = $dbh->prepare($sth{insert_service});
- $sth->execute($serviceName,$service_type_id, $AuthURI, $URL, $desc, $Category, $reg_id);
- my $service_id = $dbh->{mysql_insertid};
- foreach my $IN(@IN){
- my $sth = $dbh->prepare($sth{check_object});
- $sth->execute($IN);
- 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");
- }
- foreach my $OUT(@OUT){
- my $sth = $dbh->prepare($sth{check_object});
- $sth->execute($OUT);
- 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, "out");
- }
- foreach my $NS(@NS){ # may be "any"
- my $sth = $dbh->prepare($sth{check_namespace});
- $sth->execute($NS);
- 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, "ns");
- }
+ # right, registration should be successful now!
+ my $SVC = MOBY::service_instance->new(
+ category => $Category,
+ servicename => $serviceName,
+ service_type => $serviceType,
+ authority_uri => $AuthURI,
+ url => $URL,
+ contact_email => $contactEmail,
+ authoritative => $authoritativeService,
+ description => $desc,
+ );
- my $reg = &Registration({
- success => 1,
- error_message => "",
- registration_id => $reg_id,
- });
- return $reg; # and return it.
-}
-
-
-
-sub _registerServicePayload {
- 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 'registerService');
-
- my $name = &_nodeTextContent($Object, "serviceName");
- my $Category = &_nodeTextContent($Object, "Category");
- my $type = &_nodeTextContent($Object, "serviceType");
- my $authURI = &_nodeTextContent($Object, "authURI");
-
- my $URL = &_nodeTextContent($Object, "URL");
- my $desc = &_nodeTextContent($Object, "Description");
-
-# YES, I KNOW! This part throws away the association
-# Between objects and their namespace, but we have no
-# 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);
- foreach (@types){
- my @child2 = $_->getChildNodes;
- foreach (@child2){
- #print $_->getNodeTypeName, "\t", $_->toString,"\n";
- next unless $_->getNodeType == TEXT_NODE;
- push @INS, $_->toString;
- }
- }
- foreach (@namespaces){
- my @child2 = $_->getChildNodes;
- foreach (@child2){
- #print $_->getNodeTypeName, "\t", $_->toString,"\n";
- next unless $_->getNodeType == TEXT_NODE;
- push @NSS, $_->toString;
- }
- }
- return (\@INS, \@OUTS, \@NSS);
-}
-
-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);
- my ($service_type_id) = $sth->fetchrow_array; # might return 0 as a valid table id
- unless (defined $service_type_id){
+ if (!defined $SVC){
my $reg = &Registration({
success => 0,
- error_message => "Service Type $serviceType is not recognized as a valid Service type in the registry\n",
+ error_message => "Service registration failed for unknown reasons",
registration_id => "",
});
return $reg;
- }
-
-
- my $reg_id;
- for (my $x = 1; $x <=50; ++$x){
- $reg_id .= int((rand) * 8) + 1;
- }
- $sth = $dbh->prepare($sth{check_service});
- $sth->execute($AuthURI, $serviceName);
- my ($existing_service) = $sth->fetchrow_array; # returns the index number, might be zero
- if (defined $existing_service){
+ }
+ if ($SVC == -1){
my $reg = &Registration({
success => 0,
- error_message => "Service Type $serviceName is already registered in the $AuthURI namespace. Registration failed.\n",
+ error_message => "Service with this authority/servicename already exists",
registration_id => "",
});
return $reg;
}
-
- $sth = $dbh->prepare($sth{insert_service});
- $sth->execute($serviceName,$service_type_id, $AuthURI, $URL, $desc, "soap", $reg_id);
- my $service_id = $dbh->{mysql_insertid};
-
- my $reg = &Registration({
- success => 1,
- error_message => "",
- registration_id => $reg_id,
- });
- return $reg; # and return it.
-}
-
-sub _registerCGIService {
+ $debug && &_LOG("new service instance created\n");
- my ($dbh, $sths,$serviceName , $serviceType, $AuthURI , $INS , $URL , $desc) = @_;
- my %sth = %{$sths};
-
- unless ($INS){ # throw error if parameter missing
- my $reg = &Registration({
+ foreach my $IN(@IN){
+ my ($success) = &_registerArticles($SVC, "input", $IN, undef);
+ unless ($success==1) {
+ my $reg = &Registration({
success => 0,
- error_message => "must include an sprintf formatted string indicating your HTTP GET query string",
+ error_message => "Registration Failed During INPUT Article Registration",
registration_id => "",
});
- return $reg;
+ return $reg;
+ }# and return it.
}
-
- my $sth = $dbh->prepare($sth{get_last_object_accession});
- $sth->execute;
- my $last_acc = $sth->fetchrow_array;
-
- unless ($last_acc){
- my $reg = &Registration({
+ foreach my $OUT(@OUT){
+ my ($success) = &_registerArticles($SVC, "output", $OUT, undef);
+ unless ($success==1) {
+ my $reg = &Registration({
success => 0,
- error_message => "unable to determine last object accession number. This is not necessarily your fault! If you think you are right, contact the MOBY developers and report the error",
- registration_id => "",
+ error_message => "Registration Failed During OUTPUT Article Registration",
+ registration_id => $SVC->service_instance_id,
});
- return $reg;
- }
- my $acc = (($last_acc =~ /0*(\d+)/) && $1);
- $acc++;
- my $new_acc = sprintf "%06u", $acc;
-
-
- $sth = $dbh->prepare($sth{check_service_type});
- $sth->execute($serviceType);
- my ($service_type_id) = $sth->fetchrow_array; # might return 0 as a valid table id
- unless (defined $service_type_id){
- my $reg = &Registration({
- success => 0,
- error_message => "Service Type $serviceType is not recognized as a valid Service type in the registry\n",
- registration_id => "",
- });
return $reg;
- }
-
-
- my $reg_id;
- for (my $x = 1; $x <=50; ++$x){
- $reg_id .= int((rand) * 8) + 1;
- }
- $sth = $dbh->prepare($sth{check_service});
- $sth->execute($AuthURI, $serviceName);
- my ($existing_service) = $sth->fetchrow_array; # returns the index number, might be zero
- if (defined $existing_service){
+ }# and return it.
+ }
+ foreach my $SEC(@SECS){
+ my ($success) = &_registerArticles($SVC, "secondary", $SEC, undef);
+ unless ($success==1) {
my $reg = &Registration({
- success => 0,
- error_message => "Service Type $serviceName is already registered in the $AuthURI namespace. Registration failed.\n",
- registration_id => "",
- });
- return $reg;
- }
-
- $sth = $dbh->prepare($sth{insert_service});
- $sth->execute($serviceName,$service_type_id, $AuthURI, $URL, $desc, "cgi", $reg_id);
- my $service_id = $dbh->{mysql_insertid};
-
- my $obj_id;
-
- $sth = $dbh->prepare($sth{register_object});
- $sth->execute("$AuthURI-$serviceName", $new_acc, 1, "sprintf formatted GET string", $AuthURI);
- $obj_id = $dbh->{mysql_insertid};
-
- unless ($obj_id){
- my $reg = &Registration({
- success => 0,
- error_message => "Failed to register object for unknown reason",
- registration_id => "",
+ success => 1,
+ error_message => "Registration Failed During SECONDARY Article Registration",
+ registration_id => $SVC->service_instance_id,
});
- return $reg;
+ return $reg;
+ }# and return it.
}
-
-
- $sth = $dbh->prepare($sth{register_object_xsd});
- $sth->execute($obj_id,"$AuthURI-$serviceName" , $INS);
- $sth = $dbh->prepare($sth{check_object});
- $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,
error_message => "",
- registration_id => $reg_id,
+ registration_id => $SVC->service_instance_id,
});
return $reg; # and return it.
}
+sub _registerArticles {
+ my ($SVC, $inout, $node,$collid) = @_;
+ my $dbh = $SVC->dbh;
+ return unless $node->getNodeType == ELEMENT_NODE;
+ # this is a Simple or a Complex object
+ my $simp_coll = $node->getTagName;
+ $debug && &_LOG("TAGNAME in _registerArticle is $simp_coll");
+
+ my $article = $node->getAttributeNode("articleName"); # may or may not have a name
+ if ($article){$article = $article->getValue()}
+ $debug && &_LOG("ARTICLENAME in _registerArticle is $article");
+
+ my ($object_type, @namespaces);
+
+ if ($simp_coll eq "Collection"){
+
+ my $table = "collection";
+ #$debug && &_LOG("Collection!\n"); # the following SQl belongs in the service_instance object, but screw it, I'm running out of time!
+ #$dbh->do("insert into collection_$inout (service_instance_id, article_name) values (?,?)", undef, ($SVC->service_instance_id, $article));
+ #my $collection_id=$dbh->{mysql_insertid};
+ #my $Simples = $node->getElementsByTagName('Simple');
+ #my $length = $Simples->getLength;
+ #for (my $x=0; $x<$length; ++$x){
+ # &_registerArticles($SVC, $inout, $Simples->item($x),$collection_id);
+ #}
+
+
+ } elsif ($simp_coll eq "Simple") {
+
+
+ my $article = $node->getAttributeNode("articleName")->getValue();
+ # get object type and its URI from the ontoogy server
+ my $types = $node->getElementsByTagName('objectType');
+ my $OE = MOBY::OntologyServer->new(ontology => "object");
+ foreach ($types->item(0)->getChildNodes){ # should only ever be one!
+ ($_->getNodeType == TEXT_NODE) && ($object_type = $_->toString);
+ }
+ my ($success, $message, $typeURI) = $OE->objectExists(term => $object_type);
+ unless ($success){$SVC->DELETE_THYSELF; return "-1"} # kill it all unless this was successful!
+
+ my $namespace_string;
+ my $namespaces = $node->getElementsByTagName('Namespace');
+ my $num_ns = $namespaces->getLength;
+ $OE = MOBY::OntologyServer->new(ontology => "namespace");
+ for (my $n = 0; $n<$num_ns;++$n){
+ foreach my $name($namespaces->item($n)->getChildNodes){
+ if ($name->getNodeType == TEXT_NODE){
+ my ($success, $message, $URI) = $OE->namespaceExists(term => $name->toString);
+ unless ($success){$SVC->DELETE_THYSELF; return "-1"}
+ $namespace_string .=$URI.",";
+ }
+ }
+ }
+ chop($namespace_string); # remove trailing comma
+ my $dbh = $SVC->dbh;
+ my $service_instance_id;
+ unless ($collid){$service_instance_id = $SVC->service_instance_id} # one or the other, but not both
+ $dbh->do("insert into simple_".$inout."
+ (object_type_uri,
+ namespace_type_uris,
+ article_name,
+ service_instance_id,
+ collection_".$inout."_id)
+ values (?,?,?,?,?)",
+ undef,
+ ($typeURI,
+ $namespace_string,
+ $article,
+ $service_instance_id,
+ $collid));
+
+ } elsif ($simp_coll eq "Parameter"){
+ my $article = $node->getAttributeNode("articleName")->getValue();
+ my $types = $node->getElementsByTagName('datatype');
+ my $datatype;
+ foreach ($types->item(0)->getChildNodes){ # should only ever be one!
+ ($_->getNodeType == TEXT_NODE) && ($datatype = $_->toString);
+ }
+ my $defs = $node->getElementsByTagName('default');
+ my $def;
+ foreach ($defs->item(0)->getChildNodes){ # should only ever be one!
+ ($_->getNodeType == TEXT_NODE) && ($def = $_->toString);
+ }
+ my $maxs = $node->getElementsByTagName('max');
+ my $max;
+ foreach ($maxs->item(0)->getChildNodes){ # should only ever be one!
+ ($_->getNodeType == TEXT_NODE) && ($max = $_->toString);
+ }
+ my $mins = $node->getElementsByTagName('min');
+ my $min;
+ foreach ($mins->item(0)->getChildNodes){ # should only ever be one!
+ ($_->getNodeType == TEXT_NODE) && ($min = $_->toString);
+ }
+ my $enums = $node->getElementsByTagName('enum');
+ my @enums;
+ my $numenums = $enums->getLength;
+ for (my $n=0;$n<$numenums;++$n){
+ foreach ($enums->item($n)->getChildNodes){ # should only ever be one!
+ ($_->getNodeType == TEXT_NODE) && (push @enums, $_->toString);
+ }
+ }
+ my $enum_string = join "",(map {$_.","} @enums);
+ chop $enum_string; # get rid of trailing comma
+ my $dbh = $SVC->dbh;
+ $dbh->do(q{insert into secondary_input (default_value,maximum_value,minimum_value,enum_value,datatype,article_name,service_instance_id) values (?,?,?,?,?,?,?)},
+ undef,
+ ($def, $max, $min, $enum_string, $datatype, $article, $SVC->service_instance_id));
+ }
+ return 1;
+}
+sub _registerServicePayload {
+ 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 'registerService');
+
+ my $serviceName = &_nodeTextContent($Object, "serviceName");
+ my $Category = &_nodeTextContent($Object, "Category");
+ my $serviceType = &_nodeTextContent($Object, "serviceType");
+ my $AuthURI = &_nodeTextContent($Object, "authURI");
+ my $contactEmail = &_nodeTextContent($Object, "contactEmail");
+ my $authoritativeService = &_nodeTextContent($Object, "authoritativeService");
+ my $URL = &_nodeTextContent($Object, "URL");
+ my $desc = &_nodeTextContent($Object, "Description");
+ my $INPUTS = &_nodeRawContent($Object, "Input"); # returns array ref
+ my $OUTPUTS = &_nodeRawContent($Object, "Output"); # returns array ref
+ my $SECONDARIES = &_nodeRawContent($Object, "secondaryArticles"); # returns array ref
+
+ return ($serviceName, $serviceType, $AuthURI, $contactEmail, $URL, $authoritativeService, $desc, $Category, $INPUTS, $OUTPUTS, $SECONDARIES);
+}
+sub _extractObjectTypes {
+ my ($DOM) = @_; # DOM is either a <Simple/> or a <Collection/> article
+ $debug && &_LOG("\n\n\nExtracting object types from \n$DOM \n\n");
+ unless (ref($DOM) =~ /^XML/){
+ my $Parser = new XML::DOM::Parser;
+ my $doc = $Parser->parse($DOM);
+ $DOM = $doc->getDocumentElement();
+ }
+ my $x = $DOM->getElementsByTagName("objectType");
+ my @objectnames;
+ my $l = $x->getLength; # might be a Collection object with multiple simples...
+ for (my $n=0; $n < $l; ++$n){
+ my @child = $x->item($n)->getChildNodes;
+ foreach (@child){
+ $debug && &_LOG ($_->getNodeTypeName, "\t", $_->toString,"\n");
+ next unless ($_->getNodeType == TEXT_NODE);
+ my $name = $_->toString; chomp $name;
+ push @objectnames, $name;
+ }
+ }
+ return (@objectnames);
+}
+
+#
+#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);
+# foreach (@types){
+# my @child2 = $_->getChildNodes;
+# foreach (@child2){
+# #print $_->getNodeTypeName, "\t", $_->toString,"\n";
+# next unless $_->getNodeType == TEXT_NODE;
+# push @INS, $_->toString;
+# }
+# }
+# foreach (@namespaces){
+# my @child2 = $_->getChildNodes;
+# foreach (@child2){
+# #print $_->getNodeTypeName, "\t", $_->toString,"\n";
+# next unless $_->getNodeType == TEXT_NODE;
+# push @NSS, $_->toString;
+# }
+# }
+# return (\@INS, \@OUTS, \@NSS);
+#}
+#
+#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);
+# my ($service_type_id) = $sth->fetchrow_array; # might return 0 as a valid table id
+# unless (defined $service_type_id){
+# my $reg = &Registration({
+# success => 0,
+# error_message => "Service Type $serviceType is not recognized as a valid Service type in the registry\n",
+# registration_id => "",
+# });
+# return $reg;
+# }
+#
+#
+# my $reg_id;
+# for (my $x = 1; $x <=50; ++$x){
+# $reg_id .= int((rand) * 8) + 1;
+# }
+# $sth = $dbh->prepare($sth{check_service});
+# $sth->execute($AuthURI, $serviceName);
+# my ($existing_service) = $sth->fetchrow_array; # returns the index number, might be zero
+# if (defined $existing_service){
+# my $reg = &Registration({
+# success => 0,
+# error_message => "Service Type $serviceName is already registered in the $AuthURI namespace. Registration failed.\n",
+# registration_id => "",
+# });
+# return $reg;
+# }
+#
+# $sth = $dbh->prepare($sth{insert_service});
+# $sth->execute($serviceName,$service_type_id, $AuthURI, $URL, $desc, "soap", $reg_id);
+# my $service_id = $dbh->{mysql_insertid};
+#
+# my $reg = &Registration({
+# success => 1,
+# error_message => "",
+# registration_id => $reg_id,
+# });
+# return $reg; # and return it.
+#}
+#
+#sub _registerCGIService {
+#
+# my ($dbh, $sths,$serviceName , $serviceType, $AuthURI , $INS , $URL , $desc) = @_;
+# my %sth = %{$sths};
+#
+# 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",
+# registration_id => "",
+# });
+# return $reg;
+# }
+#
+# my $sth = $dbh->prepare($sth{get_last_object_accession});
+# $sth->execute;
+# my $last_acc = $sth->fetchrow_array;
+#
+# unless ($last_acc){
+# my $reg = &Registration({
+# success => 0,
+# error_message => "unable to determine last object accession number. This is not necessarily your fault! If you think you are right, contact the MOBY developers and report the error",
+# registration_id => "",
+# });
+# return $reg;
+# }
+# my $acc = (($last_acc =~ /0*(\d+)/) && $1);
+# $acc++;
+# my $new_acc = sprintf "%06u", $acc;
+#
+#
+# $sth = $dbh->prepare($sth{check_service_type});
+# $sth->execute($serviceType);
+# my ($service_type_id) = $sth->fetchrow_array; # might return 0 as a valid table id
+# unless (defined $service_type_id){
+# my $reg = &Registration({
+# success => 0,
+# error_message => "Service Type $serviceType is not recognized as a valid Service type in the registry\n",
+# registration_id => "",
+# });
+# return $reg;
+# }
+#
+#
+# my $reg_id;
+# for (my $x = 1; $x <=50; ++$x){
+# $reg_id .= int((rand) * 8) + 1;
+# }
+# $sth = $dbh->prepare($sth{check_service});
+# $sth->execute($AuthURI, $serviceName);
+# my ($existing_service) = $sth->fetchrow_array; # returns the index number, might be zero
+# if (defined $existing_service){
+# my $reg = &Registration({
+# success => 0,
+# error_message => "Service Type $serviceName is already registered in the $AuthURI namespace. Registration failed.\n",
+# registration_id => "",
+# });
+# return $reg;
+# }
+#
+# $sth = $dbh->prepare($sth{insert_service});
+# $sth->execute($serviceName,$service_type_id, $AuthURI, $URL, $desc, "cgi", $reg_id);
+# my $service_id = $dbh->{mysql_insertid};
+#
+# my $obj_id;
+#
+# $sth = $dbh->prepare($sth{register_object});
+# $sth->execute("$AuthURI-$serviceName", $new_acc, 1, "sprintf formatted GET string", $AuthURI);
+# $obj_id = $dbh->{mysql_insertid};
+#
+# unless ($obj_id){
+# my $reg = &Registration({
+# success => 0,
+# error_message => "Failed to register object for unknown reason",
+# registration_id => "",
+# });
+# return $reg;
+# }
+#
+#
+# $sth = $dbh->prepare($sth{register_object_xsd});
+# $sth->execute($obj_id,"$AuthURI-$serviceName" , $INS);
+# $sth = $dbh->prepare($sth{check_object});
+# $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,
+# error_message => "",
+# registration_id => $reg_id,
+# });
+# return $reg; # and return it.
+#}
=head2 registerServiceWSDL
@@ -1559,30 +1477,42 @@
sub deregisterService {
my ($pkg, $payload) = @_;
$debug && &_LOG("\nstarting deregistration\n");
- my ($reg_id) = &_deregisterServicePayload($payload);
- unless ($reg_id){
+ my ($authURI, $serviceName) = &_deregisterServicePayload($payload);
+ unless ($authURI && $serviceName){
my $reg = &Registration({
success => 0,
- error_message => "must provide a registration id number\n",
+ error_message => "must provide an authority and a service name\n",
registration_id => 0,
});
}
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
- my $sth = $dbh->prepare($sth{service_id});
- $sth->execute($reg_id);
- my ($sid) = $sth->fetchrow_array;
- return 0 unless $sid;
- $sth = $dbh->prepare($sth{remove_service});
- $sth->execute($sid);
- $sth = $dbh->prepare($sth{remove_service_params});
- $sth->execute($sid);
- return &Registration({
- success => 1,
- error_message => "",
- registration_id => 0,
+ my $SERVICE = MOBY::service_instance->new(
+ servicename => $serviceName,
+ authority_uri => $authURI);
+
+ unless (defined $SERVICE){
+ return &Registration({
+ success => 0,
+ error_message => "The service specified by authority=$authURI servicename=$serviceName does not exist in the registry",
+ registration_id => 0,
+ });
+ }
+
+ my $result = $SERVICE->DELETE_THYSELF;
+
+ if ($result){
+ return &Registration({
+ success => 1,
+ error_message => "",
+ registration_id => 0,
+ });
+ } else {
+ return &Registration({
+ success => 0,
+ error_message => "Service deletion failed for unknown reasons",
+ registration_id => 0,
});
+ }
}
sub _deregisterServicePayload {
@@ -1593,520 +1523,863 @@
my $Object = $doc->getDocumentElement();
my $obj = $Object->getTagName;
return undef unless ($obj eq 'deregisterService');
- return &_nodeTextContent($Object, "serviceID");
+ my $authURI = &_nodeTextContent($Object, "authURI");
+ my $name = &_nodeTextContent($Object, "serviceName");
+ return ($authURI, $name);
}
+=head2 findService
-
-=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>
-
+ inputXML:
+ <findService>
+ <!-- Service Query Object -->
+ </findService>
+
+ ServiceQueryObject XML:
+ To query MOBY Central, you fill out the relevant elements of a Query Ojbect. These include the input and/or output data Classes (by name from the Class ontology), the Service-type (by name from the Service-type ontology), the authority (service provider URI), or any number of keywords that must appear in the service description.
+
+ * MOBY Central finds all services which match the contents of the Query Object.
+ * All elements are optional, however at least one must be present.
+ * All elements present are considered as increasingly limiting on the search (i.e. "AND").
+ * keywords are:
+ o comma-delimited
+ o sentence-fragments are enclosed in double-quotes
+ o wildcard "*" is allowed in combination with keyword fragments and or sentence fragments (lone "*" is meaningless and ignored)
+ o multiple keywords are considered joined by "AND".
+
+In addition to the search parameters, there are two "flags" that can be set in the Query object:
+
+ * expandServices: this flag will cause MOBY Central to traverse the Service ontology and discover services that are child types (more specific) than the Service-type you requested
+
+ e.g. you might request "alignment", and it would discover services such as "Blast", "Smith Waterman", "Needleman Wunsch"
+
+ * expandObjects: this flag will cause MOBY Central to traverse the Class ontology to find services that operate not only on the Object Class you are querying, but also any parent types or sub-objects of that Object Class.
+
+ e.g. if you request services that work on AnnotatedSequence Objects this flag will also return services that work on Sequence objects, since AnnotatedSequence objects inherit from Sequence objects
+
+The Query object structure is as follows:
+
+ <inputObjects>
+ <Input>
+ <!-- one or more Simple or Complex Primary articles -->
+ </Input>
+ </inputObjects>
+ <outputObjects>
+ <Output>
+ <!-- one or more Simple or Complex Primary articles -->
+ </Output>
+ </outputObjects>
+ <authoritative>1</authoritative>
+ <Category>moby</Category>
+ <serviceType>ServiceTypeTerm</serviceType>
+ <authURI>http://desired.service.provider</authURI>;
+ <expandObjects>1|0</expandObjects>
+ <expandServices>1|0</expandServices>
+ <keywords>
+ <keyword>something</keyword>
+ ....
+ ....
+ </keywords>
=cut
-
-sub locateServiceByKeywords{
+sub findService {
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 .="<Category>$cat</Category>\n";
- $response .="<serviceType>$type</serviceType>\n";
- $response .="<outputObject>$objectOUT</outputObject>\n";
- $response .= "<Description><![CDATA[$desc]]></Description>\n";
- $response .= "</Service>\n";
+ $debug && &_LOG("\nLOOKING FOR SERVICES\n");
+ #return ('serviceType' => $serviceType,
+ # 'authURI' => $AuthURI,
+ # 'expandObjects' => $expandObjects,
+ # 'expandServices' => $expandServices,
+ # 'authoritative' => $authoritative,
+ # 'category' => $Category,
+ # 'inputObjects' => $INPUTS,
+ # 'outputObjects' => $OUTPUTS,
+ # 'keywords' => \@kw);
+ my %findme = &_findServicePayload($payload);
+ my %valid_service_ids;
+ my $criterion_count=0;
+ # we want to avoid joins, since they slow things down, so...
+ # the logic is that we keep a hash of valid id's
+ # and the number of times they are discovered
+ # we also count the number of criterion
+ # we only want the service_id's that appear as many times as the criterion we have
+ # since they will have matched every criterion.
+ my $dbh = MOBY::central_db_connection->new()->dbh;
+ if ($findme{authoritative}){
+ ++$criterion_count;
+ my $ids = $dbh->selectall_arrayref(q{select service_instance_id from service_instance where authoritative=?}, undef, $findme{authoritative});
+ unless (scalar @{$ids}){
+ return &_serviceListResponse($dbh,undef);
+ }
+ foreach (@{$ids}){
+ ++$valid_service_ids{$_->[0]}; # increment that particular id's count by one
+ }
+ }
+ if ($findme{serviceType}){
+ my $OS = MOBY::OntologyServer->new(ontology => 'service');
+ my ($exists, $message, $URI) = $OS->serviceExists('serviceType');
+ unless ($exists){
+ 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);
+ foreach (@{$ids}){
+ ++$valid_service_ids{$_->[0]}; # increment that particular id's count by one
+ }
+ }
+ if ($findme{authURI}){
+ ++$criterion_count;
+ my ($id) = $dbh->selectrow_array(q{select authority_id from authority where authority_uri = ? or authority_common_name = ?},undef,($findme{authURI}, $findme{authURI}));
+ unless ($id){
+ return &_serviceListResponse($dbh,undef);
+ }
+ my $ids = $dbh->selectall_arrayref(q{select service_instance_id from service_instance where authority_id=?}, undef, $id);
+ foreach (@{$ids}){
+ ++$valid_service_ids{$_->[0]}; # increment that particular id's count by one
+ }
+ }
+ $findme{category} = 'moby' unless $findme{category};
+ if ($findme{category}){
+ ++$criterion_count;
+ my $ids = $dbh->selectall_arrayref(q{select service_instance_id from service_instance where category=?}, undef, lc($findme{category}));
+ unless (scalar @{$ids}){
+ return &_serviceListResponse($dbh,undef);
+ }
+ foreach (@{$ids}){
+ ++$valid_service_ids{$_->[0]}; # increment that particular id's count by one
+ }
+ }
+ if (scalar @{$findme{keywords}}){
+ ++$criterion_count;
+ my $searchstring;
+ foreach (@{$findme{keywords}}){
+ $searchstring .= " OR description like '%$_%' ";
+ }
+ $searchstring =~ s/OR//; # just the first one
+ my $ids = $dbh->selectall_arrayref(q{select service_instance_id from service_instance where $searchstring});
+ unless (scalar @{$ids}){
+ return &_serviceListResponse($dbh, undef);
+ }
+ foreach (@{$ids}){
+ ++$valid_service_ids{$_->[0]}; # increment that particular id's count by one
+ }
+ }
+ if (scalar @{$findme{inputObjects}}){
+ ++$criterion_count;
+ my $obj = (shift @{$findme{inputObjects}});
+ my @si_ids = &_searchForServicesWithArticle($dbh, "input", $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
+ my @new_ids = &_searchForServicesWithArticle($dbh, "input", $obj,''); # 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;
+ if ($instances{$id}){push @good_ids, $id} # if they are in common, then that id is still good
+ }
+ map {$good_ids{$_}=1} @good_ids; # make a hash of the new good id's
+ %instances = %good_ids; # and replace the original list with this more limited one
+ }
}
- }
- $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;
+ # now %instances contains only valid ID numbers
+ foreach (keys %instances){
+ ++$valid_service_ids{$_};
+ }
+ }
+ if (scalar @{$findme{outputObjects}}){
+ ++$criterion_count;
+ my $obj = (shift @{$findme{inputObjects}});
+ my @si_ids = &_searchForServicesWithArticle($dbh, "input", $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
+ my @new_ids = &_searchForServicesWithArticle($dbh, "input", $obj,''); # 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;
+ if ($instances{$id}){push @good_ids, $id} # if they are in common, then that id is still good
+ }
+ map {$good_ids{$_}=1} @good_ids; # make a hash of the new good id's
+ %instances = %good_ids; # and replace the original list with this more limited one
+ }
+ }
+ # now %instances contains only valid ID numbers
+ foreach (keys %instances){
+ ++$valid_service_ids{$_};
}
}
-
- $debug && &_LOG("found keywords @kw\n");
- return (\@kw);
-}
-
-
-
-
-=head2 locateServiceByType
-
- Title : locateServiceByType
- Usage : $services = $MOBY->locateServiceByType($inputXML)
- Function : get the service names/descriptions for a particular type of Service
- (and child-types)
- Returns : XML (see below)
- inputXML :
- <locateServiceByType>
- <serviceType>ServiceType</serviceType>
- <fullServices>1 | 0</fullServices>
- </locateServiceByType>
-
- 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
-
+ my @final;
+ while (my ($id, $freq) = each %valid_service_ids){
+ #print "ID: $id FREQ:$freq\n";
+ next unless $freq == $criterion_count; # has to have matched every criterion
+ push @final, $id;
+ }
+ return &_serviceListResponse($dbh, @final);
-sub locateServiceByType {
- my ($pkg, $payload) = @_;
-
- my ($serviceType, $full_services) = &_locateServiceByTypePayload($payload);
- return undef unless $serviceType;
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
- my @ServiceIDs;
- if ($full_services){ # we need this service type and all child types
- @ServiceIDs = &_traverseServiceDAG($dbh,$serviceType, $sth_hash);
- } else { # we need only the service type of this element
- my $sth = $dbh->prepare($sth{get_service_type_id});
- $sth->execute($serviceType);
- @ServiceIDs = $sth->fetchrow_array;
- }
-
- # 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,
- OEout.term,
- S.auth_uri,
- S.description,
- OEtype.term,
- S.category
- from
- Service as S,
- OntologyEntry as OEtype,
- OntologyEntry as OEout,
- ServiceParameter as SPout,
- Ontology as O
- where
- OEtype.is_obselete = 'n'
- and OEout.is_obselete = 'n'
- and SPout.type = 'out'
- and SPout.service_id = S.id
- and S.service_type_id = OEtype.id
- and OEtype.ontology_id = O.id
- and OEout.id = SPout.ontologyentry_id
- and O.name='MOBY_Service'
- and OEtype.id in (".join (",", map {"\"".$_."\""} @ServiceIDs).") ";
-
- return &_getValidServices($dbh, $sth_hash, $query);
}
+sub _searchForServicesWithArticle {
+ my ($dbh, $inout, $node, $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!
+
+ # this element node may be a Simple or a Collection object
+ my $simp_coll = $node->getTagName;
+ $debug && &_LOG("TAGNAME in _searchForArticle is $simp_coll");
+
+ my @valid_ids;
+ if ($simp_coll eq "Collection"){
+ return (); # this will erase all current successful service_instance matches... too bad
+ # not yet implemented
+ #$debug && &_LOG("Collection!\n"); # the following SQl belongs in the service_instance object, but screw it, I'm running out of time!
+ #my $Simples = $node->getElementsByTagName('Simple');
+ #my $length = $Simples->getLength;
+ #my @simples;
+ #for (my $x=0; $x<$length; ++$x){
+ # push @simples, $Simples->item($x);
+ #}
+ #@collids = &_searchForCollectedSimples($dbh, $inout, \@simples);
+ } elsif ($simp_coll eq "Simple") {
+ @valid_ids = &_searchForSimple($dbh,$node, "input");
-sub _locateServiceByTypePayload {
- 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 'locateServiceByType');
- my $type = &_nodeTextContent($Object, "serviceType");
- my $expand = &_nodeTextContent($Object, "fullServices");
- return ($type, $expand);
+ }
+ return @valid_ids;
}
-
-=head2 locateServiceByInput
-
- Title : locateServiceByInput
- Usage : $services = $MOBY->locateServiceByInput($inputXML)
- Function : get the names/descriptions for services that use certain INPUT's
- Returns : XML (see below)
- inputXML :
- <locateServiceByInput>
- <inputObjects>
- <Input>
- <objectType>ObjectType1</objectType>
- <namespaceType>NamespaceType1</namespaceType>
- </Input>
- <Input>
- <objectType>ObjectType2</objectType>
- <namespaceType>NamespaceType2</namespaceType>
- </Input>
- </inputObjects>
- <serviceType>ServiceTypeTerm</serviceType>
- <authURI>http://desired.service.provider</authURI>
- <fullObjects>1|0</fullObjects>
- <fullServices>1|0</fullServices>
- </locateServiceByInput>
-
- 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 locateServiceByInput {
- my ($pkg, $payload) = @_;
- my ($serviceType, $AuthURI, $INs, $NSs, $full_objects, $full_services) = &_locateServiceByInputPayload($payload);
- unless (defined $full_objects){$full_objects = 1}
- unless (defined $full_services){$full_services = 1}
- $debug && &_LOG("RECEIVED PARAMS: \n", join "\n", at _);
-
- push @{$NSs}, "any"; # 'any' is a valid namespace for all service searches
-
- return undef unless $INs;
+sub _searchForSimple {
+ # returns list of service_instance ID's
+ # that match this simple
+ my ($dbh,$node, $inout) = @_;
+ my ($objectURI, $namespaceURIs) = &_extractObjectTypesAndNamespaces($node); # ref of $hash{type}=[ns1, ns2, ns3]
+ unless ($objectURI){return ()};
- my ($dbh, $sth_hash) = &_dbAccess;
- my (@ServiceIDs);
- my %sth = %{$sth_hash};
-
-
- if ($serviceType && $full_services){ # we need this service type and all child types
- @ServiceIDs = &_traverseServiceDAG($dbh, $serviceType, $sth_hash);
- } elsif ($serviceType) { # we need only the service type of this element
- my $sth = $dbh->prepare($sth{get_service_type_id});
- $sth->execute($serviceType);
- @ServiceIDs = $sth->fetchrow_array;
+ my $nsquery;
+ foreach my $ns(@{$namespaceURIs}){ # namespaces are already URI's
+ $nsquery .=" OR namespace_type_uri like '%$ns%' ";
}
-
- my (@ObjectIDs, %ObjectIDs);
- if ($full_objects){ # we need this Object type and all parent types
- foreach (@{$INs}){
- $debug && &_LOG("traversing DAG for $_");
- foreach (&_traverseObjectDAG($dbh, $_, $sth_hash, 'p')){
- $debug && &_LOG("found $_ in DAG");
- $ObjectIDs{$_}=1;
- }
- }
- @ObjectIDs = keys %ObjectIDs;
- } else { # we need only the Object type of the elements we were sent
- foreach (@{$INs}){
- my $sth = $dbh->prepare($sth{get_object_type_id});
- $sth->execute($_);
- push @ObjectIDs, $sth->fetchrow_array;
- }
+ if ($nsquery){$nsquery =~ s/OR//;} # just the first
+ my $query = "select distinct service_instance_id from simple_input where object_type_uri = '$objectURI' ";
+ ($nsquery) && ($query .=" AND ($nsquery) ");
+ #print "\nQUERY $query\n";
+ my $nsref = $dbh->selectall_arrayref($query);
+ my @ids;
+ foreach (@{$nsref}){
+ push @ids, $_->[0];
}
-
- $debug && &_LOG("INs @{$INs} ::: @ObjectIDs\n");
- if ($NSs){$debug && &_LOG("NSs @{$NSs} \n")};
- if ($serviceType){$debug && &_LOG("Servicetypes $serviceType, @ServiceIDs\n")};
-
- my $query = "
- Select
- S.service_name,
- OEout.term,
- S.auth_uri,
- S.description,
- OEtype.term,
- S.category
- from
- Service as S,
- OntologyEntry as OEtype,
- OntologyEntry as OEin,
- OntologyEntry as OEout,
- ServiceParameter as SPout,
- ServiceParameter as SPin,
- OntologyEntry as OEns,
- ServiceParameter as SPns
- where
- OEin.is_obselete = 'n'
- and OEout.is_obselete = 'n'
- and S.service_type_id = OEtype.id
- and SPout.type = 'out'
- and SPout.service_id = S.id
- and SPout.ontologyentry_id = OEout.id
- and SPin.type = 'in'
- and SPin.service_id = S.id
- and SPin.ontologyentry_id = OEin.id
- and SPns.type = 'ns'
- and SPns.service_id = S.id
- and SPns.ontologyentry_id=OEns.id
- and OEin.id in (". join (",", map {"\"".$_."\""} @ObjectIDs).")
- and OEns.term in (". join (",", map {"\"".$_."\""} @{$NSs}).") ";
-
- if ($serviceType){ $query .= "and (S.service_type_id in (".(join ',', @ServiceIDs).")) "} # service type is a DAG, so get all relevant types
- if ($AuthURI){ $query .= "and (S.auth_uri = '$AuthURI') "}
-
- $debug && &_LOG("*************************\ Query is: $query\n****************************");
- return &_getValidServices($dbh, $sth_hash, $query);
-
+ return @ids;
}
-sub _locateServiceByInputPayload {
-
- 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 'locateServiceByInput');
- my $type = &_nodeTextContent($Object, "serviceType");
- my $authURI = &_nodeTextContent($Object, "authURI");
- my $fullObjects = &_nodeTextContent($Object, "fullObjects");
- my $fullServices = &_nodeTextContent($Object, "fullServices");
+sub _searchForCollectedSimples {
+ # retuns the unique
+ my ($dbh, $inout, $simples)= @_;
+ my $query;
+ foreach my $node(@{$simples}){
+ my ($objectURI, $namespaceURIs) = &_extractObjectTypesAndNamespaces($node); # ref of $hash{type}=[ns1, ns2, ns3]
+ 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
+ $query .= " OR (object_type_uri = '$objectURI' AND ($nsquery)) ";
+ }
+ if ($query){$query =~s/AND//;} # just the first
+ $debug && &_LOG("_searchForCollectedSimples QUERY = select distinct(collection_$inout"."id from simple_$inout where collection_$inout"."_id IS NOT NULL AND $query\n\n");
- my $x = $Object->getElementsByTagName("inputObjects");
- my @types = $x->item(0)->getElementsByTagName("objectType");
- my @namespaces = $x->item(0)->getElementsByTagName("namespaceType");
- my (@INS, @NSS);
- foreach (@types){
- my @child2 = $_->getChildNodes;
- foreach (@child2){
- #print $_->getNodeTypeName, "\t", $_->toString,"\n";
- next unless $_->getNodeType == TEXT_NODE;
- push @INS, $_->toString;
- }
- }
- foreach (@namespaces){
- my @child2 = $_->getChildNodes;
- foreach (@child2){
- #print $_->getNodeTypeName, "\t", $_->toString,"\n";
- next unless $_->getNodeType == TEXT_NODE;
- push @NSS, $_->toString;
- }
+ my $collids = $dbh->selectall_arrayref("create temporary table select distinct(collection_$inout"."id from simple_$inout where collection_$inout"."_id IS NOT NULL AND $query");
+ my @result;
+ foreach (@{$collids}){
+ push @result, $_->[0];
}
- return ($type, $authURI, \@INS, \@NSS, $fullObjects, $fullServices);
-}
-
-
-=head2 locateServiceByOutput
-
- Title : locateServiceByOutput
- Usage : $services = $MOBY->locateServiceByOutput($inputXML)
- Function : get the names/descriptions for services that use certain INPUT's
- Returns : XML (see below)
- inputXML :
- <locateServiceByOutput>
- <objectType>ObjectType</objectType>
- <serviceType>ServiceTypeTerm</serviceType>
- <authURI>http://desired.service.provider</authURI>
- <fullObjects>1|0</fullObjects>
- <fullServices>1|0</fullServices>
- <locateServiceByOutput>
-
- 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 locateServiceByOutput {
- my ($pkg, $payload) = @_;
- my ($serviceType, $AuthURI, $OUT, $full_objects, $full_services) = &_locateServiceByOutputPayload($payload);
- unless (defined $full_objects){$full_objects = 1}
- unless (defined $full_services){$full_services = 1}
- $debug && &_LOG("RECEIVED PARAMS", @_);
- # this one has to be generated dynamically...
- return undef unless $OUT;
- my ($dbh, $sth_hash) = &_dbAccess;
- my (@ServiceIDs);
- my %sth = %{$sth_hash};
-
- if ($serviceType && $full_services){ # we need this service type and all child types
- $debug && &_LOG("Traversing Service DAG");
- @ServiceIDs = &_traverseServiceDAG($dbh, $serviceType, $sth_hash);
- } elsif ($serviceType) { # we need only the service type of this element
- $debug && &_LOG("NOT Traversing Service DAG");
- my $sth = $dbh->prepare($sth{get_service_type_id});
- $sth->execute($serviceType);
- @ServiceIDs = $sth->fetchrow_array;
- }
- $debug && &_LOG("FINISHED Traversing Service DAG");
-
- my (@ObjectIDs, %ObjectIDs);
- if ($full_objects){ # we need this Object type and all parent types
- $debug && &_LOG("traversing Object DAG for $OUT");
- foreach (&_traverseObjectDAG($dbh, $OUT, $sth_hash, 'c')){
- $debug && &_LOG("found $_ in Object DAG");
- $ObjectIDs{$_}=1;
- }
- @ObjectIDs = keys %ObjectIDs;
- } else { # we need only the Object type of the elements we were sent
- my $sth = $dbh->prepare($sth{get_object_type_id});
- $sth->execute($OUT);
- push @ObjectIDs, $sth->fetchrow_array;
- }
-
- $debug && &_LOG("OUT $OUT ::: @ObjectIDs\n");
-# if ($NSs){&_LOG("NSs @{$NSs} \n")};
- if ($serviceType){$debug && &_LOG("Servicetypes $serviceType, @ServiceIDs\n")};
-
- my $query = "
- Select
- S.service_name,
- OEout.term,
- S.auth_uri,
- S.description,
- OEtype.term,
- S.category
- from
- Service as S,
- Ontology as O,
- OntologyEntry as OEtype,
- OntologyEntry as OEout,
- ServiceParameter as SPout,
- OntologyEntry as OEns,
- ServiceParameter as SPns
- where
- OEout.is_obselete = 'n'
- and OEtype.is_obselete = 'n'
- and S.service_type_id = OEtype.id
- and O.name = 'MOBY_Service'
- and O.id = OEtype.ontology_id
- and SPout.service_id = SPns.service_id
- and SPout.service_id = S.id
- and OEout.id = SPout.ontologyentry_id
- and OEns.id = SPns.ontologyentry_id
- and SPout.type = 'out'
- and SPns.type = 'ns'
- and OEout.id in (". join (",", map {"\"".$_."\""} @ObjectIDs).") ";
- #if ($NSs && ${$NSs}[0]){ # must have at least one element
- # $query .= "
- # and OEns.term in (". join (",", map {"\"".$_."\""} @{$NSs}).") ";
- #}
- if ($serviceType){ $query .= "and (S.service_type_id in (".(join ',', @ServiceIDs).")) "} # service type is a DAG, so get all relevant types
- if ($AuthURI){ $query .= "and (S.auth_uri = '$AuthURI') "}
-
- $debug && &_LOG("*************************\ Query is: $query\n****************************");
- return &_getValidServices($dbh, $sth_hash, $query);
-
}
-
-sub _locateServiceByOutputPayload {
+sub _findServicePayload {
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 'locateServiceByOutput');
- my $type = &_nodeTextContent($Object, "serviceType");
- my $authURI = &_nodeTextContent($Object, "authURI");
- my $fullObjects = &_nodeTextContent($Object, "fullObjects");
- my $fullServices = &_nodeTextContent($Object, "fullServices");
- my $output = &_nodeTextContent($Object, "objectType");
+ return undef unless ($obj eq 'findService');
- return ($type, $authURI, $output, $fullObjects, $fullServices);
+ my $serviceType = &_nodeTextContent($Object, "serviceType");
+ my $authoritative = &_nodeTextContent($Object, "authoritative");
+ my $Category = &_nodeTextContent($Object, "Category");
+ my $AuthURI = &_nodeTextContent($Object, "authURI");
+ my $expandObjects = &_nodeTextContent($Object, "expandObjects");
+ my $expandServices = &_nodeTextContent($Object, "expandServices");
+ my @kw = &_nodeArrayContent($Object, "keywords");
+ my $INPUTS = &_nodeRawContent($Object, "Input"); # returns array ref
+ my $OUTPUTS = &_nodeRawContent($Object, "Output"); # returns array ref
+
+ return ('serviceType' => $serviceType,
+ 'authURI' => $AuthURI,
+ 'expandObjects' => $expandObjects,
+ 'expandServices' => $expandServices,
+ 'authoritative' => $authoritative,
+ 'Category' => $Category,
+ 'inputObjects' => $INPUTS,
+ 'outputObjects' => $OUTPUTS,
+ 'keywords' => \@kw);
+
}
+sub _extractObjectTypesAndNamespaces {
+ # takes a SINGLE simple article and return regular list ($objectURI, [nsURI1, nsURI2, nsURI3])
+ my ($DOM) = @_;
+ $debug && &_LOG("\n\n_extractObjectTypesAndNamespaces\nExtracting object types from \n$DOM \n\n");
+ unless (ref($DOM) =~ /^XML/){
+ my $Parser = new XML::DOM::Parser;
+ my $doc = $Parser->parse($DOM);
+ $DOM = $doc->getDocumentElement();
+ }
+ my $x = $DOM->getElementsByTagName("objectType");
+ my $objectname;
+ my @child = $x->item(0)->getChildNodes;
+ foreach (@child){
+ $debug && &_LOG ($_->getNodeTypeName, "\t", $_->toString,"\n");
+ next unless ($_->getNodeType == TEXT_NODE);
+ my $name = $_->toString; chomp $name;
+ $objectname = $name;
+ }
+ my $OS= MOBY::OntologyServer->new(ontology => 'object');
+ my ($exists, $message, $objectURI) = $OS->objectExists(term => $objectname);
+ return (undef, []) unless $objectURI;
+
+ my $ns = $DOM->getElementsByTagName("Namespace");
+ my @namespaces;
+ my $nonamespaces = $ns->getLength;
+ $OS= MOBY::OntologyServer->new(ontology => 'namespace');
+ for (my $n=0; $n<$nonamespaces; ++$n){
+ my @child = $x->item($n)->getChildNodes;
+ foreach (@child){
+ $debug && &_LOG ($_->getNodeTypeName, "\t", $_->toString,"\n");
+ next unless ($_->getNodeType == TEXT_NODE);
+ my $name = $_->toString; chomp $name;
+ my ($success, $message, $URI) = $OS->namespaceExists(term => $name);
+ ($URI) && push @namespaces, $URI;
+ }
+ }
+ return ($objectURI, \@namespaces);
+}
+
+#
+#=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 .="<Category>$cat</Category>\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
+# Usage : $services = $MOBY->locateServiceByType($inputXML)
+# Function : get the service names/descriptions for a particular type of Service
+# (and child-types)
+# Returns : XML (see below)
+# inputXML :
+# <locateServiceByType>
+# <serviceType>ServiceType</serviceType>
+# <fullServices>1 | 0</fullServices>
+# </locateServiceByType>
+#
+# 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 locateServiceByType {
+# my ($pkg, $payload) = @_;
+#
+# my ($serviceType, $full_services) = &_locateServiceByTypePayload($payload);
+# return undef unless $serviceType;
+# my ($dbh, $sth_hash) = &_dbAccess;
+# my %sth = %{$sth_hash};
+# my @ServiceIDs;
+# if ($full_services){ # we need this service type and all child types
+# @ServiceIDs = &_traverseServiceDAG($dbh,$serviceType, $sth_hash);
+# } else { # we need only the service type of this element
+# my $sth = $dbh->prepare($sth{get_service_type_id});
+# $sth->execute($serviceType);
+# @ServiceIDs = $sth->fetchrow_array;
+# }
+#
+# # 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,
+# OEout.term,
+# S.auth_uri,
+# S.description,
+# OEtype.term,
+# S.category
+# from
+# Service as S,
+# OntologyEntry as OEtype,
+# OntologyEntry as OEout,
+# ServiceParameter as SPout,
+# Ontology as O
+# where
+# OEtype.is_obselete = 'n'
+# and OEout.is_obselete = 'n'
+# and SPout.type = 'out'
+# and SPout.service_id = S.id
+# and S.service_type_id = OEtype.id
+# and OEtype.ontology_id = O.id
+# and OEout.id = SPout.ontologyentry_id
+# and O.name='MOBY_Service'
+# and OEtype.id in (".join (",", map {"\"".$_."\""} @ServiceIDs).") ";
+#
+# return &_getValidServices($dbh, $sth_hash, $query);
+#}
+#
+#
+#sub _locateServiceByTypePayload {
+# 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 'locateServiceByType');
+# my $type = &_nodeTextContent($Object, "serviceType");
+# my $expand = &_nodeTextContent($Object, "fullServices");
+# return ($type, $expand);
+#}
+#
+#
+#=head2 locateServiceByInput
+#
+# Title : locateServiceByInput
+# Usage : $services = $MOBY->locateServiceByInput($inputXML)
+# Function : get the names/descriptions for services that use certain INPUT's
+# Returns : XML (see below)
+# inputXML :
+# <locateServiceByInput>
+# <inputObjects>
+# <Input>
+# <objectType>ObjectType1</objectType>
+# <namespaceType>NamespaceType1</namespaceType>
+# </Input>
+# <Input>
+# <objectType>ObjectType2</objectType>
+# <namespaceType>NamespaceType2</namespaceType>
+# </Input>
+# </inputObjects>
+# <serviceType>ServiceTypeTerm</serviceType>
+# <authURI>http://desired.service.provider</authURI>
+# <fullObjects>1|0</fullObjects>
+# <fullServices>1|0</fullServices>
+# </locateServiceByInput>
+#
+# 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 locateServiceByInput {
+# my ($pkg, $payload) = @_;
+# my ($serviceType, $AuthURI, $INs, $NSs, $full_objects, $full_services) = &_locateServiceByInputPayload($payload);
+# unless (defined $full_objects){$full_objects = 1}
+# unless (defined $full_services){$full_services = 1}
+# $debug && &_LOG("RECEIVED PARAMS: \n", join "\n", at _);
+#
+# push @{$NSs}, "any"; # 'any' is a valid namespace for all service searches
+#
+# return undef unless $INs;
+#
+# my ($dbh, $sth_hash) = &_dbAccess;
+# my (@ServiceIDs);
+# my %sth = %{$sth_hash};
+#
+#
+# if ($serviceType && $full_services){ # we need this service type and all child types
+# @ServiceIDs = &_traverseServiceDAG($dbh, $serviceType, $sth_hash);
+# } elsif ($serviceType) { # we need only the service type of this element
+# my $sth = $dbh->prepare($sth{get_service_type_id});
+# $sth->execute($serviceType);
+# @ServiceIDs = $sth->fetchrow_array;
+# }
+#
+# my (@ObjectIDs, %ObjectIDs);
+# if ($full_objects){ # we need this Object type and all parent types
+# foreach (@{$INs}){
+# $debug && &_LOG("traversing DAG for $_");
+# foreach (&_traverseObjectDAG($dbh, $_, $sth_hash, 'p')){
+# $debug && &_LOG("found $_ in DAG");
+# $ObjectIDs{$_}=1;
+# }
+# }
+# @ObjectIDs = keys %ObjectIDs;
+# } else { # we need only the Object type of the elements we were sent
+# foreach (@{$INs}){
+# my $sth = $dbh->prepare($sth{get_object_type_id});
+# $sth->execute($_);
+# push @ObjectIDs, $sth->fetchrow_array;
+# }
+# }
+#
+# $debug && &_LOG("INs @{$INs} ::: @ObjectIDs\n");
+# if ($NSs){$debug && &_LOG("NSs @{$NSs} \n")};
+# if ($serviceType){$debug && &_LOG("Servicetypes $serviceType, @ServiceIDs\n")};
+#
+# my $query = "
+# Select
+# S.service_name,
+# OEout.term,
+# S.auth_uri,
+# S.description,
+# OEtype.term,
+# S.category
+# from
+# Service as S,
+# OntologyEntry as OEtype,
+# OntologyEntry as OEin,
+# OntologyEntry as OEout,
+# ServiceParameter as SPout,
+# ServiceParameter as SPin,
+# OntologyEntry as OEns,
+# ServiceParameter as SPns
+# where
+# OEin.is_obselete = 'n'
+# and OEout.is_obselete = 'n'
+# and S.service_type_id = OEtype.id
+# and SPout.type = 'out'
+# and SPout.service_id = S.id
+# and SPout.ontologyentry_id = OEout.id
+# and SPin.type = 'in'
+# and SPin.service_id = S.id
+# and SPin.ontologyentry_id = OEin.id
+# and SPns.type = 'ns'
+# and SPns.service_id = S.id
+# and SPns.ontologyentry_id=OEns.id
+# and OEin.id in (". join (",", map {"\"".$_."\""} @ObjectIDs).")
+# and OEns.term in (". join (",", map {"\"".$_."\""} @{$NSs}).") ";
+#
+# if ($serviceType){ $query .= "and (S.service_type_id in (".(join ',', @ServiceIDs).")) "} # service type is a DAG, so get all relevant types
+# if ($AuthURI){ $query .= "and (S.auth_uri = '$AuthURI') "}
+#
+# $debug && &_LOG("*************************\ Query is: $query\n****************************");
+# return &_getValidServices($dbh, $sth_hash, $query);
+#
+#}
+#
+#sub _locateServiceByInputPayload {
+#
+# 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 'locateServiceByInput');
+# my $type = &_nodeTextContent($Object, "serviceType");
+# my $authURI = &_nodeTextContent($Object, "authURI");
+# my $fullObjects = &_nodeTextContent($Object, "fullObjects");
+# my $fullServices = &_nodeTextContent($Object, "fullServices");
+#
+# my $x = $Object->getElementsByTagName("inputObjects");
+# my @types = $x->item(0)->getElementsByTagName("objectType");
+# my @namespaces = $x->item(0)->getElementsByTagName("namespaceType");
+# my (@INS, @NSS);
+# foreach (@types){
+# my @child2 = $_->getChildNodes;
+# foreach (@child2){
+# #print $_->getNodeTypeName, "\t", $_->toString,"\n";
+# next unless $_->getNodeType == TEXT_NODE;
+# push @INS, $_->toString;
+# }
+# }
+# foreach (@namespaces){
+# my @child2 = $_->getChildNodes;
+# foreach (@child2){
+# #print $_->getNodeTypeName, "\t", $_->toString,"\n";
+# next unless $_->getNodeType == TEXT_NODE;
+# push @NSS, $_->toString;
+# }
+# }
+#
+# return ($type, $authURI, \@INS, \@NSS, $fullObjects, $fullServices);
+#}
+#
+#
+#=head2 locateServiceByOutput
+#
+# Title : locateServiceByOutput
+# Usage : $services = $MOBY->locateServiceByOutput($inputXML)
+# Function : get the names/descriptions for services that use certain INPUT's
+# Returns : XML (see below)
+# inputXML :
+# <locateServiceByOutput>
+# <objectType>ObjectType</objectType>
+# <serviceType>ServiceTypeTerm</serviceType>
+# <authURI>http://desired.service.provider</authURI>
+# <fullObjects>1|0</fullObjects>
+# <fullServices>1|0</fullServices>
+# <locateServiceByOutput>
+#
+# 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 locateServiceByOutput {
+# my ($pkg, $payload) = @_;
+# my ($serviceType, $AuthURI, $OUT, $full_objects, $full_services) = &_locateServiceByOutputPayload($payload);
+# unless (defined $full_objects){$full_objects = 1}
+# unless (defined $full_services){$full_services = 1}
+# $debug && &_LOG("RECEIVED PARAMS", @_);
+# # this one has to be generated dynamically...
+# return undef unless $OUT;
+# my ($dbh, $sth_hash) = &_dbAccess;
+# my (@ServiceIDs);
+# my %sth = %{$sth_hash};
+#
+# if ($serviceType && $full_services){ # we need this service type and all child types
+# $debug && &_LOG("Traversing Service DAG");
+# @ServiceIDs = &_traverseServiceDAG($dbh, $serviceType, $sth_hash);
+# } elsif ($serviceType) { # we need only the service type of this element
+# $debug && &_LOG("NOT Traversing Service DAG");
+# my $sth = $dbh->prepare($sth{get_service_type_id});
+# $sth->execute($serviceType);
+# @ServiceIDs = $sth->fetchrow_array;
+# }
+# $debug && &_LOG("FINISHED Traversing Service DAG");
+#
+# my (@ObjectIDs, %ObjectIDs);
+# if ($full_objects){ # we need this Object type and all parent types
+# $debug && &_LOG("traversing Object DAG for $OUT");
+# foreach (&_traverseObjectDAG($dbh, $OUT, $sth_hash, 'c')){
+# $debug && &_LOG("found $_ in Object DAG");
+# $ObjectIDs{$_}=1;
+# }
+# @ObjectIDs = keys %ObjectIDs;
+# } else { # we need only the Object type of the elements we were sent
+# my $sth = $dbh->prepare($sth{get_object_type_id});
+# $sth->execute($OUT);
+# push @ObjectIDs, $sth->fetchrow_array;
+# }
+#
+# $debug && &_LOG("OUT $OUT ::: @ObjectIDs\n");
+## if ($NSs){&_LOG("NSs @{$NSs} \n")};
+# if ($serviceType){$debug && &_LOG("Servicetypes $serviceType, @ServiceIDs\n")};
+#
+# my $query = "
+# Select
+# S.service_name,
+# OEout.term,
+# S.auth_uri,
+# S.description,
+# OEtype.term,
+# S.category
+# from
+# Service as S,
+# Ontology as O,
+# OntologyEntry as OEtype,
+# OntologyEntry as OEout,
+# ServiceParameter as SPout,
+# OntologyEntry as OEns,
+# ServiceParameter as SPns
+# where
+# OEout.is_obselete = 'n'
+# and OEtype.is_obselete = 'n'
+# and S.service_type_id = OEtype.id
+# and O.name = 'MOBY_Service'
+# and O.id = OEtype.ontology_id
+# and SPout.service_id = SPns.service_id
+# and SPout.service_id = S.id
+# and OEout.id = SPout.ontologyentry_id
+# and OEns.id = SPns.ontologyentry_id
+# and SPout.type = 'out'
+# and SPns.type = 'ns'
+# and OEout.id in (". join (",", map {"\"".$_."\""} @ObjectIDs).") ";
+# #if ($NSs && ${$NSs}[0]){ # must have at least one element
+# # $query .= "
+# # and OEns.term in (". join (",", map {"\"".$_."\""} @{$NSs}).") ";
+# #}
+#
+# if ($serviceType){ $query .= "and (S.service_type_id in (".(join ',', @ServiceIDs).")) "} # service type is a DAG, so get all relevant types
+# if ($AuthURI){ $query .= "and (S.auth_uri = '$AuthURI') "}
+#
+# $debug && &_LOG("*************************\ Query is: $query\n****************************");
+# return &_getValidServices($dbh, $sth_hash, $query);
+#
+#}
+#
+#
+#sub _locateServiceByOutputPayload {
+#
+# 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 'locateServiceByOutput');
+# my $type = &_nodeTextContent($Object, "serviceType");
+# my $authURI = &_nodeTextContent($Object, "authURI");
+# my $fullObjects = &_nodeTextContent($Object, "fullObjects");
+# my $fullServices = &_nodeTextContent($Object, "fullServices");
+# my $output = &_nodeTextContent($Object, "objectType");
+#
+# return ($type, $authURI, $output, $fullObjects, $fullServices);
+#}
+#
=head2 retrieveService
@@ -2116,77 +2389,55 @@
Returns : XML (see below)
inputXML :
<retrieveService>
- <authURI>http://service.provider.URI</authURI>
- <serviceName>DesiredServiceName</serviceName>
+ <Service authURI="authority.uri.here" serviceName="myServ"/>
<retrieveService>
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>
+#
+# 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
-
-
sub retrieveService {
my ($pkg, $payload) = @_;
my ($AuthURI, $serviceName) = &_retrieveServicePayload($payload);
unless ($AuthURI && $serviceName){return "<Services/>"}
+ my $SI = MOBY::service_instance->new(authority_uri => $AuthURI, servicename => $serviceName);
my $wsdls;
- my ($dbh, $sth_hash) = &_dbAccess;
- my (@ServiceIDs);
- my %sth = %{$sth_hash};
-
- my $query = "
- select
- S.id,
- S.url,
- S.description,
- S.category
- from
- Service as S
- where
- 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 type of service description $desc\n");
-
- return "<Service/>" unless ($id);
+ return "<Service/>" unless ($SI);
- if ($category eq 'moby'){
- my $wsdl = &_getServiceWSDL($dbh, $sth_hash, $id, $serviceName, $AuthURI, $URL, $desc, $category);
+ if ($SI->category eq 'moby'){
+ my $wsdl = &_getServiceWSDL($SI);
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;
-
}
+ #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;
+ #
+ #}
}
@@ -2197,11 +2448,13 @@
my ($payload) = @_;
my $Parser = new XML::DOM::Parser;
my $doc = $Parser->parse($payload);
- my $Object = $doc->getDocumentElement();
- my $obj = $Object->getTagName;
+ my $node = $doc->getDocumentElement();
+ my $obj = $node->getTagName;
return undef unless ($obj eq 'retrieveService');
- my $authURI = &_nodeTextContent($Object, "authURI");
- my $serviceName = &_nodeTextContent($Object, "serviceName");
+ my $authURI= $node->getAttributeNode("authURI"); # may or may not have a name
+ if ($authURI){$authURI = $authURI->getValue()}
+ my $serviceName = $node->getAttributeNode("serviceName"); # may or may not have a name
+ if ($serviceName){$serviceName = $serviceName->getValue()}
return ($authURI, $serviceName);
}
@@ -2225,9 +2478,8 @@
sub retrieveServiceProviders {
my ($pkg) = @_;
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
- my $sth = $dbh->prepare($sth{return_service_providers});
+ my $dbh = MOBY::central_db_connection->new()->dbh;
+ my $sth = $dbh->prepare("select distinct authority_uri from authority");
$sth->execute;
my $providers = "<serviceProviders>\n";
while (my ($prov) = $sth->fetchrow_array){
@@ -2258,12 +2510,11 @@
sub retrieveServiceNames {
my ($pkg) = shift;
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
- my $sth = $dbh->prepare($sth{return_service_names});
+ my $dbh = MOBY::central_db_connection->new()->dbh;
+ my $sth = $dbh->prepare("select authority_uri, servicename from authority natural join service_instance");
$sth->execute;
my $names = "<serviceNames>\n";
- while (my ($name, $auth) = $sth->fetchrow_array){
+ while (my ($auth, $name) = $sth->fetchrow_array){
$names .= "<serviceName name='$name' authURI='$auth'/>\n";
}
$names .= "</serviceNames>\n";
@@ -2293,12 +2544,10 @@
sub retrieveServiceTypes {
my ($pkg) = @_;
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
- my $sth = $dbh->prepare($sth{return_service_types});
- $sth->execute;
+ my $OS = MOBY::OntologyServer->new(ontology => 'service');
+ my %types = %{$OS->retrieveAllServiceTypes()};
my $types = "<serviceTypes>\n";
- while (my ($serv, $desc) = $sth->fetchrow_array){
+ while (my ($serv, $desc) = each %types){
$types .= "<serviceType name='$serv'>\n<Description><![CDATA[$desc]]></Description>\n</serviceType>\n";
}
$types .= "</serviceTypes>\n";
@@ -2327,12 +2576,10 @@
sub retrieveObjectNames {
my ($pkg) = @_;
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
- my $sth = $dbh->prepare($sth{retrieve_object_names});
- $sth->execute;
+ my $OS = MOBY::OntologyServer->new(ontology => 'object');
+ my %types = %{$OS->retrieveAllObjectTypes()};
my $obj = "<objectNames>\n";
- while (my ($name, $desc) = $sth->fetchrow_array){
+ while (my ($name, $desc) = each %types){
$obj .= "<Object name='$name'>\n<Description><![CDATA[$desc]]></Description>\n</Object>\n";
}
$obj .= "</objectNames>\n";
@@ -2361,12 +2608,10 @@
sub retrieveNamespaces {
my ($pkg) = @_;
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
- my $sth = $dbh->prepare($sth{retrieve_namespaces});
- $sth->execute;
+ my $OS = MOBY::OntologyServer->new(ontology => 'namespace');
+ my %types = %{$OS->retrieveAllNamespaceTypes()};
my $ns = "<Namespaces>\n";
- while (my ($namespace, $desc) = $sth->fetchrow_array){
+ while (my ($namespace, $desc) = each %types){
$ns .= "<Namespace name='$namespace'>\n<Description><![CDATA[$desc]]></Description>\n</Namespace>\n";
}
$ns .="</Namespaces>";
@@ -2402,31 +2647,8 @@
sub retrieveObject {
my ($pkg, $payload) = @_;
- $debug && &_LOG("1retrieveObject $payload\n");
- my ($param) = &_retrieveObjectPayload($payload);
-
- my $response;
- my ($dbh, $sth_hash) = &_dbAccess;
- my %sth = %{$sth_hash};
-
- $response = "<Objects>\n";
- if (lc($param) eq "all"){
- my $sth = $dbh->prepare($sth{retrieve_all_objects});
- $sth->execute;
- while (my ($obj, $xsd) = $sth->fetchrow_array){
- $response .= "<Object name='$obj'>\n";
- $response .= "<Schema><![CDATA[$xsd]]></Schema>\n";
- $response .= "</Object>\n";
- }
- } else{
- my $sth = $dbh->prepare($sth{retrieve_one_object});
- $sth->execute($param);
- while (my ($obj, $xsd) = $sth->fetchrow_array){
- $response .= "<Object name='$obj'>\n";
- $response .= "<Schema>$xsd</Schema>\n";
- $response .= "</Object>\n";
- }
- }
+ my $response = "<Objects>\n";
+ $response .="<NOT_YET_IMPLEMENTED/>\n";
$response .= "</Objects>\n";
return $response;
}
@@ -2639,27 +2861,27 @@
sub _getServiceWSDL {
- my ( $dbh, $sth_hash, $id, $serviceName, $AuthURI,$URL, $desc, $category) = @_;
- my %sth = %{$sth_hash};
+ my ($SI) = @_;
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 $sth = $dbh->prepare($sth{get_server_parameters});
- $sth->execute($id);
- my (@in, @out);
- while (my ($Object, $xsd, $in_out) = $sth->fetchrow_array()){
- if ($in_out eq "in"){push @in, [$Object, $xsd]}
- else {push @out, [$Object, $xsd]}
- }
- # do substitutions
+ # do substitutions
+
+ my $serviceName = $SI->servicename;
+ my $AuthURI = $SI->authority_uri;
+ my $desc = $SI->description;
+ my $URL = $SI->url;
+ my $IN = "NOT_YET_DEFINED_INPUTS";
+ my $OUT = "NOT_YET_DEFINED_OUTPUTS";
+ my $INxsd = "<NOT_YET_IMPLEMENTED_INPUT_XSD/>";
+ my $OUTxsd="<NOT_YET_IMPLEMENTED_OUTPUT_XSD/>";
$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, $OUT, $OUTxsd);
- if (scalar @in){my ($IN, $INxsd) = @{shift @in}};
- if (scalar @out){my ($OUT, $OUTxsd) = @{shift @out}};
+ #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
@@ -2778,7 +3000,7 @@
# will get text of **all** child $node from the given $DOM
# regardless of their depth!!
my ($DOM, $node) = @_;
- $debug && &_LOG("_nodeTextContext received DOM: ", $DOM->toString,"\nsearching for node $node\n");
+ $debug && &_LOG("_nodeTextContent received DOM: ", $DOM->toString,"\nsearching for node $node\n");
my $x = $DOM->getElementsByTagName($node);
my @child = $x->item(0)->getChildNodes;
my $content;
@@ -2790,13 +3012,35 @@
return $content;
}
+sub _nodeRawContent {
+ # will get raw child nodes of $node from the given $DOM
+ my ($DOM, $nodename) = @_;
+ my @content;
+ $debug && &_LOG("_nodeRawContent received DOM: ", $DOM->toString,"\nsearching for node $nodename\n");
+ my $x = $DOM->getElementsByTagName($nodename);
+ my $node = $x->item(0);
+ return [] unless $node;
+ foreach my $child($node->getChildNodes){
+ next unless $child->getNodeType == ELEMENT_NODE;
+ push @content, $child;
+ }
+ return \@content;
+}
+
sub _nodeArrayContent {
# will get array content of all child $node from given $DOM
# regardless of depth!
+ # e.g. the following XML:
+ #<ISA>
+ # <objectType>first</objectType>
+ # <objectType>second</objectType>
+ #</ISA>
+ #will return the list "first", "second"
my ($DOM, $node) = @_;
$debug && &_LOG("_nodeArrayContext received DOM: ", $DOM->toString,"\nsearching for node $node\n");
my @result;
my $x = $DOM->getElementsByTagName($node);
+ return undef unless $x->item(0);
my @child = $x->item(0)->getChildNodes;
foreach (@child){
next unless $_->getNodeType == ELEMENT_NODE;
@@ -2810,10 +3054,200 @@
return @result;
}
+sub _nodeArrayExtraContent {
+ # will get array content of all child $node from given $DOM
+ # regardless of depth!
+ # e.g. the following XML:
+ #<ISA>
+ # <objectType articleName="thisone">first</objectType>
+ # <objectType articleName="otherone">second</objectType>
+ #</ISA>
+ #will return the list
+ # ['first',{'articleName' => 'thisone'}],
+ # ['second',{'articleName' => 'otherone'},...
+
+ my ($DOM, $node, at attrs) = @_;
+ $debug && &_LOG("_nodeArrayContext received DOM: ", $DOM->toString,"\nsearching for node $node\n");
+ my @result;
+ my %att_value;
+ my $x = $DOM->getElementsByTagName($node);
+ my @child = $x->item(0)->getChildNodes;
+ foreach (@child){
+ next unless $_->getNodeType == ELEMENT_NODE;
+ my $attnodes = $_->getAttributes;
+ foreach my $attr(@attrs){
+ $att_value{$attr}= $attnodes->getNamedItem($attr)->getValue;
+ }
+ my @child2 = $_->getChildNodes;
+ foreach (@child2){
+ #print $_->getNodeTypeName, "\t", $_->toString,"\n";
+ next unless $_->getNodeType == TEXT_NODE;
+ push @result, [$_->toString,\%att_value];
+ }
+ }
+ return @result;
+}
+
+sub _serviceListResponse {
+
+ my ($dbh, @ids) = @_;
+
+ my $output="";
+ my $sth = $dbh->prepare(q{
+ select
+ category, servicename, service_type_uri, authority_id, description, authoritative
+ from service_instance where
+ service_instance_id = ?});
+ my $sth_simple_in = $dbh->prepare("select object_type_uri, namespace_type_uris, article_name from simple_input where service_instance_id=? and collection_input_id IS NULL");
+ my $sth_simple_out = $dbh->prepare("select object_type_uri, namespace_type_uris, article_name from simple_output where service_instance_id=? and collection_output_id IS NULL");
+ my $sth_collection_ins = $dbh->prepare("select collection_input_id, article_name from collection_input where service_instance_id=?");
+ my $sth_collection_outs = $dbh->prepare("select collection_output_id, article_name from collection_output where service_instance_id=?");
+ my $sth_collection_in = $dbh->prepare("select object_type_uri, namespace_type_uris, article_name from simple_input where service_instance_id IS NULL and collection_input_id =?");
+ my $sth_collection_out = $dbh->prepare("select object_type_uri, namespace_type_uris, article_name from simple_output where service_instance_id IS NULL and collection_output_id =?");
+ my $sth_secondary_in = $dbh->prepare("select default_value, maximum_value, minimum_value, enum_value, datatype, article_name from secondary_input where service_instance_id=?");
+
+
+ my $OSobj = MOBY::OntologyServer->new(ontology => 'object');
+ my $OSns = MOBY::OntologyServer->new(ontology => 'namespace');
+ my $OSserv = MOBY::OntologyServer->new(ontology => 'service');
+
+ foreach (@ids){
+ $sth->execute($_);
+ my ($category, $servicename, $service_type_uri, $authority_id, $desc, $authoritative) = $sth->fetchrow_array;
+ #print "\n\nAFTER EXECUTE $category, $servicename, $service_type_uri, $authority_id, $desc, $authoritative\n\n";
+ my $service_type = $OSserv->getServiceCommonName($service_type_uri);
+ my ($authURI) = $dbh->selectrow_array(q{select authority_uri from authority where authority_id=?},undef,$authority_id);
+ $output .= "\t<Service authURI='$authURI' serviceName='$servicename'>\n";
+ $output .= "\t<serviceType>$service_type</serviceType>\n";
+ $output .= "\t<authoritative>$authoritative</authoritative>\n";
+ $output .= "\t<Category>$category</Category>\n";
+ $output .= "\t<Description>\n$desc\n\t</Description>\n";
+ $output .="\t<Input>\n";
+ $sth_simple_in->execute($_);
+ while (my ($objURI, $nsURI, $article) = $sth_simple_in->fetchrow_array()){
+ my $objName = $OSobj->getObjectCommonName($objURI);
+ my @nsURIs = split ",", $nsURI;
+ $output .="\t\t<Simple articleName='$article'>\n";
+ $output .="\t\t\t<objectType>$objName</objectType>\n";
+ foreach my $ns(@nsURIs){
+ my $NSname = $OSns->getNamespaceCommonName($ns);
+ $output .="\t\t\t<Namespace>$NSname</Namespace>\n";
+ }
+ $output .="\t\t</Simple>\n";
+ }
+ $sth_collection_ins->execute($_);
+ while (my ($collid, $articlename) = $sth_collection_ins->fetchrow_array){
+ $output .="\t\t<Collection articleName='$articlename'>\n";
+ $sth_collection_in->execute($collid);
+ while (my ($objURI, $nsURI, $article) = $sth_collection_in->fetchrow_array()){
+ my $objName = $OSobj->getObjectCommonName($objURI);
+ my @nsURIs = split ",", $nsURI;
+ $output .="\t\t\t<Simple articleName='$article'>\n";
+ $output .="\t\t\t\t<objectType>$objName</objectType>\n";
+ foreach my $ns(@nsURIs){
+ my $NSname = $OSns->getNamespaceCommonName($ns);
+ $output .="\t\t\t\t<Namespace>$NSname</Namespace>\n";
+ }
+ $output .="\t\t\t</Simple>\n";
+ }
+ $output .="\t\t</Collection>\n";
+ }
+
+ $output .="\t</Input>\n";
+
+ $output .="\t<Output>\n";
+ $sth_simple_out->execute($_);
+ while (my ($objURI, $nsURI, $article) = $sth_simple_out->fetchrow_array()){
+ my $objName = $OSobj->getObjectCommonName($objURI);
+ my @nsURIs = split ",", $nsURI;
+ $output .="\t\t<Simple articleName='$article'>\n";
+ $output .="\t\t\t<objectType>$objName</objectType>\n";
+ foreach my $ns(@nsURIs){
+ my $NSname = $OSns->getNamespaceCommonName($ns);
+ $output .="\t\t\t<Namespace>$NSname</Namespace>\n";
+ }
+ $output .="\t\t</Simple>\n";
+ }
+ $sth_collection_outs->execute($_);
+ while (my ($collid, $articlename) = $sth_collection_outs->fetchrow_array){
+ $output .="\t\t<Collection articleName='$articlename'>\n";
+ $sth_collection_out->execute($collid);
+ while (my ($objURI, $nsURI, $article) = $sth_collection_out->fetchrow_array()){
+ my $objName = $OSobj->getObjectCommonName($objURI);
+ my @nsURIs = split ",", $nsURI;
+ $output .="\t\t\t<Simple articleName='$article'>\n";
+ $output .="\t\t\t\t<objectType>$objName</objectType>\n";
+ foreach my $ns(@nsURIs){
+ my $NSname = $OSns->getNamespaceCommonName($ns);
+ $output .="\t\t\t\t<Namespace>$NSname</Namespace>\n";
+ }
+ $output .="\t\t\t</Simple>\n";
+ }
+ $output .="\t\t</Collection>\n";
+ }
+ $output .="\t</Output>\n";
+
+ $output .="\t<secondaryArticles>\n";
+ $sth_secondary_in->execute($_);
+ while (my ($default_value, $maximum_value, $minimum_value, $enum_value, $datatype, $article_name) = $sth_secondary_in->fetchrow_array()){
+ $output .= "\t\t\t<Parameter articleName='$article_name'>\n";
+ $output .= "\t\t\t\t<datatype>$datatype</datatype>\n";
+ $output .="\t\t\t\t<default>$default_value</default>\n";
+ $output .="\t\t\t\t<max>$maximum_value</max>\n";
+ $output .="\t\t\t\t<min>$minimum_value</min>\n";
+ my @enums = split ",", $enum_value;
+ if (scalar(@enums)){
+ foreach my $enum(@enums){
+ $output .= "\t\t\t\t<enum>$enum</enum>\n";
+ }
+ } else {
+ $output .= "\t\t\t\t<enum></enum>\n";
+ }
+ $output .= "\t\t\t</Parameter>\n";
+ }
+ $output .="\t\t</secondaryArticles>\n";
+ $output .= "\t</Service>\n";
+ }
+ return "<Services>\n$output\n</Services>\n";
+
+}
+
+
+sub _error {
+ my ($message, $id) = @_;
+ my $reg = &Registration({
+ success => 0,
+ error_message => "$message",
+ registration_id => "$id",
+ });
+ return $reg;
+}
+
+sub _success {
+ my ($message, $id) = @_;
+ my $reg = &Registration({
+ success => 1,
+ error_message => "$message",
+ registration_id => "$id",
+ });
+ return $reg;
+}
+
+sub _getOntologyServer { # may want to make this more complex
+ my (%args) = @_;
+ my $OS = MOBY::OntologyServer->new(%args);
+ return $OS;
+}
+
+
sub DESTROY {}
+
sub _LOG {
#return unless $debug;
+ print join "\n", @_;
+ print "\n---\n";
+ return;
open LOG, ">>/tmp/CentralRegistryLogOut.txt" or die "can't open logfile $!\n";
print LOG join "\n", @_;
print LOG "\n---\n";
More information about the MOBY-guts
mailing list