[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Sat Aug 16 15:51:33 UTC 2003
mwilkinson
Sat Aug 16 11:51:33 EDT 2003
Update of /home/repository/moby/moby-live/Perl/MOBY/Client
In directory pub.open-bio.org:/tmp/cvs-serv6250/MOBY/Client
Modified Files:
Central.pm
Log Message:
this version of the client allows connections to a MOBY Central registry running with a CGI GET interface, rather than a CGI SOAP interface. Since such a thing doesn't exist yet, this should not matter to anyone.
moby-live/Perl/MOBY/Client Central.pm,1.46,1.47
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/Client/Central.pm,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -r1.46 -r1.47
--- /home/repository/moby/moby-live/Perl/MOBY/Client/Central.pm 2003/08/16 15:46:10 1.46
+++ /home/repository/moby/moby-live/Perl/MOBY/Client/Central.pm 2003/08/16 15:51:33 1.47
@@ -82,8 +82,8 @@
URI => $URI},
}
- by default this becomes
- {MOBY_Central => {
- URL => 'http://mobycentral.cbr.nrc.ca/cgi-bin/MOBY-Central.pl',
+ {mobycentral => {
+ URL => 'http://mobycentral.cbr.nrc.ca/cgi-bin/MOBY05/mobycentral.pl',
URI => 'http://mobycentral.cbr.nrc.ca/MOBY/Central'}
}
Discussion: Each registry must have a different
@@ -106,7 +106,7 @@
=cut
-my $debug = 1;
+my $debug = 0;
if ($debug){open (OUT, ">/tmp/CentralLogOut.txt") || die "cant open logfile CentralLogOut.txt $!\n";close OUT;}
@@ -118,10 +118,11 @@
#ATTRIBUTES
my %_attr_data = # DEFAULT ACCESSIBILITY
(
- SOAP_connections => [undef, 'read/write'],
+ Connections => [undef, 'read/write'],
default_MOBY_servername => ['mobycentral', 'read/write'],
default_MOBY_server => ['http://mobycentral.cbr.nrc.ca/cgi-bin/MOBY05/mobycentral.pl', 'read/write'],
- default_MOBY_uri => ['http://mobycentral.cbr.nrc.ca/MOBY/Central', 'read/write'],
+ default_MOBY_uri => ['http://mobycentral.cbr.nrc.ca/MOBY/Central', 'read/write'],
+ default_MOBY_type => ['soap', 'read/write'],
Registries => [undef, 'read/write'],
multiple_registries => [undef, 'read/write'],
# SWITCH TO THESE FOR A LOCAL MOBY CENTRAL REGISTRY
@@ -152,21 +153,63 @@
keys %_attr_data;
}
- sub SOAP_connection {
+ sub Connection {
my ($self, $desired) = @_;
if ($desired){
- while (my ($name, $soap) = (@{$self->SOAP_connections->[0]})){
- return $soap if $name eq $desired;
+ while (my ($name, $type, $connect) = (@{$self->Connections->[0]})){
+ return ($type, $connect) if $name eq $desired;
}
} else {
- my ($name, $soap) = @{$self->SOAP_connections->[0]};
- return $soap;
+ my ($name, $type, $connect) = @{$self->Connections->[0]};
+ return ($type,$connect);
}
- return 0;
+ return (undef, undef);
}
}
+sub _call {
+ # this method replaces the former calls directly
+ # to teh SOAP_Connection, to give more flexibility
+ # in how that call is made
+ # most subroutines in here do the following:
+ # $return = $self->SOAP_connection->call(registerObjectClass => ($message))->paramsall;
+ # or $payload = $self->SOAP_connection($reg)->call('Relationships' => ($m))->paramsall;
+
+ # so intercept that and figure out if we are actually making a SOAP call or not
+ # and determine which registry it is
+
+ my ($self, $reg, $method, @params) = @_;
+ $reg = $self->default_MOBY_servername if $reg eq "default";
+ $reg = $self->default_MOBY_servername if !$reg;
+
+ my ($type, $connect) = $self->Connection($reg);
+ return "<result>EXECUTION ERROR - registry $reg not found</result>" unless ($type && $connect);
+
+ my $param = join "", @params; # must be a single message!
+
+ if (lc($type) eq "get"){
+ print STDERR "executing CGI call\n";
+ use LWP::UserAgent;
+ my $ua = LWP::UserAgent->new;
+ use CGI;
+ $param =~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
+ my $paramstring = "?action=$method";
+ $paramstring .=";payload=$param" if $param;
+ my $req = HTTP::Request->new(GET => $connect.$paramstring);
+ my $res = $ua->request($req);
+ if ($res->is_success){
+ return $res->content;
+ } else {
+ return "<result>EXECUTION ERROR - unsuccessful call to MOBY Central registry named '$reg'</result>"
+ }
+ } else {
+ print STDERR "executing SOAP call\n";
+ my $payload = $connect->call($method => $param)->paramsall;
+ return $payload;
+ }
+}
+
sub new {
my ($caller, %args) = @_;
@@ -185,11 +228,12 @@
else {
$self->{$attrname} = $self->_default_for($attrname) }
}
- $self->SOAP_connections([]); # initialize;
+ $self->Connections([]); # initialize;
# if user has set up preferred servers, then use those by default
$self->default_MOBY_server($ENV{MOBY_SERVER}) if $ENV{MOBY_SERVER};
$self->default_MOBY_uri($ENV{MOBY_URI}) if $ENV{MOBY_URI};
+ $self->default_MOBY_type($ENV{MOBY_TYPE}) if $ENV{MOBY_TYPE};
if ($self->Registries){
@@ -199,27 +243,36 @@
$regno++; # count how many registries we have in total
my $url = $acc->{URL};
my $uri = $acc->{URI};
- push @{$self->SOAP_connections}, [$name, SOAP::Lite->proxy($url)->uri($uri)->on_fault(
- sub{
- my($soap, $res) = @_;
- die ref $res ? $res->faultstring : $soap->transport->status, "\n ERROR ERROR ERROR\n";
- })];
+ my $type = $acc->{TYPE};
+ if (lc($type) eq "get"){
+ push @{$self->Connections}, [$name, $type, $url];
+ } else {
+ push @{$self->Connections}, [$name, $type, SOAP::Lite->proxy($url)->uri($uri)->on_fault(
+ sub{
+ my($soap, $res) = @_;
+ die ref $res ? $res->faultstring : $soap->transport->status, "\n ERROR ERROR ERROR\n";
+ })];
+ }
}
- $self->multiple_registries($regno-1); # one is okay, two is too many :-)
+ $self->multiple_registries($regno-1); # one is not "multiple", it is just a change in default -> set to "false" if only one
} else {
- $self->multiple_registries(0);
+ $self->multiple_registries(0);
+ if (lc($self->default_MOBY_type) eq "get"){
+ push @{$self->Connections}, [$self->default_MOBY_servername, $self->default_MOBY_type,$self->default_MOBY_server];
+ } else {
$self->Registries({$self->default_MOBY_servername => {
URL => $self->default_MOBY_server,
URI => $self->default_MOBY_uri
}}
);
- push @{$self->SOAP_connections},[$self->default_MOBY_servername, SOAP::Lite->proxy($self->default_MOBY_server)->uri($self->default_MOBY_uri)->on_fault(
+ push @{$self->Connections},[$self->default_MOBY_servername, $self->default_MOBY_type, SOAP::Lite->proxy($self->default_MOBY_server)->uri($self->default_MOBY_uri)->on_fault(
sub{
my($soap, $res) = @_;
die ref $res ? $res->faultstring : $soap->transport->status, "\n ERROR ERROR ERROR\n";
})];
+ }
}
- return undef unless $self->SOAP_connection(); # gotta have at least one...
+ return undef unless $self->Connection(); # gotta have at least one...
return $self;
}
@@ -281,7 +334,8 @@
}
$message .="</registerObjectClass>";
- my $return = $self->SOAP_connection->call(registerObjectClass => ($message))->paramsall;
+# my $return = $self->SOAP_connection->call(registerObjectClass => ($message))->paramsall;
+ my $return = $self->_call('default', 'registerObjectClass', $message);
return ($self->parseRegXML($return));
@@ -313,7 +367,8 @@
<deregisterObjectClass>
<objectType>$id</objectType>
</deregisterObjectClass>";
- my $return = $self->SOAP_connection->call(deregisterObjectClass => ($message))->paramsall;
+# my $return = $self->SOAP_connection->call(deregisterObjectClass => ($message))->paramsall;
+ my $return = $self->_call('default', 'deregisterObjectClass', $message);
return ($self->parseRegXML($return));
@@ -359,7 +414,8 @@
$message .="</Relationship>\n";
}
$message .= "</registerServiceType>";
- my $return = $self->SOAP_connection->call(registerServiceType => ($message))->paramsall;
+# my $return = $self->SOAP_connection->call(registerServiceType => ($message))->paramsall;
+ my $return = $self->_call('default', 'registerServiceType', $message);
return ($self->parseRegXML($return));
}
@@ -387,7 +443,8 @@
<deregisterServiceType>
<serviceType>$id</serviceType>
</deregisterServiceType>";
- my $return = $self->SOAP_connection->call(deregisterServiceType => ($message))->paramsall;
+# my $return = $self->SOAP_connection->call(deregisterServiceType => ($message))->paramsall;
+ my $return = $self->_call('default', 'deregisterServiceType', $message);
return ($self->parseRegXML($return));
@@ -423,7 +480,8 @@
<contactEmail>$contact</contactEmail>
</registerNamespace>";
- my $return = $self->SOAP_connection->call(registerNamespace => ($message))->paramsall;
+# my $return = $self->SOAP_connection->call(registerNamespace => ($message))->paramsall;
+ my $return = $self->_call('default', 'registerNamespace', $message);
return ($self->parseRegXML($return));
@@ -450,7 +508,8 @@
<deregisterNamespace>
<namespaceType>$id</namespaceType>
</deregisterNamespace>";
- my $return = $self->SOAP_connection->call(deregisterNamespace => ($message))->paramsall;
+# my $return = $self->SOAP_connection->call(deregisterNamespace => ($message))->paramsall;
+ my $return = $self->_call('default', 'deregisterNamespace', $message);
return ($self->parseRegXML($return));
@@ -650,7 +709,8 @@
# print STDERR $message;
$debug && &_LOG(" message\n\n$message\n\n");
- my $return = $self->SOAP_connection->call(registerService => ($message))->paramsall;
+# my $return = $self->SOAP_connection->call(registerService => ($message))->paramsall;
+ my $return = $self->_call('default', 'registerService', $message);
return ($self->parseRegXML($return));
@@ -670,7 +730,8 @@
my ($self, %a) = @_;
return $self->errorRegXML("Function not allowed when querying multiple registries") if $self->multiple_registries;
my $message = "";
- my $return = $self->SOAP_connection->call(registerServiceWSDL => ($message))->paramsall;
+# my $return = $self->SOAP_connection->call(registerServiceWSDL => ($message))->paramsall;
+ my $return = $self->_call('default', 'registerServiceWSDL', $message);
return ($self->parseRegXML($return));
@@ -708,7 +769,8 @@
<authURI>$auth</authURI>
</deregisterService>";
- my $return = $self->SOAP_connection->call(deregisterService => ($message))->paramsall;
+# my $return = $self->SOAP_connection->call(deregisterService => ($message))->paramsall;
+ my $return = $self->_call('default', 'deregisterService', $message);
return ($self->parseRegXML($return));
@@ -799,13 +861,19 @@
# [objType4 => [ns5, ns6...]]], # collection of multiple object types
# ]
while (my ($inout, $param) = each %funkyhash){
+ die "no inout parameter from teh funkyhash" unless defined $inout;
+ die "no param parameter from teh funkyhash" unless defined $param;
+ die "param parameter should be a listref" unless (ref($param) =~ /ARRAY/);
+
my $inout_lc = lc ($inout);
my @PARAM = @{$param};
$message .= "<${inout_lc}Objects><${inout}>\n";
foreach my $param(@PARAM){
unless (ref($param) =~ /array/i){return (undef, $self->errorRegXML("invalid structure of $inout objects, expected arrayref of class and \@namespaces"))}
my ($class, $namespaces) = @{$param};
- my @objectdefs;
+ die "no class part of param " unless defined $class;
+ warn "no namespace part of the param" unless defined $namespaces;
+ my @objectdefs;
if ((ref $class) =~ /array/i){ # collection
$message .="<Collection>\n";
@objectdefs = $class;
@@ -816,6 +884,7 @@
foreach my $objectdef(@objectdefs){
$message .="<Simple>\n";
my ($type, $Namespaces) = @{$objectdef};
+ die "type is missing from objectdef " unless $type;
$message .="<objectType>$type</objectType>\n";
if (defined($Namespaces) && !(ref($Namespaces) =~ /array/i)){return (undef, $self->errorRegXML("invalid structure of $inout namespaces for object $type; expected arrayref"))}
foreach my $ns(@{$Namespaces}){
@@ -831,11 +900,9 @@
$message .= "</${inout}></${inout_lc}Objects>\n";
}
$message .= "</findService>\n";
-
-# print $message;
-# my $return = $self->SOAP_connection($reg)->call('retrieveServiceTypes' => (@_))->paramsall;
- my $return = $self->SOAP_connection($reg)->call('findService' => ($message))->paramsall;
+# my $return = $self->SOAP_connection($reg)->call('findService' => ($message))->paramsall;
+ my $return = $self->_call($reg, 'findService', $message);
return ($self->_parseServices($reg, $return), undef);
}
@@ -861,7 +928,7 @@
my $name = $SI->name;
my $reg = $SI->registry;
- return undef unless ($auth && $name && $self->SOAP_connection($reg));
+ return undef unless ($auth && $name && $self->Connection($reg));
my $message = "
<retrieveService>
@@ -869,7 +936,9 @@
</retrieveService>";
- my $return = $self->SOAP_connection($reg)->call(retrieveService => ($message))->paramsall;
+# my $return = $self->SOAP_connection($reg)->call(retrieveService => ($message))->paramsall;
+ my $return = $self->_call($reg, 'retrieveService', $message);
+
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
@@ -909,9 +978,11 @@
my $reg = shift;
$reg = $reg?$reg:$self->default_MOBY_servername;
- return undef unless ($self->SOAP_connection($reg));
+ return undef unless ($self->Connection($reg));
+
+# my $return = $self->SOAP_connection($reg)->call('retrieveServiceNames' => (@_))->paramsall;
+ my $return = $self->_call($reg, 'retrieveServiceNames', "");
- my $return = $self->SOAP_connection($reg)->call('retrieveServiceNames' => (@_))->paramsall;
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -942,8 +1013,9 @@
my ($self) = shift;
my $reg = shift;
$reg = $reg?$reg:$self->default_MOBY_servername;
- return undef unless ($self->SOAP_connection($reg));
- my $return = $self->SOAP_connection($reg)->call('retrieveServiceProviders' => (@_))->paramsall;
+ return undef unless ($self->Connection($reg));
+# my $return = $self->SOAP_connection($reg)->call('retrieveServiceProviders' => (@_))->paramsall;
+ my $return = $self->_call($reg, 'retrieveServiceProviders', "");
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -973,8 +1045,10 @@
my ($self) = shift;
my $reg = shift;
$reg = $reg?$reg:$self->default_MOBY_servername;
- return undef unless ($self->SOAP_connection($reg));
- my $return = $self->SOAP_connection($reg)->call('retrieveServiceTypes' => (@_))->paramsall;
+ return undef unless ($self->Connection($reg));
+# my $return = $self->SOAP_connection($reg)->call('retrieveServiceTypes' => (@_))->paramsall;
+ my $return = $self->_call($reg, 'retrieveServiceTypes', "");
+
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -1012,8 +1086,10 @@
my $reg = shift;
$reg = $reg?$reg:$self->default_MOBY_servername;
- return undef unless ($self->SOAP_connection($reg));
- my $return = $self->SOAP_connection($reg)->call('retrieveObjectNames' => (@_))->paramsall;
+ return undef unless ($self->Connection($reg));
+ #my $return = $self->SOAP_connection($reg)->call('retrieveObjectNames' => (@_))->paramsall;
+ my $return = $self->_call($reg, 'retrieveObjectNames', "");
+
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -1049,9 +1125,10 @@
my ($self)= shift;
my $reg = shift;
$reg = $reg?$reg:$self->default_MOBY_servername;
- return undef unless ($self->SOAP_connection($reg));
+ return undef unless ($self->Connection($reg));
- my $return = $self->SOAP_connection($reg)->call('retrieveNamespaces' => (@_))->paramsall;
+# my $return = $self->SOAP_connection($reg)->call('retrieveNamespaces' => (@_))->paramsall;
+ my $return = $self->_call($reg, 'retrieveNamespaces', "");
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -1094,8 +1171,9 @@
</retrieveObject>";
$reg =$reg?$reg:$self->default_MOBY_servername;
- return undef unless ($self->SOAP_connection($reg));
- my $return = $self->SOAP_connection($reg)->call('retrieveObject' => ($message))->paramsall;
+ return undef unless ($self->Connection($reg));
+# my $return = $self->SOAP_connection($reg)->call('retrieveObject' => ($message))->paramsall;
+ my $return = $self->_call($reg, 'retrieveObject', $message);
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -1141,9 +1219,10 @@
<objectType>$name</objectType>
</retrieveObjectDefinition>";
$reg =$reg?$reg:$self->default_MOBY_servername;
- return undef unless ($self->SOAP_connection($reg));
- my $payload = $self->SOAP_connection($reg)->call('retrieveObjectDefinition' => ($message))->paramsall;
- my ($term, $desc, $relationships, $email, $auth, $clobber) = &_registerObjectPayload($payload);
+ return undef unless ($self->Connection($reg));
+# my $payload = $self->SOAP_connection($reg)->call('retrieveObjectDefinition' => ($message))->paramsall;
+ my $return = $self->_call($reg, 'retrieveObjectDefinition', $message);
+ my ($term, $desc, $relationships, $email, $auth, $clobber) = &_registerObjectPayload($return);
unless (defined $term && defined $desc && defined $auth && defined $email){
if ($term =~ /FAILED/){return undef}
}
@@ -1226,8 +1305,9 @@
}
$m .= "</Relationships>";
$reg =$reg?$reg:$self->default_MOBY_servername;
- return undef unless ($self->SOAP_connection($reg));
- $payload = $self->SOAP_connection($reg)->call('Relationships' => ($m))->paramsall;
+ return undef unless ($self->Connection($reg));
+ #$payload = $self->SOAP_connection($reg)->call('Relationships' => ($m))->paramsall;
+ $payload = $self->_call($reg, 'Relationships', $m);
} elsif ($service){
$m = "
<Relationships>
@@ -1237,8 +1317,9 @@
}
$m .= "</Relationships>";
$reg =$reg?$reg:$self->default_MOBY_servername;
- return undef unless ($self->SOAP_connection($reg));
- $payload = $self->SOAP_connection($reg)->call('Relationships' => ($m))->paramsall;
+ return undef unless ($self->Connection($reg));
+# $payload = $self->SOAP_connection($reg)->call('Relationships' => ($m))->paramsall;
+ $payload = $self->_call($reg, 'Relationships', $m);
}
return &_relationshipsPayload($payload);
}
@@ -1287,8 +1368,10 @@
my $type = shift;
$reg =$reg?$reg:$self->default_MOBY_servername;
- return undef unless ($self->SOAP_connection($reg));
- return $self->SOAP_connection($reg)->call('DUMP')->paramsall;
+ return undef unless ($self->Connection($reg));
+# return $self->SOAP_connection($reg)->call('DUMP')->paramsall;
+ my $payload = $self->_call($reg, 'DUMP', "");
+ return $payload;
}
sub _parseServices {
More information about the MOBY-guts
mailing list