[Bioperl-guts-l] [16573] bioperl-dev/branches/eutils-soap-run/lib/Bio/Tools/Run/ESoap/WSDL. pm: extracting request and result params from wsdl

[Mark Allen Jensen]

Revision: 16573
Author:   maj
Date:     2010-01-02 16:06:37 -0500 (Sat, 02 Jan 2010)
Log Message:
-----------
extracting request and result params from wsdl

Modified Paths:
--------------
    bioperl-dev/branches/eutils-soap-run/lib/Bio/Tools/Run/ESoap/WSDL.pm

Modified: bioperl-dev/branches/eutils-soap-run/lib/Bio/Tools/Run/ESoap/WSDL.pm
===================================================================
--- bioperl-dev/branches/eutils-soap-run/lib/Bio/Tools/Run/ESoap/WSDL.pm	2010-01-02 20:17:16 UTC (rev 16572)
+++ bioperl-dev/branches/eutils-soap-run/lib/Bio/Tools/Run/ESoap/WSDL.pm	2010-01-02 21:06:37 UTC (rev 16573)
@@ -186,6 +186,66 @@
     1;
 }
 
+
+
+=head2 result_parameters()
+
+ Title   : result_parameters
+ Usage   : $result_hash = $wsdl->result_parameters
+ Function: retrieve a hash structure describing the 
+           result of running the specified operation
+           according to the WSDL
+ Returns : 
+ Args    : operation (scalar string)
+
+=cut
+
+sub result_parameters {
+    my $self = shift;
+    my ($operation) = @_;
+    my $is_action;
+    $self->throw("Operation name must be specified") unless defined $operation;
+    my $opn_hash = $self->operations;
+    unless ( grep /^$operation$/, keys %$opn_hash ) {
+	$is_action = grep /^$operation$/, values %$opn_hash;
+	$self->throw("Operation name '$operation' is not recognized")
+	    unless ($is_action);
+    }
+    
+    #check the cache here....
+    return $self->_cache("result_params_$operation") if
+	$self->_cache("result_params_$operation");
+
+    # find the input message type in the portType elt
+    if ($is_action) { 
+	my @a = grep {$$opn_hash{$_} eq $operation} keys %$opn_hash;
+	# note this takes the first match
+	$operation = $a[0];
+	$self->throw("Whaaa??") unless defined $operation;
+    }
+    #check the cache once more after translation....
+    return $self->_cache("result_params_$operation") if
+	$self->_cache("result_params_$operation");
+
+    # do work
+    my $bookmarks = $self->_operation_bookmarks($operation);
+
+    # eutilities results seem to be a mixture of xs:string element
+    # and complex types which are just xs:seqs of xs:string elements
+    # 
+    # cast these as a hash of hashes...
+
+    my $ret = [];
+    my $omsg_elt = $bookmarks->{'o_msg_elt'};
+    my $opn_schema = $bookmarks->{'schema'};
+    
+    # do a quick recursion:
+    _get_types($ret, $omsg_elt, $opn_schema);
+    return $self->_cache("result_params_$operation", $ret);
+}
+
+sub response_parameters { shift->result_parameters( @_ ) }
+
 =head2 _operation_bookmarks()
 
  Title   : _operation_bookmarks
@@ -463,5 +523,36 @@
     return $self->{'_parsed'};
 }
 
+sub _get_types {
+    my ($res, $elt, $sch) = @_;
+    # assuming max 1 xs:seq per element
+    my $seq = ($elt->descendants('xs:sequence'))[0];
+    return 1 unless $seq;
+    foreach ( $seq->descendants('xs:element') ) {
+	for my $type ($_->att('type')) {
+	    !defined($type) && do {
+		Bio::Root::Root->throw("type attribute not defined; cannot proceed");
+		last;
+	    };
+	    $type eq 'xs:string' && do {
+		push @$res, { $_->att('name') => 1 };
+		last;
+	    };
+	    do { # custom type
+		my $new_res = [];
+		push @$res, { $_->att('name'), $new_res };
+		# find the type def in schema
+		$type =~ s/.*?://; # strip tns
+		my $new_elt = $sch->first_child("xs:complexType[\@name='$type']");
+		Bio::Root::Root->throw("type not defined in schema; connot proceed") unless defined $new_elt;
+		_get_types($new_res, $new_elt, $sch);
+		last;
+	    }
+	}
+    }
+    return 1;
+}
+	
+	
 
 1;