[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at dev.open-bio.org
Tue Jan 28 21:51:46 UTC 2003
Tue Jan 28 16:51:46 EST 2003
Update of /home/repository/moby/moby-live/Perl/Client/MOBY/Client
In directory dev:/tmp/cvs-serv19891/Perl/Client/MOBY/Client
Modified Files:
Central.pm Registration.pm
Log Message:
A total rewrite of the MOBY Central interface, along with a rewrite of the Perl client-side wrapper. MOBY Central is no longer object oriented (->new method is deprecated), all messages are XML objects rather than Perl objects, some additional methods have been added to deregister namespaces and service types, i fixed some of the SQL logic that was faulty, and i cleaned up the return data so that it is consistent from call to call. i have fixed the various client scripts here in the Perl repository, but I have not yet fixed the CGI-based client running at CBR Halifax, nor have I updated the public MOBY::Central with this new code. I will do that within the next 24 hours - in the meantime, you may well find that everything is broken. Once everything is uploaded and tweaked I will update the documentation on the BioMOBY website to reflect the new API. In the meantime, you can get the latest documentation from Perldoc or pod2html.
moby-live/Perl/Client/MOBY/Client Central.pm,1.1,1.2 Registration.pm,1.1,1.2
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/Client/MOBY/Client/Central.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- /tmp/T0eBa4_M 2003-01-28 16:51:46.380001978 -0500
+++ /tmp/T1fBa4_M 2003-01-28 16:51:46.390007393 -0500
@@ -5,13 +5,16 @@
use Carp;
use XML::DOM;
use MOBY::Client::ServiceInstance;
+use MOBY::Client::Registration;
use vars qw($AUTOLOAD @ISA $MOBY_server $MOBY_uri);
-
=head1 NAME
MOBY::Client::Central - a client side wrapper for MOBY Central
+=cut
+
+
=head1 SYNOPSIS
use MOBY::Client::Central;
@@ -19,8 +22,8 @@
my $Services = $Central->locateServiceByInput('Sequence');
foreach my $SERVICE(@{$Services}){
- print "Service Name: ", $SERVICE->name
- print "Service Provider: ", $SERVICE->authority
+ print "Service Name: ", $SERVICE->name;
+ print "Service Provider: ", $SERVICE->authority;
}
=cut
@@ -34,14 +37,10 @@
MOBY::Central XML output into Perlish lists, hashes, and objects. This should
be sufficient for most or all MOBY Client activities written in Perl.
-Write (i.e. Registration) transactions are not (yet) supported, and should be
-done through connection to the MOBY::Central API directly.
-
=head1 AUTHORS
-Mark Wilkinson (mwilkinson at gene.pbi.nrc.ca)
-Plant Biotechnology Institute, National Research Council of Canada.
+Mark Wilkinson (markw at illuminae.com)
BioMOBY Project: http://www.biomoby.org
@@ -58,32 +57,22 @@
Usage : my $MOBY = MOBY::Client::Central->new(%args)
Function : connect to MOBY-Central
Returns : MOBY::Client::Central object
- Args : config => location of config file (default './MOBY/central.cfg')
-
- MOBY_server => URL of server (default 'http://mobycentral.cbr.nrc.ca/cgi-bin/MOBY-Central.pl')
+ Args : MOBY_server => URL of server
+ (default 'http://mobycentral.cbr.nrc.ca/cgi-bin/MOBY-Central.pl')
+ MOBY_uri => URI of server
+ (default 'http://mobycentral.cbr.nrc.ca/MOBY/Central')
- MOBY_uri => URI of server (default 'http://mobycentral.cbr.nrc.ca/MOBY/Central')
-
- Notes : config file location is relative to the CGI script that calls
- this module, not to this module itself!!
- File contains the following lines (in order):
- MOBY Central Database IP Address\n
- Database Name\n
- Username\n
- Password\n
- If you do not host a MOBY::Central database locally, or don't know better,
- then don't use any of these arguments!
+ Notes : If you do not host a MOBY::Central
+ database locally, or don't know
+ better,then don't use any arguments
=cut
+my $debug = 1;
-my $debug = 0;
-
-if ($debug){open (OUT, ">/tmp/CentralLogOut.txt") || die "cant open logfile\n";close OUT;}
-
+if ($debug){open (OUT, ">/tmp/CentralLogOut.txt") || die "cant open logfile CentralLogOut.txt $!\n";close OUT;}
-
{
# Encapsulated:
# DATA
@@ -93,11 +82,9 @@
my %_attr_data = # DEFAULT ACCESSIBILITY
(
SOAP_connection => [undef, 'read/write'],
- config => ["./MOBY/central.cfg", 'read/write'],
MOBY_server => ['http://mobycentral.cbr.nrc.ca/cgi-bin/MOBY-Central.pl', 'read/write'],
MOBY_uri => ['http://mobycentral.cbr.nrc.ca/MOBY/Central', 'read/write'],
- Current_Central_Status => [undef, 'read/write'],
-
+
);
#_____________________________________________________________
@@ -148,17 +135,352 @@
die ref $res ? $res->faultstring : $soap->transport->status, "\n ERROR ERROR ERROR\n";
});
- my $Central = $soap_connection->call(new => ('config', $self->config))->result;
- # due to the way SOAP::Lite functions, we must pass $Central to all future calls
- # to ensure that the current configuration information is present in each call
- # this is a bit strange, I agree....
$self->SOAP_connection($soap_connection); # store the SOAP connection
- $self->Current_Central_Status($Central); # store the object data
return $self;
}
+=head2 registerObject
+
+ Title : registerObject
+ Usage : $REG = $MOBY->registerObject(%args)
+ Function : register a new type of MOBY Object
+ Returns : MOBY::Registration object
+ Args : objectType => "the name of the Object"
+ description => "a human-readable description of the object"
+ xsd => "an xsd string describing the object structure"
+ i.e. everything between (excluding) the <xs:schema/> tags
+ ISA => \@list_of_immediate_parent_object_types (or empty listref)
+ authURI => "URI of the registrar of this object"
+ clobber => 0 | 1 |2;
+ 0 = DON'T ; 1 = deprecate and re-register ; 2 = overwrite
+
+=cut
+
+sub registerObject {
+
+ my ($self, %a) = @_;
+ my $term = $a{objectType}; $term ||="";
+ my $desc = $a{description}; $desc ||="";
+ my $xsd = $a{xsd}; $xsd ||="";
+ my @ISA = @{$a{ISA}};
+ my $authURI = $a{authURI}; $authURI ||="";
+ my $clobber = $a{clobber}?$a{clobber}:0;
+ my $message = "
+ <registerObject>
+ <objectType>$term</objectType>
+ <description><![CDATA[$desc]]></description>
+ <ISA>";
+ foreach (@ISA){
+ $message .="<objectType>$_</objectType>\n"
+ }
+ $message .= "</ISA>
+ <authURI>$authURI</authURI>
+ <clobber>$clobber</clobber>
+ <xsd><![CDATA[$xsd]]></xsd>
+ </registerObject>";
+
+ my $return = $self->SOAP_connection->call(registerObject => ($message))->paramsall;
+
+ return ($self->parseRegXML($return));
+
+}
+
+
+=head2 deregisterObject
+
+ Title : deregisterObject
+ Usage : $REG = $MOBY->deregisterObject(%args)
+ Function : deregister a deprecated MOBY Object
+ Returns : MOBY::Registration object
+ Args : objectAcc => $myObjectAccession
+
+
+=cut
+
+
+
+sub deregisterObject {
+
+ my ($self, %a) = @_;
+ my $id = $a{'objectAcc'}; $id ||="";
+ my $message = "
+ <deregisterObject>
+ <objectAcc>$id</objectAcc>
+ </deregisterObject>";
+ my $return = $self->SOAP_connection->call(deregisterObject => ($message))->paramsall;
+
+ return ($self->parseRegXML($return));
+
+}
+
+
+
+=head2 registerServiceType
+
+ Title : registerServiceType
+ Usage : $REG = $MOBY->registerServiceType(%args)
+ Function : register a new MOBY Service type
+ Returns : MOBY::Registration object
+ Args : serviceType => $serviceType
+ description => "human readable description"
+ ISA => [$serviceType1, $serviceType2, ...]
+
+
+
+=cut
+
+sub registerServiceType {
+
+ my ($self, %a) = @_;
+ my $type = $a{'serviceType'}; $type ||="";
+ my $desc = $a{'description'}; $desc ||="";
+ my @ISA = @{$a{'ISA'}};
+
+ my $message = "
+ <registerServiceType>
+ <serviceType>$type</serviceType>
+ <description><![CDATA[$desc]]></description>
+ <ISA>\n";
+ foreach (@ISA){
+ $message .= "<serviceType>$_</serviceType>\n";
+ }
+ $message .="</ISA>
+ </registerServiceType>";
+
+ my $return = $self->SOAP_connection->call(registerServiceType => ($message))->paramsall;
+
+ return ($self->parseRegXML($return));
+
+}
+
+
+
+=head2 deregisterServiceType
+
+ Title : deregisterServiceType
+ Usage : $REG = $MOBY->deregisterServiceType(%args)
+ Function : deregister a deprecated MOBY Service Type
+ Returns : MOBY::Registration object
+ Args : serviceTypeAcc => $myServiceTypeAccession
+
+
+=cut
+
+
+
+sub deregisterServiceType {
+
+ my ($self, %a) = @_;
+ my $id = $a{'serviceTypeAcc'}; $id ||="";
+ my $message = "
+ <deregisterServiceType>
+ <serviceTypeAcc>$id</serviceTypeAcc>
+ </deregisterServiceType>";
+ my $return = $self->SOAP_connection->call(deregisterServiceType => ($message))->paramsall;
+
+ return ($self->parseRegXML($return));
+
+}
+
+=head2 registerNamespace
+
+ Title : registerNamespace
+ Usage : $REG = $MOBY->registerNamespace(%args)
+ Function : register a new Namespace
+ Returns : MOBY::Registration object
+ Args : namespaceType => $namespaceType (required)
+ authURI => your.authority.URI (required)
+ description => "human readable description of namespace" (required)
+ clobber => 0 | 1 (optional, default 0)
+
+
+=cut
+
+
+
+sub registerNamespace {
+
+ my ($self, %a) = @_;
+ my $type = $a{'namespaceType'}; $type ||="";
+ my $authURI = $a{'authURI'}; $authURI ||="";
+ my $desc = $a{'description'}; $desc ||="";
+ my $clobber = $a{'clobber'};
+ $clobber ||= 0;
+ my $message = "
+ <registerNamespace>
+ <namespaceType>$type</namespaceType>
+ <description><![CDATA[$desc]]></description>
+ <authURI>$authURI</authURI>
+ <clobber>$clobber</clobber>
+ </registerNamespace>";
+
+ my $return = $self->SOAP_connection->call(registerNamespace => ($message))->paramsall;
+
+ return ($self->parseRegXML($return));
+
+}
+
+
+
+
+=head2 deregisterNamespace
+
+ Title : deregisterNamespace
+ Usage : $REG = $MOBY->deregisterNamespace(%args)
+ Function : deregister a deprecated MOBY Namespace
+ Returns : MOBY::Registration object
+ Args : namespaceAcc => $mynamespaceAccession
+
+
+=cut
+
+
+
+sub deregisterNamespace {
+
+ my ($self, %a) = @_;
+ my $id = $a{'namespaceAcc'}; $id ||="";
+ my $message = "
+ <deregisterNamespace>
+ <namespaceAcc>$id</namespaceAcc>
+ </deregisterNamespace>";
+ my $return = $self->SOAP_connection->call(deregisterNamespace => ($message))->paramsall;
+
+ return ($self->parseRegXML($return));
+
+}
+
+
+
+=head2 registerService
+
+ Title : registerService
+ Usage : $REG = $MOBY->registerService(%args)
+ Function : register a new MOBY Service instance
+ Returns : MOBY::Registration object
+ Args : serviceName => $serviceName, # REQUIRED
+ serviceType => $serviceType, # REQUIRED
+ authURI => $authURI, # REQUIRED
+ input => {objectType1 => [namespace1, namespace2, namespace3], #REQUIRED
+ objectType2 => [namespace1, namespace4, namespace5],
+ } (hash-ref!)
+ output => [ObjectType1, ObjectType2,...], (list ref!) # REQUIRED
+ URL => $URL, # REQUIRED
+ description => $human_readable_description, # REQUIRED
+
+
+=cut
+
+
+sub registerService {
+
+ my ($self, %a) = @_;
+ my $name = $a{serviceName}; $name ||="";
+ my $type = $a{serviceType}; $type ||="";
+ my %IN = %{$a{input}};
+ my @OUT = @{$a{output}};
+ my $authURI = $a{authURI}; $authURI ||="";
+ my $URL = $a{URL}; $URL ||="";
+ my $desc = $a{description}; $desc ||="";
+
+
+ my $message = "
+ <registerService>
+ <serviceName>$name</serviceName>
+ <serviceType>$type</serviceType>
+ <description><![CDATA[$desc]]></description>
+ <inputObjects>\n";
+ while (my ($otype, $ns) = each %IN){
+ $message .= "
+ <input>
+ <objectType>$otype</objectType>\n";
+ foreach (@{$ns}){
+ $message .= "
+ <namespace>$_</namespace>\n"
+ }
+ $message .= "
+ </input>\n";
+ }
+
+ $message .="
+ </inputObjects>
+ <outputObjects>";
+
+ foreach (@OUT){
+ $message .= "
+ <objectType>$_</objectType>\n";
+ }
+ $message .="
+ </outputObjects>
+ <authURI>$authURI</authURI>
+ <URL>$URL</URL>
+ </registerService>";
+ &_LOG(" message\n\n$message\n\n");
+ my $return = $self->SOAP_connection->call(registerService => ($message))->paramsall;
+
+ return ($self->parseRegXML($return));
+
+}
+
+=head2 registerServiceWSDL
+
+ Title : registerServiceWSDL
+ Usage : not yet implemented
+
+
+=cut
+
+
+sub registerServiceWSDL {
+
+ my ($self, %a) = @_;
+ my $message = "";
+ my $return = $self->SOAP_connection->call(registerServiceWSDL => ($message))->paramsall;
+
+ return ($self->parseRegXML($return));
+
+}
+
+
+
+=head2 deregisterService
+
+ Title : deregisterService
+ Usage : $REG = $MOBY->deregisterService(%args)
+ Function : deregister a registered MOBY Service
+ Returns : MOBY::Registration object
+ Args : serviceID => $serviceID
+
+
+=cut
+
+
+
+sub deregisterService {
+
+ my ($self, %a) = @_;
+ my $id = $a{'serviceID'};
+ defined $id || return (&parseRegXML("
+ <MOBYRegistration>
+ <id></id>
+ <success>0</success>
+ <message><![CDATA[you did not pass a valid service ID number]]></message>
+ </MOBYRegistration>"));
+ my $message = "
+ <deregisterService>
+ <serviceID>$id</serviceID>
+ </deregisterService>";
+
+ my $return = $self->SOAP_connection->call(deregisterService => ($message))->paramsall;
+
+ return ($self->parseRegXML($return));
+
+}
+
+
+
=head2 locateServiceByOutput
@@ -167,15 +489,13 @@
Function : get the names/descriptions for services that use certain INPUT's
Returns : list of ServiceInstance objects
Args : (in order)
- $OUT : output Object type
- \@Namespaces : optional - restrict to those who handle these namespaces (eg. GenBank/GI)
- $serviceType : optional - restrict to Service Type (from ontology)
- $AuthURI : optional - restrict to only these service providers
- $max_return : optional - restrict number returned
- $full_objects: boolean, default 1, expand output object ontology
- to retrieve this type, and all child types
- $full_service: boolean, default 1, expand service ontology
- to retrieve this type and all child types
+ objectType => $outputObject : output Object type
+ serviceType => $serviceType : optional - restrict to Service Type (from ontology)
+ authURI => $AuthURI : optional - restrict to only these service providers
+ fullObjects => $full_objects: boolean, default 1, expand output object ontology
+ to retrieve this type, and all child types
+ fullServices =>$full_service: boolean, default 1, expand service ontology
+ to retrieve this type and all child types
=cut
@@ -184,33 +504,44 @@
sub locateServiceByOutput {
- my ($self) = shift;
- my $return = $self->SOAP_connection->call(locateServiceByOutput => ($self->Current_Central_Status, at _))->paramsall;
+ my ($self, %a) = @_;
+ my $out = $a{objectType};$out ||="";
+ my $type = $a{serviceType};$type ||="";
+ my $auth = $a{authURI};$auth ||="";
+ my $fo = $a{fullObjects};$fo ||="";
+ my $fs = $a{fullServices};$fs ||="";
+ return () unless $out;
+ my $message = "
+ <locateServiceByOutput>
+ <objectType>$out</objectType>
+ <serviceType>$type</serviceType>
+ <authURI>$auth</authURI>
+ <fullObjects>$fo</fullObjects>
+ <fullServices>$fs</fullServices>
+ </locateServiceByOutput>";
+
+ my $return = $self->SOAP_connection->call(locateServiceByOutput => ($message))->paramsall;
my @Services = $self->_parseServices($return);
return @Services;
}
-
=head2 locateServiceByInput
Title : locateServiceByInput
- Usage : @Services = $MOBY->locateServiceByInput(@args)
+ Usage : @Services = $MOBY->locateServiceByInput(%args)
Function : get the names/descriptions for services that use certain INPUT's
Returns : list of ServiceInstance objects
- Args : in order - must pass undef if you skip any
- \@INs : listref of input Object types by name (
- currently connected by OR, but this will change)
- \@Namespaces : optional - restrict to those who handle these
- namespaces by name (eg. GenBank ID)
- $serviceType : optional - restrict to Service Type by name
- (from ontology)
- $AuthURI : optional - restrict to only these
+ Args : input => {objectType1 => [namespace1, namespace2, namespace3],
+ objectType2 => [namespace1, namespace4, namespace5],
+ } (hash-ref!)
+ serviceType => $serviceType : optional - restrict to Service Type by name
+ ( from ontology)
+ authURI => $AuthURI : optional - restrict to only these
service providers by URI
- $max_return : optional - restrict number returned
- $full_objects: boolean, default 1, traverse Object ontology
- $full_service: boolean, default 1, traverse Service ontology
+ fullObjects=> $full_objects: boolean, default 1, traverse Object ontology
+ fullServices=>$full_service: boolean, default 1, traverse Service ontology
=cut
@@ -219,8 +550,38 @@
sub locateServiceByInput {
- my ($self) = shift;
- my $return = $self->SOAP_connection->call(locateServiceByInput => ($self->Current_Central_Status, at _))->paramsall;
+ my ($self, %a) = @_;
+ my $IN = $a{input};
+ my $type = $a{serviceType}; $type ||="";
+ my $auth = $a{authURI}; $auth ||="";
+ my $fo = $a{fullObjects}; $fo ||="";
+ my $fs = $a{fullServices}; $fs ||="";
+ return () unless $IN;
+
+ $debug && &_LOG("locateServiceByInput INPUT $IN\nallparams %a\n\n");
+ my $message = "
+ <locateServiceByInput>
+ <inputObjects>\n";
+ while (my ($otype, $ns) = each %{$IN}){
+ $message .= "
+ <input>
+ <objectType>$otype</objectType>\n";
+ foreach (@{$ns}){
+ $message .= "
+ <namespaceType>$_</namespaceType>\n"
+ }
+ $message .= "
+ </input>\n";
+ }
+
+ $message .="</inputObjects>
+ <serviceType>$type</serviceType>
+ <authURI>$auth</authURI>
+ <fullObjects>$fo</fullObjects>
+ <fullServices>$fs</fullServices>
+ </locateServiceByInput>";
+
+ my $return = $self->SOAP_connection->call(locateServiceByInput => ($message))->paramsall;
my @Services = $self->_parseServices($return);
return @Services;
@@ -231,12 +592,11 @@
Title : locateServiceByType
Usage : @Services = $MOBY->locateServiceByType (@args)
- Function : get the names/descriptions for services that use certain INPUT's
+ Function : get the names/descriptions for services of a particular type
Returns : list of ServiceInstance objects
Args : (in order)
- $serviceType : the name of the Service Type (from ontology)
- $max_return : optional - how many WSDL documents to return at maximum
- $expand : optional - boolean, default 1, expand ontology
+ serviceType => $serviceType : the name of the Service Type (from ontology)
+ fullServices=>$expand_services : optional - boolean, default 1, expand ontology
to include child service-types
@@ -244,9 +604,20 @@
sub locateServiceByType {
+ my ($self, %a) = @_;
- my ($self) = shift;
- my $return = $self->SOAP_connection->call(locateServiceByType => ($self->Current_Central_Status, at _))->paramsall;
+ my $type = $a{'serviceType'};
+ return () unless $type;
+ my $fs = $a{'fullServices'};
+ $fs ||="";
+
+ my $message = "
+ <locateServiceByType>
+ <serviceType>$type</serviceType>
+ <fullServices>$fs</fullServices>
+ </locateServiceByType>";
+
+ my $return = $self->SOAP_connection->call(locateServiceByType => ($message))->paramsall;
my @Services = $self->_parseServices($return);
return @Services;
}
@@ -256,9 +627,10 @@
Title : retrieveService
Usage : $WSDL = $MOBY->locateService($AuthURI, $servicename)
- Function : get the WSDL descriptions for services with this service name
+ Function : get the WSDL definition of the service with this name/authority URI
Returns : a WSDL string
- Args : $AuthURI, $serviceName as returned by the locate* calls
+ Args : authURI => $AuthURI,
+ serviceName => $serviceName (as returned by the locate* calls)
=cut
@@ -266,8 +638,19 @@
sub retrieveService {
- my ($self)=shift;
- my $return = $self->SOAP_connection->call(retrieveService => ($self->Current_Central_Status, at _))->paramsall;
+ my ($self, %a)=@_;
+
+ my $auth = $a{authURI};
+ my $name = $a{serviceName};
+ return undef unless ($auth && $name);
+
+ my $message = "
+ <retrieveService>
+ <authURI>$auth</authURI>
+ <serviceName>$name</serviceName>
+ </retrieveService>";
+
+ my $return = $self->SOAP_connection->call(retrieveService => ($message))->paramsall;
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $WSDL = $doc->getDocumentElement->getFirstChild->getNodeValue;
@@ -294,7 +677,7 @@
sub retrieveServiceNames {
my ($self) = shift;
- my $return = $self->SOAP_connection->call('retrieveServiceNames' => ($self->Current_Central_Status, @_))->paramsall;
+ my $return = $self->SOAP_connection->call('retrieveServiceNames' => (@_))->paramsall;
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -323,7 +706,7 @@
sub retrieveServiceProviders{
my ($self) = shift;
- my $return = $self->SOAP_connection->call('retrieveServiceProviders' => ($self->Current_Central_Status, @_))->paramsall;
+ my $return = $self->SOAP_connection->call('retrieveServiceProviders' => (@_))->paramsall;
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -351,7 +734,7 @@
sub retrieveServiceTypes {
my ($self) = shift;
- my $return = $self->SOAP_connection->call('retrieveServiceTypes' => ($self->Current_Central_Status, @_))->paramsall;
+ my $return = $self->SOAP_connection->call('retrieveServiceTypes' => (@_))->paramsall;
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -386,7 +769,7 @@
sub retrieveObjectNames {
my ($self) = shift;
- my $return = $self->SOAP_connection->call('retrieveObjectNames' => ($self->Current_Central_Status, @_))->paramsall;
+ my $return = $self->SOAP_connection->call('retrieveObjectNames' => (@_))->paramsall;
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -420,7 +803,7 @@
sub retrieveNamespaces {
my ($self) = shift;
- my $return = $self->SOAP_connection->call('retrieveNamespaces' => ($self->Current_Central_Status, @_))->paramsall;
+ my $return = $self->SOAP_connection->call('retrieveNamespaces' => (@_))->paramsall;
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -453,7 +836,7 @@
sub retrieveObject {
my ($self) = shift;
- my $return = $self->SOAP_connection->call('retrieveObject' => ($self->Current_Central_Status, @_))->paramsall;
+ my $return = $self->SOAP_connection->call('retrieveObject' => (@_))->paramsall;
my $parser = new XML::DOM::Parser;
my $doc = $parser->parse($return);
my $root = $doc->getDocumentElement;
@@ -484,18 +867,9 @@
my $Service = $Services->item($x);
my $AuthURI = $Service->getAttributeNode('authURI')->getValue;
my $servicename = $Service->getAttributeNode('serviceName')->getValue;
- my $Type;
- for my $elem($Service->getElementsByTagName('ServiceType')){
- $Type = $elem->getFirstChild->toString;
- }
- my $Output;
- for my $elem($Service->getElementsByTagName('OutputObject')){
- $Output = $elem->getFirstChild->toString;
- }
- my $Description;
- for my $elem($Service->getElementsByTagName('Description')){
- $Description = $elem->getFirstChild->toString;
- }
+ my $Type = &_nodeTextContent($Service, 'ServiceType');
+ my $Output = &_nodeTextContent($Service, 'OutputObject');
+ my $Description = &_nodeTextContent($Service, 'Description');
my $Instance = MOBY::Client::ServiceInstance->new(
authority => $AuthURI,
name => $servicename,
@@ -508,7 +882,42 @@
return @Services;
}
-
+sub parseRegXML {
+ #<MOBYRegistration>
+ # <id>$id</id>
+ # <success>$success</success>
+ # <message><![CDATA[$message]]></message>
+ #</MOBYRegistration>
+ my ($self, $xml) = @_;
+ my $Parser = new XML::DOM::Parser;
+
+ my $doc = $Parser->parse($xml);
+ my $Object = $doc->getDocumentElement();
+ my $obj = $Object->getTagName;
+ return undef unless ($obj eq 'MOBYRegistration');
+ my $id = &_nodeTextContent($Object, 'id');
+ my $success = &_nodeTextContent($Object, 'success');
+ my $message = &_nodeTextContent($Object, 'message');
+ my $reg = MOBY::Client::Registration->new(
+ success => $success,
+ error_message => $message,
+ registration_id => $id,);
+ return $reg;
+}
+sub _nodeTextContent {
+ # will get text of **all** child $node from the given $DOM
+ # regardless of their depth!!
+ my ($DOM, $node) = @_;
+ my $x = $DOM->getElementsByTagName($node);
+ my @child = $x->item(0)->getChildNodes;
+ my $content;
+ foreach (@child){
+ #print $_->getNodeTypeName, "\t", $_->toString,"\n";
+ next unless $_->getNodeType == TEXT_NODE;
+ $content = $_->toString;
+ }
+ return $content;
+}
sub AUTOLOAD {
no strict "refs";
my ($self, $newval) = @_;
@@ -549,12 +958,5 @@
print LOG "\n---\n";
close LOG;
}
-#
-#
-# --------------------------------------------------------------------------------------------------------
-#
-##
-##
-
1;
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/Client/MOBY/Client/Registration.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- /tmp/T0WCaWaN 2003-01-28 16:51:46.480004381 -0500
+++ /tmp/T1XCaWaN 2003-01-28 16:51:46.490007186 -0500
@@ -11,10 +11,9 @@
#ATTRIBUTES
my %_attr_data = # DEFAULT ACCESSIBILITY
(
- success => [0, 'read/write'],
- error_message => [undef, 'read/write'],
- registration_id => [undef, 'read/write'],
-
+ success => [0, 'read/write'],
+ error_message => ["OK", 'read/write'],
+ registration_id => ["0", 'read/write'],
);
#_____________________________________________________________
@@ -49,7 +48,7 @@
my $self = bless {}, $class;
foreach my $attrname ( $self->_standard_keys ) {
- if (exists $args{$attrname}) {
+ if (exists $args{$attrname} && defined $args{$attrname}) {
$self->{$attrname} = $args{$attrname} }
elsif ($caller_is_obj) {
$self->{$attrname} = $caller->{$attrname} }
More information about the MOBY-guts
mailing list