[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Fri Jun 27 02:27:13 UTC 2003
mwilkinson
Thu Jun 26 22:27:13 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv21257/Perl/MOBY
Modified Files:
Central.pm
Log Message:
recoded error messages to make the usage consistent. Also, a few of the messages were incorrect due to copy and paste errors. that'll teach me :-)
moby-live/Perl/MOBY Central.pm,1.83,1.84
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Central.pm,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -r1.83 -r1.84
--- /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/06/25 20:23:12 1.83
+++ /home/repository/moby/moby-live/Perl/MOBY/Central.pm 2003/06/27 02:27:13 1.84
@@ -61,7 +61,7 @@
my $reg = $Central->registerService("
);
print "success ", $reg->success;
- print "\nerror_message ", $reg->error_message;
+ print "\nmessage ", $reg->message;
print "\nregistration_id ", $reg->registration_id;
print "\n\n";
@@ -114,7 +114,7 @@
my ( $details) = @_;
my $id = $details->{registration_id};
my $success = $details->{success};
- my $message = $details->{error_message};
+ my $message = $details->{message};
return "<MOBYRegistration>
<id>$id</id>
@@ -382,76 +382,27 @@
my ($pkg, $payload) = @_;
my $OntologyServer = &_getOntologyServer(ontology => 'object');
- unless ($payload){
- my $reg = &Registration({
- success => 0,
- error_message => "Message Format Incorrect",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("Message Format Incorrect","") unless ($payload);
my ($class) = &_deregisterObjectPayload($payload);
$debug && &_LOG("deregister object type $class\n");
- unless ($class){
- my $reg = &Registration({
- success => 0,
- error_message => "Must include class of object to deregister",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("Must include class of object to deregister","") unless ($class);
my ($success, $message, $existingURI) = $OntologyServer->objectExists(term => $class);
- unless ($existingURI){
- my $reg = &Registration({
- success => 0,
- error_message => "Object class $class does not exist",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("Object class $class does not exist","") unless ($existingURI);
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 class $class is used by a service and may not be deregistered",
- registration_id => "",
- });
- return $reg;
- }
-
+ return &_error("Object class $class is used by a service and may not be deregistered","") if ($id);
+
($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;
- }
+ return &_error("Object class $class is used by a service and may not be deregistered","") if ($id);
($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;
- }
+ return &_error("Object class $class is used by a service and may not be deregistered","") if ($id);
($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;
- }
+ return &_error("Object class $class is used by a service and may not be deregistered","") if ($id);
my ($success2, $message2, $URI) = $OntologyServer->deleteObject(term => $class);
$success2==0 && return &_error($message2, $URI);
@@ -659,45 +610,19 @@
my ($pkg, $payload) = @_;
my $OntologyServer = &_getOntologyServer(ontology => 'service');
- unless ($payload){
- my $reg = &Registration({
- success => 0,
- error_message => "Message Format Incorrect",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("Message Format Incorrect","") unless ($payload);
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",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("Must include an accession number to deregister a serviceType","") unless ($term);
+
my ($success, $message, $existingURI) = $OntologyServer->serviceExists(term => $term); # hopefully this situation will never happen!
- unless ($existingURI){
- my $reg = &Registration({
- success => 0,
- error_message => "Service Type $term does not exist in the ontology",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("Service Type $term does not exist in the ontology","") unless ($existingURI);
+
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 => "A registered service depends on this service type",
- registration_id => "",
- });
- return $reg;
- }
-
+ return &_error("A registered service depends on this service type","") if ($id);
+
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);
@@ -776,7 +701,7 @@
contact_email => $email);
$success==0 && return &_error($message, $URI);
- return &_success("Service type $term registered successfully.", $URI);
+ return &_success("Namespace type $term registered successfully.", $URI);
}
@@ -829,83 +754,33 @@
my ($pkg, $payload) = @_;
my $OntologyServer = &_getOntologyServer(ontology => 'namespace');
- unless ($payload){
- my $reg = &Registration({
- success => 0,
- error_message => "Message Format Incorrect",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("Message Format Incorrect","") unless ($payload);
my ($term) = &_deregisterNamespacePayload($payload);
$debug && &_LOG("deregister namespaceType accession $term\n");
- unless ($term){
- my $reg = &Registration({
- success => 0,
- error_message => "Must include a Namespace type to deregister.",
- registration_id => "",
- });
- return $reg;
- }
-
+ return &_error("Must include a Namespace type to deregister.","") unless ($term);
my ($success, $message, $existingURI) = $OntologyServer->namespaceExists(term => $term);
- unless ($existingURI){
- my $reg = &Registration({
- success => 0,
- error_message => "Namespace Type $term does not exist",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("Namespace Type $term does not exist","") unless ($existingURI);
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 Type $term is used by a service and may not be deregistered",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("Namespace Type $term is used by a service and may not be deregistered","") if ($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;
- }
+ return &_error("Namespace Type $term is used by a service and may not be deregistered","") if ($id);
($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;
- }
+ return &_error("Namespace Type $term is used by a service and may not be deregistered","") if ($id);
($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;
- }
+ return &_error("Namespace Type $term is used by a service and may not be deregistered","") if ($id);
my ($success2, $message2, $URI) = $OntologyServer->deleteNamespace(
term => $term);
$success2==0 && return &_error($message2, $URI);
- return &_success("Namespace $term registered successfully.", $URI);
+ return &_success("Namespace type $term deregistered successfully.", $URI);
}
sub _deregisterNamespacePayload {
@@ -1110,7 +985,7 @@
my ($serviceName, $serviceType, $AuthURI, $contactEmail, $URL, $authoritativeService, $desc, $Category, $INPUTS, $OUTPUTS, $SECONDARY) = &_registerServicePayload($payload);
$authoritativeService = defined($authoritativeService)?1:0;
my $error;
- $error .=" missing serviceName \n" unless defined $serviceName;
+ $error .="missing serviceName \n" unless defined $serviceName;
$error .="missing serviceType \n" unless defined $serviceType;
$error .="missing authURI \n" unless defined $AuthURI;
$error .="missing contactEmail \n" unless defined $contactEmail;
@@ -1118,48 +993,16 @@
$error .="missing description \n" unless defined $desc;
$error .="missing Category \n" unless defined $Category;
- if ($error) {
- $debug && &_LOG("malformed payload $error\n");
- my $reg = &Registration({
- success => 0,
- error_message => "malformed payload $error\n\n",
- 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({
- success => 0,
- error_message => "Category may take the (case sensitive) values 'moby', 'cgi', 'soap'\n",
- registration_id => "",
- });
- return $reg;
- }
-
+ return &_error("malformed payload $error\n\n","") if ($error);
+ return &_error("Category may take the (case sensitive) values 'moby', 'cgi', 'soap'\n","") unless (($Category eq "est") || ($Category eq "cgi") || ($Category eq "moby"));
$debug && &_LOG("Entering switch with $Category method\n");
- unless ($Category eq "moby") {
- my $reg = &Registration({
- success => 0,
- error_message => "Service categories other than 'moby' are not yet implemented",
- registration_id => "",
- });
- return $reg;
- }
-
+ return &_error("Service categories other than 'moby' are not yet implemented","") unless ($Category eq "moby");
my @IN = @{$INPUTS};
my @OUT = @{$OUTPUTS};
my @SECS = @{$SECONDARY};
- unless (scalar @IN || scalar @OUT){ # throw error if parameter missing
- my $reg = &Registration({
- success => 0,
- error_message => "must include at least one input and/or one output object type",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("must include at least one input and/or one output object type","") unless (scalar @IN || scalar @OUT);
my %objects_to_be_validated;
foreach (@IN, @OUT){
foreach my $objectName(&_extractObjectTypes($_)){
@@ -1170,28 +1013,15 @@
foreach (keys %objects_to_be_validated){
my ($valid, $message, $URI) = $OS->objectExists(term => $_);
- unless ($valid){
- my $reg = &Registration({
- success => 0,
- error_message => "$message",
- registration_id => "$URI",
- });
- return $reg;
- }
+ return &_error("$message","$URI") unless ($valid);
}
$debug && &_LOG("\n\n\aall objects okay\n");
$OS = MOBY::OntologyServer->new(ontology => 'service');
my ($valid, $message, $URI) = $OS->serviceExists(term => $serviceType);
- unless ($valid){
- my $reg = &Registration({
- success => 0,
- error_message => "$message",
- registration_id => "$URI",
- });
- return $reg;
- }
+ return &_error("$message","$URI") unless ($valid);
# right, registration should be successful now!
+
my $SVC = MOBY::service_instance->new(
category => $Category,
servicename => $serviceName,
@@ -1203,65 +1033,27 @@
description => $desc,
);
- if (!defined $SVC){
- my $reg = &Registration({
- success => 0,
- error_message => "Service registration failed for unknown reasons",
- registration_id => "",
- });
- return $reg;
- }
- if ($SVC == -1){
- my $reg = &Registration({
- success => 0,
- error_message => "Service with this authority/servicename already exists",
- registration_id => "",
- });
- return $reg;
- }
+ return &_error("Service registration failed for unknown reasons","") if (!defined $SVC);
+ return &_error("Service with this authority/servicename already exists","") if ($SVC == -1);
+
$debug && &_LOG("new service instance created\n");
foreach my $IN(@IN){
my ($success,$msg) = &_registerArticles($SVC, "input", $IN, undef);
- unless ($success==1) {
- my $reg = &Registration({
- success => 0,
- error_message => "Registration Failed During INPUT Article Registration: $msg",
- registration_id => "",
- });
- return $reg;
- }# and return it.
+ return &_error("Registration Failed During INPUT Article Registration: $msg","") unless ($success==1);
}
foreach my $OUT(@OUT){
my ($success,$msg) = &_registerArticles($SVC, "output", $OUT, undef);
- unless ($success==1) {
- my $reg = &Registration({
- success => 0,
- error_message => "Registration Failed During OUTPUT Article Registration: $msg",
- registration_id => $SVC->service_instance_id,
- });
- return $reg;
- }# and return it.
+ return &_error("Registration Failed During OUTPUT Article Registration: $msg","") unless ($success==1);
}
foreach my $SEC(@SECS){
my ($success,$msg) = &_registerArticles($SVC, "secondary", $SEC, undef);
- unless ($success==1) {
- my $reg = &Registration({
- success => 1,
- error_message => "Registration Failed During SECONDARY Article Registration: $msg",
- registration_id => $SVC->service_instance_id,
- });
- return $reg;
- }# and return it.
+ return &_error("Registration Failed During SECONDARY Article Registration: $msg","") unless ($success==1);
}
- my $reg = &Registration({
- success => 1,
- error_message => "",
- registration_id => $SVC->service_instance_id,
- });
- return $reg; # and return it.
+ return &success("Registration successful", $SVC->service_instance_id);
}
+
sub _registerArticles {
my ($SVC, $inout, $node,$collid) = @_; # node is a node of the XML dom representing an article to be registered
my $dbh = $SVC->dbh;
@@ -1438,13 +1230,7 @@
sub registerServiceWSDL {
my ( $pkg, $serviceType, $wsdl) = @_;
- my $reg = &Registration({
- success => 0,
- error_message => "not yet implemented\n",
- registration_id => "",
- });
- return $reg;
-
+ return &_error("not yet implemented", "");
}
@@ -1471,37 +1257,17 @@
my ($pkg, $payload) = @_;
$debug && &_LOG("\nstarting deregistration\n");
my ($authURI, $serviceName) = &_deregisterServicePayload($payload);
- unless ($authURI && $serviceName){
- my $reg = &Registration({
- success => 0,
- error_message => "must provide an authority and a service name\n",
- registration_id => 0,
- });
- }
+ return &_error("must provide an authority and a service name\n", "") unless ($authURI && $serviceName);
- unless (MOBY::service_instance->new(servicename => $serviceName, authority_uri => $authURI, test => 1)){
- return &Registration({
- success => 0,
- error_message => "The service specified by authority=$authURI servicename=$serviceName does not exist in the registry",
- registration_id => 0,
- });
- }
+ return &_error("The service specified by authority=$authURI servicename=$serviceName does not exist in the registry", "") unless (MOBY::service_instance->new(servicename => $serviceName, authority_uri => $authURI, test => 1));
my $SERVICE = MOBY::service_instance->new(servicename => $serviceName, authority_uri => $authURI);
my $result = $SERVICE->DELETE_THYSELF;
if ($result){
- return &Registration({
- success => 1,
- error_message => "",
- registration_id => 0,
- });
+ return &_success("Service Deregistered Successfully","");
} else {
- return &Registration({
- success => 0,
- error_message => "Service deletion failed for unknown reasons",
- registration_id => 0,
- });
+ return &_error("Service deletion failed for unknown reasons","");
}
}
@@ -2953,7 +2719,7 @@
my ($message, $id) = @_;
my $reg = &Registration({
success => 0,
- error_message => "$message",
+ message => "$message",
registration_id => "$id",
});
return $reg;
@@ -2963,7 +2729,7 @@
my ($message, $id) = @_;
my $reg = &Registration({
success => 1,
- error_message => "$message",
+ message => "$message",
registration_id => "$id",
});
return $reg;
More information about the MOBY-guts
mailing list