[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Mon Jun 9 23:48:00 UTC 2003
mwilkinson
Mon Jun 9 19:47:59 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv26907
Modified Files:
Central.pm OntologyServer.pm
Log Message:
added new method as per Martin's request that returns to you the full definition of an object exactly (almost) as it was registered. It returns the LSID's of the various attributes rather than their common names, but otherwise it shoudl be identical to what was entered into the registration process, and in fact, the XML is exactly what is required by the registerObjectClass call, in principle allowing cloning of object classes from one instance of MOBY Central to another.
moby-live/Perl/MOBY Central.pm,1.71,1.72 OntologyServer.pm,1.10,1.11
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.pm,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -r1.71 -r1.72
--- /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/06/06 00:45:47 1.71
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/06/09 23:47:59 1.72
@@ -145,18 +145,18 @@
}
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";
-# 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";
+ 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);
}
@@ -1420,206 +1420,6 @@
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
@@ -2100,516 +1900,7 @@
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
@@ -2841,6 +2132,49 @@
}
+
+=head2 retrieveObjectDefinition
+
+ Title : retrieveObjectDefinition
+ Usage : $registerObjectXML = $MOBY->retrieveObjectDefinition($inputXML)
+ Function : get the full description of an object, as registered
+ Returns : see input XML for registerObjectClass
+ Input XML :
+ <retrieveObjectDefinition>
+ <objectType>ExistingObjectClassname</objectType>
+ </retrieveObjectDefinition>
+
+=cut
+
+sub retrieveObjectDefinition {
+ my ($pkg, $payload) = @_;
+ my $Parser = new XML::DOM::Parser;
+ my $doc = $Parser->parse($payload);
+ my $term = &_nodeTextContent($doc, "objectType");
+ return undef unless $term;
+ my $OS = MOBY::OntologyServer->new(ontology => 'object');
+ my %def = %{$OS->retrieveObject(node => $term)};
+ my $response;
+ $response = "<registerObjectClass>
+ <objectType>$def{objectType}</objectType>
+ <Description><![CDATA[$def{description}]]></Description>
+ <authURI>$def{authURI}</authURI>
+ <contactEmail>$def{contactEmail}</contactEmail>\n";
+ my %relationships = %{$def{Relationships}};
+ while (my ($rel, $objdefs) = each %relationships){
+ $response .= "<Relationship relationshipType='$rel'>\n";
+ foreach my $def(@{$objdefs}){
+ my ($lsid, $articlename) = @{$def};
+ $articlename="" unless defined $articlename;
+ $response .="<objectType articleName='$articlename'>$lsid</objectType>\n";
+ }
+ $response .="</Relationship>\n";
+ }
+ $response .="</registerObjectClass>\n";
+ return $response;
+}
+
+
=head2 retrieveNamespaces
Title : retrieveNamespaces
@@ -2874,29 +2208,29 @@
-=head2 objectClassDetails
-
- Title : objectClassDetails
- Usage : $outputXML = $MOBY->objectClassDetails($inputXML)
- Function : get the object details
- Returns : XML (see below)
- Args : $name - object name (from ontology) or "all" to get all objects
-
- inputXML :
- <retrieveObject>
- <objectType>ObjectType</objectType>
- </retrieveObject>
-
- outputXML :
- <Objects>
- <Object name="namespace">
- <Schema><XSD schema fragment here></Schema>
- </Object>
- ...
- ...
- </Objects>
-
-=cut
+#=head2 objectClassDetails
+#
+# Title : objectClassDetails
+# Usage : $outputXML = $MOBY->objectClassDetails($inputXML)
+# Function : get the object details
+# Returns : XML (see below)
+# Args : $name - object name (from ontology) or "all" to get all objects
+#
+# inputXML :
+# <retrieveObject>
+# <objectType>ObjectType</objectType>
+# </retrieveObject>
+#
+# outputXML :
+# <Objects>
+# <Object name="namespace">
+# <Schema><XSD schema fragment here></Schema>
+# </Object>
+# ...
+# ...
+# </Objects>
+#
+#=cut
sub objectClassDetails {
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2003/05/24 20:35:35 1.10
+++ /home/repository/moby/moby-live/Perl/MOBY/OntologyServer.pm 2003/06/09 23:47:59 1.11
@@ -4,6 +4,69 @@
# server as well as the MOBY Central database
# in order to ensure that they are both in sync
+
+=head1 NAME
+
+MOBY::OntologyServer - A way for MOBY Central to query the
+object, service, namespace, and relationship ontologies
+
+=cut
+
+
+=head1 SYNOPSIS
+
+ use MOBY::OntologyServer;
+ my $OS = MOBY::OntologyServer->new(ontology => "object");
+
+ my ($success, $message, $existingURI) = $OS->objectExists(term => "Object");
+
+ if ($success){
+ print "object exists and it has the LSID $existingURI\n";
+ } else {
+ print "object does not exist; additional message from server: $message\n";
+ }
+
+
+=cut
+
+=head1 DESCRIPTION
+
+Swappable interface to ontologies. It should deal with LSID's 100%
+of the time, and also deal with MOBY-specific common names for objects,
+services, namespaces, and relationship types.
+
+
+
+=head1 AUTHORS
+
+Mark Wilkinson (markw at illuminae.com)
+
+BioMOBY Project: http://www.biomoby.org
+
+
+=cut
+
+=head1 METHODS
+
+
+=head2 new
+
+ Title : new
+ Usage : my $OS = MOBY::OntologyServer->new(%args)
+ Function :
+ Returns : MOBY::OntologyServer object
+ Args : ontology => [object || service || namespace || relationship]
+ database => mysql databasename that holds the ontologies
+ host => mysql hostname
+ username => mysql username
+ password => mysql password
+ port => mysql port
+ dbh => pre-existing database handle to a mysql database
+
+=cut
+
+
+
package MOBY::OntologyServer;
use strict;
@@ -86,6 +149,11 @@
}
}
+=head2 objectExists
+
+=cut
+
+
sub objectExists{
my ($self, %args) = @_;
my $term = $args{term};
@@ -101,6 +169,10 @@
}
}
+=head2 createObject
+
+=cut
+
sub createObject {
my ($self, %args) = @_;
@@ -136,6 +208,49 @@
}
+
+=head2 retrieveObject
+
+=cut
+
+# objectType => "the name of the Object"
+# description => "a human-readable description of the object"
+# contactEmail => "your at email.address"
+# authURI => "URI of the registrar of this object"
+# Relationships => {
+# relationshipType1 => [
+# [Object1, articleName],
+# [Object2, articleName]],
+# relationshipType2 => [
+# [Object1, articleName]]}
+
+sub retrieveObject {
+ my ($self, %args) = @_;
+ my $term = $args{'node'};
+ return (0, "WRONG ONTOLOGY!",'') unless ($self->ontology eq 'object');
+ return (0, "requires a object type node as an argument",'') unless ($args{'node'});
+ my $LSID = ($args{'node'} =~ /urn\:lsid/)?$args{'node'}:$self->getObjectURI($term);
+ unless ($LSID){return (0, "Failed during creation of an LSID",'')}
+ my ($id, $type, $lsid, $desc, $auth, $contact)= $self->dbh->selectrow_array(q{select object_id, object_type, object_lsid, description, authority,contact_email from object where object_lsid = ?}, undef, $LSID);
+ unless ($id){return (0, "Object doesn't exist in ontology", "")}
+ # my $OS = MOBY::OntologyServer->new(ontology => "relationship");
+ my $sth = $self->dbh->prepare(q{select relationship_type, object_lsid, object2_articlename from object_term2term, object where object1_id = ? and object2_id = object_id});
+ $sth->execute($id);
+ my %rel;
+ while (my ($relationship_type, $objectlsid, $article) = $sth->fetchrow_array){
+ push @{$rel{$relationship_type}}, [$objectlsid, $article];
+ }
+ return {objectType => $lsid,
+ description => $desc,
+ contactEmail => $contact,
+ authURI => $auth,
+ Relationships => \%rel};
+}
+
+=head2 deprecateObject
+
+=cut
+
sub deprecateObject {
my ($self, %args) = @_;
return (0, "WRONG ONTOLOGY",'') unless ($self->ontology eq 'object');
@@ -164,11 +279,19 @@
return (1,"Object $term Deleted",$lsid);
}
+=head2 deleteObject
+
+=cut
+
sub deleteObject {
my $self = shift;
$self->deprecateObject(@_);
}
+=head2 relationshipExists
+
+=cut
+
sub relationshipExists{
# term => $term
# ontology => $ontology
@@ -190,6 +313,10 @@
}
}
+=head2 addObjectRelationship
+
+=cut
+
sub addObjectRelationship{
# adds a relationship
#subject_node => $term,
@@ -224,6 +351,9 @@
}
}
+=head2 addServiceRelationship
+
+=cut
sub addServiceRelationship{
@@ -321,6 +451,10 @@
## just ignore it if it doesn't exist in the first place
#}
+=head2 serviceExists
+
+=cut
+
sub serviceExists {
my ($self, %args) = @_;
return (0, "WRONG ONTOLOGY!",'') unless ($self->ontology eq 'service');
@@ -335,6 +469,10 @@
}
}
+=head2 createServiceType
+
+=cut
+
sub createServiceType {
my ($self, %args) = @_;
#node => $term,
@@ -366,6 +504,11 @@
}
+=head2 deleteServiceType
+
+=cut
+
+
sub deleteServiceType {
my ($self, %args) = @_;
return (0, "WRONG ONTOLOGY!",'') unless ($self->ontology eq 'service');
@@ -423,6 +566,10 @@
# }
#}
+=head2 namespaceExists
+
+=cut
+
sub namespaceExists {
my ($self, %args) = @_;
@@ -438,6 +585,11 @@
}
}
+=head2 createNamespace
+
+=cut
+
+
sub createNamespace {
my ($self, %args) = @_;
#node => $term,
@@ -468,6 +620,10 @@
return (1, "Namespace creation succeeded",$LSID);
}
+=head2 deleteNamespace
+
+=cut
+
sub deleteNamespace {
my ($self, %args) = @_;
@@ -498,6 +654,11 @@
return (1,"Namespace Type $term Deleted",$lsid);
}
+=head2 retrieveAllServiceTypes
+
+=cut
+
+
sub retrieveAllServiceTypes {
my ($self) = @_;
my $types = $self->dbh->selectall_arrayref(q{select service_type, description from service});
@@ -509,6 +670,10 @@
return \%response;
}
+=head2 retrieveAllNamespaceTypes
+
+=cut
+
sub retrieveAllNamespaceTypes {
my ($self) = @_;
my $types = $self->dbh->selectall_arrayref(q{select namespace_type, description from namespace});
@@ -520,6 +685,10 @@
return \%response;
}
+=head2 retrieveAllObjectClasses
+
+=cut
+
sub retrieveAllObjectClasses {
my ($self) = @_;
my $types = $self->dbh->selectall_arrayref(q{select object_type, description from object});
@@ -531,6 +700,10 @@
return \%response;
}
+=head2 retrieveAllObjectTypes
+
+=cut
+
sub retrieveAllObjectTypes {
my ($self) = @_;
my $types = $self->dbh->selectall_arrayref(q{select object_type, description from object});
@@ -542,6 +715,10 @@
return \%response;
}
+=head2 getObjectCommonName
+
+=cut
+
sub getObjectCommonName {
my ($self, $URI) = @_;
return undef unless $URI =~ /urn\:lsid/;
@@ -549,6 +726,10 @@
return $name?$name:$URI;
}
+=head2 getNamespaceCommonName
+
+=cut
+
sub getNamespaceCommonName {
my ($self, $URI) = @_;
return undef unless $URI =~ /urn\:lsid/;
@@ -556,6 +737,11 @@
return $name?$name:$URI;
}
+=head2 getServiceCommonName
+
+=cut
+
+
sub getServiceCommonName {
my ($self, $URI) = @_;
return undef unless $URI =~ /urn\:lsid/;
@@ -563,6 +749,9 @@
return $name?$name:$URI;
}
+=head2 getServiceURI
+
+=cut
sub getServiceURI {
my ($self, $term) = @_;
@@ -570,18 +759,31 @@
return $id;
}
+=head2 getObjectURI
+
+=cut
+
sub getObjectURI {
my ($self, $term) = @_;
my ($id) = $self->dbh->selectrow_array(q{select object_lsid from object where object_type = ?},undef,$term);
return $id;
}
+=head2 getNamespaceURI
+
+=cut
+
sub getNamespaceURI {
my ($self, $term) = @_;
my ($id) = $self->dbh->selectrow_array(q{select namespace_lsid from namespace where namespace_type = ?},undef,$term);
return $id;
}
+=head2 getRelationshipTypes
+
+=cut
+
+
sub getRelationshipTypes {
my ($self, %args) = @_;
my $ontology = $args{'ontology'};
@@ -592,12 +794,20 @@
}
return \%result;
}
-
+
+=head2 ISA
+
+=cut
+
sub ISA {
my ($self, $expand) = @_;
}
+=head2 setURI
+
+=cut
+
sub setURI {
my ($self, $id) = @_;
my $URI;
More information about the MOBY-guts
mailing list