[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at dev.open-bio.org
Sat Jan 25 01:26:47 UTC 2003
Fri Jan 24 20:26:47 EST 2003
Update of /home/repository/moby/moby-live/Example_Code
In directory dev:/tmp/cvs-serv16835
Modified Files:
mobyadmin.pl
Log Message:
updated Lukas' MOBY Central administration code. this code DOES NOT WORK WITH PERL 5.8 due to a bug in 5.8's AUTOLOAD. I'll continue working on it over the next few days, but at least it shows how to successfully register and deregister services. I have not yet tested the namespace/object/service-type registration. It may or may not work as promised.
moby-live/Example_Code mobyadmin.pl,1.3,1.4
===================================================================
RCS file: /home/repository/moby/moby-live/Example_Code/mobyadmin.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- /tmp/T05fai6G 2003-01-24 20:26:47.420006809 -0500
+++ /tmp/T16fai6G 2003-01-24 20:26:47.430009794 -0500
@@ -1,23 +1,26 @@
-#!/usr/local/bin/perl
+#!/usr/bin/perl
#
# A utility to register and de-register MOBY objects from the command line.
# Not very streamlined at the moment...
# Comments and improvements welcome.
# Lukas Mueller, TAIR
# July 9, 2002
+
+# updated by Mark Wilkinson, Jan 24, 2003.
#
# Usage: mobyadmin.pl
# The rest is menu based.
#
use SOAP::Lite +autodispatch =>
- proxy => 'http://bioinfo.pbi.nrc.ca:8099/cgi-bin/MOBY-Central.pl', #maybe on port 8099?
+ proxy => 'http://mobycentral.cbr.nrc.ca/cgi-bin/MOBY-Central.pl',
on_fault => sub {
my($soap, $res) = @_;
die ref $res ? $res->faultstring : $soap->transport->status, "\n";
};
-use lib "../../moby-live/Central";
+#use lib "/home/markw/BIO/moby-live/Perl/Central";
+#use MOBY::Central;
print "Connecting to MOBY Server...\n";
my $moby = MOBY::Central-> new();
@@ -93,36 +96,49 @@
if ($correct=~/^[Yy]/) {
$reg = $moby -> registerService($serviceName, $serviceType, $authURI, \@INS, \@OUTS, \@NameSpaces, $url, $desc);
- $id = $reg-> registration_id();
- print "Your register number is: $id\n";
- open (F, ">>$REGFILE") || warn "Couldn't open $REGFILE\n";
- print F "ACTIVE\t$id\t$serviceName\t$serviceType\t$authURI\t$INS[0]\t$OUTS[0]\t$NameSapces[0]\t$url\t$desc\n";
- close(F);
+ my ($success, $id, $message) = ($reg->{success}, $reg->{registration_id}, $reg->{error_message});
+ if ($success){
+ print "Your registration number is: $id\n";
+ open (F, ">>$REGFILE") || warn "Couldn't open $REGFILE for local recording of this registration $!\n";
+ print F "ACTIVE\t$id\t$serviceName\t$serviceType\t$authURI\t$INS[0]\t$OUTS[0]\t$NameSpaces[0]\t$url\t$desc\n";
+ close(F);
+ } else {
+ print "\n\n\aService Registration Failed with error message $message\n\n";
+ }
}
else { print "Your service has not been registered.\n"; }
- print "Press RETURN to continue"; $cont =(<STDIN>);
+ print "Press RETURN to continue"; my $cont =(<STDIN>);
}
sub deregisterService {
my $moby = shift;
system("clear");
print "De-register MOBY Service\n\n";
- open (F, "<$REGFILE") || warn "Can't open $REGFILE!\n";
+ open (F, "<$REGFILE") || warn "Can't open $REGFILE! $!\nThis is problematic... only services registered using this script can be deregistered using this script. Sorry!\n";
@REGFILE=(<F>);
close(F);
+ my %services;
for ($i=0; $i< @REGFILE; $i++) {
- if ($REGFILE[$i]=~/ACTIVE/i) {print "$i\t$REGFILE[$i]\n";}
+ if ($REGFILE[$i]=~/ACTIVE\t(\d+)/i) {
+ print "$i\t$REGFILE[$i]\n";
+ $services{$i} = $1;
+ }
}
print "Deregister which ? [choose number from first column] "; $which = (<STDIN>); chomp($which);
- $reg = $moby -> deregisterService ($which);
- $REGFILE[$which]=~s/^ACTIVE/INACTIVE/i;
- open (F, ">$REGFILE") || warn "Can't open $REGFILE for writing!\n";
- foreach $r (@REGFILE) {
- print F $r;
+ $reg = $moby -> deregisterService ($services{$which});
+ my ($success, $id, $message) = ($reg->{success}, $reg->{registration_id}, $reg->{error_message});
+ if ($success){
+ print "Your service has been deregistered!\n";
+ $REGFILE[$which]=~s/^ACTIVE/INACTIVE/i;
+ open (F, ">$REGFILE") || warn "Can't open $REGFILE for writing! $!\n Your de-registration succeeded with id=$id, however this script could not update your local record of registered services.\n";
+ foreach $r (@REGFILE) {
+ print F $r;
+ }
+ } else {
+ print "\n\n\aService deregistration failed with error message $message\n";
}
close(F);
- print "Your service has been deregistered!\n";
-}
+ }
sub registerObject {
@@ -140,13 +156,17 @@
print "Register Object? "; $continue = (<STDIN>); chomp($continue);
if ($continue =~ /^[Yy]/) {
$reg = $moby -> registerObject($term, $desc, $xsd, \@ISA, $clobber);
- #$id = $reg -> identification_id();
- $id = "NO ID";
- open (F, ">>$REGFILE") || warn "Couldn't open $REGFILE\n";
- print F "ACTIVE\t$id\t$term\t$desc\t$xsd\t$isa\t$uri\t$clobber\n";
- close(F);
+ my ($success, $id, $message) = ($reg->{success}, $reg->{registration_id}, $reg->{error_message});
+ if ($success){
+
+ open (F, ">>$REGFILE") || warn "Couldn't open $REGFILE\n";
+ print F "ACTIVE\t$id\t$term\t$desc\t$xsd\t$isa\t$uri\t$clobber\n";
+ close(F);
- print "Service has been registered\n";
+ print "Object has been registered\n";
+ } else {
+ print "Object has not been registered.\n";
+ }
}
else {
print "Object has not been registered.\n";
@@ -166,13 +186,18 @@
print "\nRegister? "; $continue = (<STDIN>); chomp($continue);
if ($continue =~ /^[Yy]/) {
$reg = $moby-> registerNamespace($ns, $auth, $desc, $clobber);
- my $id = $reg -> identification_id();
- open (F, ">>$REGFILE") || warn "Couldn't open $REGFILE!\n";
- print F "ACTIVE\t$id\t$ns\t$auth\t$desc\t$clobber\n";
- close(F);
- print "Your Namespace has been registered. The register id is: ".$reg->registration_id()."\n";
+ my ($success, $id, $message) = ($reg->{success}, $reg->{registration_id}, $reg->{error_message});
+ if ($success){
+ open (F, ">>$REGFILE") || warn "Couldn't open $REGFILE!\n";
+ print F "ACTIVE\t$id\t$ns\t$auth\t$desc\t$clobber\n";
+ close(F);
+ print "Your Namespace has been registered. The register id is: ".$reg->registration_id()."\n";
+ } else {
+ print "Your Namespace has NOT been registered!\n";
+ }
+ } else {
+ print "Your Namespace has NOT been registered!\n";
}
- else { print "Your Namespace has NOT been registered!\n";}
}
@@ -182,40 +207,22 @@
print "Listing MOBY Services, Objects, Namespaces and Providors\n\n";
print "Registered Services:\n\n";
- $serviceref = $moby -> retrieveServiceNames();
- foreach $sr (keys %$serviceref) {
- print "$sr, $$serviceref{$sr}\n";
- }
+ print $moby -> retrieveServiceNames();
print "\n\nRegistered Object Names:\n\n";
- $onref = $moby -> retrieveObjectNames();
- foreach $on (keys %$onref) {
- print "$on, $$onref{$on}\n";
- }
+ print $moby -> retrieveObjectNames();
print "\n\nRegistered Namespaces:\n\n";
- $nsref = $moby -> retrieveNamespaces();
- foreach $ns (keys %$nsref) {
- print "$ns, $$nsref{$ns}\n";
- }
+ print $moby -> retrieveNamespaces();
print "\n\nRegistered Objects: \n\n";
- $moref = $moby -> retrieveObject();
- foreach $mo (keys %$moref) {
- print "$mo, $$moref{$mo}\n";
- }
+ print $moby -> retrieveObject();
print "\n\nRegistered Service Types: \n\n";
- $typeref = $moby -> retrieveServiceTypes();
- foreach $t (keys %$types) {
- print "$t, $$types{$t}\n";
- }
+ print $moby -> retrieveServiceTypes();
print "\n\nRegistered Providors:\n\n";
- @providors = $moby -> retrieveServiceProvidors();
- foreach $p (@providors) {
- print "$p\n";
- }
+ print $moby -> retrieveServiceProviders();
print "\n\nPress RETURN to continue. "; my $continue=(<STDIN>);
More information about the MOBY-guts
mailing list