[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Fri Jul 30 00:07:18 UTC 2004
mwilkinson
Thu Jul 29 20:07:18 EDT 2004
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv21507/MOBY
Modified Files:
Central.pm service_instance.pm
Log Message:
the adaptor now writes to a new field in the database - signatureURL - which is where Nina's agent expects to find the RDF corresponding to the service. This can be null, if you want to temporarily register a service.
moby-live/Perl/MOBY Central.pm,1.135,1.136 service_instance.pm,1.6,1.7
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.pm,v
retrieving revision 1.135
retrieving revision 1.136
diff -u -r1.135 -r1.136
--- /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2004/07/29 23:34:06 1.135
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2004/07/30 00:07:18 1.136
@@ -1082,11 +1082,12 @@
sub registerService {
my ($pkg, $payload) = @_;
- my ($serviceName, $serviceType, $AuthURI, $contactEmail, $URL, $authoritativeService, $desc, $Category, $INPUTS, $OUTPUTS, $SECONDARY) = &_registerServicePayload($payload);
+ my ($serviceName, $serviceType, $AuthURI, $contactEmail, $URL, $authoritativeService, $desc, $Category, $INPUTS, $OUTPUTS, $SECONDARY, $signatureURL) = &_registerServicePayload($payload);
$authoritativeService = defined($authoritativeService)?1:0;
my $error;
$error .="missing serviceName \n" unless defined $serviceName;
$error .="missing serviceType \n" unless defined $serviceType;
+ $error .="missing signatureURL \n" unless defined $signatureURL;
$error .="missing authURI \n" unless defined $AuthURI;
$error .="missing contactEmail \n" unless defined $contactEmail;
return &_error("Malformed authURI - must not have an http:// prefix","") if $AuthURI =~ '[/:]';
@@ -1141,6 +1142,7 @@
contact_email => $contactEmail,
authoritative => $authoritativeService,
description => $desc,
+ signatureURL => $signatureURL,
);
return &_error("Service registration failed for unknown reasons","") if (!defined $SVC);
@@ -1167,13 +1169,10 @@
# this is roundabout, I agree, but it is the most re-usable way to go at
# the moment.
- my ($si, $reg) = &findService('','<?xml version="1.0" encoding="UTF-8"?>
- <MOBY>
- <findService>
+ my ($si, $reg) = &findService('',"<findService>
<authURI>$AuthURI</authURI>;
<serviceName>$serviceName</serviceName>;
- </findService>
- </MOBY>');
+ </findService>");
unless ($si){
$SVC->DELETE_THYSELF;
return &_error("Registration Failed - newly registered service could not be discovered","");
@@ -1356,13 +1355,15 @@
my $contactEmail = &_nodeTextContent($Object, "contactEmail");
my $authoritativeService = &_nodeTextContent($Object, "authoritativeService");
my $URL = &_nodeTextContent($Object, "URL");
+ my $signatureURL = &_nodeTextContent($Object, "signatureURL");
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);
+ return ($serviceName, $serviceType, $AuthURI, $contactEmail, $URL, $authoritativeService, $desc, $Category, $INPUTS, $OUTPUTS, $SECONDARIES, $signatureURL);
}
+
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");
@@ -2878,7 +2879,7 @@
my $output="";
my $sth = $dbh->prepare(q{
select
- category, url, servicename, service_type_uri, authority_id, description, authoritative, contact_email
+ category, url, servicename, service_type_uri, authority_id, description, authoritative, contact_email, signatureURL
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");
@@ -2896,8 +2897,9 @@
foreach (@ids){
$sth->execute($_);
- my ($category, $url, $servicename, $service_type_uri, $authority_id, $desc, $authoritative, $email) = $sth->fetchrow_array;
+ my ($category, $url, $servicename, $service_type_uri, $authority_id, $desc, $authoritative, $email, $signatureURL) = $sth->fetchrow_array;
#print "\n\nAFTER EXECUTE $category, $servicename, $service_type_uri, $authority_id, $desc, $authoritative\n\n";
+ $signatureURL ||="";
next unless ($servicename && $authority_id);
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);
@@ -2907,6 +2909,7 @@
$output .= "\t<Category>$category</Category>\n";
$output .= "\t<Description>\n$desc\n\t</Description>\n";
$output .= "\t<contactEmail>$email</contactEmail>\n";
+ $output .= "\t<signatureURL>$signatureURL</signatureURL>\n";
$output .= "\t<URL>$url</URL>\n";
$output .="\t<Input>\n";
$sth_simple_in->execute($_);
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/service_instance.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- /home/repository/moby/moby-live/Perl/MOBY/service_instance.pm 2004/07/09 00:21:53 1.6
+++ /home/repository/moby/moby-live/Perl/MOBY/service_instance.pm 2004/07/30 00:07:18 1.7
@@ -66,6 +66,7 @@
service_type_uri => [undef, 'read/write'],
authority => [undef, 'read/write'],
authority_uri => [undef, 'read/write'],
+ signatureURL => [undef, 'read/write'],
url => [undef, 'read/write'],
inputs => [undef, 'read/write'],
outputs => [undef, 'read/write'],
@@ -128,6 +129,12 @@
(defined $val) && ($self->{url} = $val);
return $self->{url}
}
+ sub signatureURL{
+ my ($self, $val) = @_;
+ if (defined $val && $self->signatureURL){return undef}
+ (defined $val) && ($self->{signatureURL} = $val);
+ return $self->{signatureURL}
+ }
sub contact_email {
my ($self, $val) = @_;
if (defined $val && $self->contact_email){return undef}
@@ -240,7 +247,10 @@
url => $self->url,
contact_email => $self->contact_email,
authoritative => $self->authoritative,
- description => $self->description);
+ description => $self->description,
+ signatureURL => $self->signatureURL,
+ );
+
$self->service_instance_id($id);
$self->{__exists__} = 1; # this service now exists
} else { # if it doesn't exist, and you havne't given me anyting I need to create it, then bail out
More information about the MOBY-guts
mailing list