File Coverage

blib/lib/SOAP/WSDL/Client/Base.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package SOAP::WSDL::Client::Base;
2 1     1   381 use strict;
  1         1  
  1         29  
3 1     1   4 use warnings;
  1         1  
  1         30  
4 1     1   5 use base 'SOAP::WSDL::Client';
  1         1  
  1         427  
5             use Scalar::Util qw(blessed);
6              
7             our $VERSION = 3.003;
8              
9             sub call {
10             my ($self, $method, $body, $header) = @_;
11              
12             # Treat non-objects special
13             if (not blessed $body) {
14              
15             # make sure there's something sensible in our body data
16             $body = {} if not defined $body;
17             $body = ref $body eq 'ARRAY' ? $body : [ $body ];
18              
19             my @body_from = @{ $body }; # make a copy
20              
21             # build list of parts as objects initialized with
22             # parameters given
23             my @part_from = ();
24             foreach my $class (@{ $method->{ body }->{ parts } }) {
25             eval "require $class" || die $@; ## no critic (ProhibitStringyEval)
26             push @part_from, $class->new(shift(@body_from) || {});
27             }
28              
29             # it's either the first part or a list ref with all parts...
30             $body = $#part_from ? \@part_from : $part_from[0];
31             }
32              
33             # if we have a header
34             if (%{ $method->{ header } }) {
35              
36             # treat non object special - as above, but only for one
37             if (not blessed $header) {
38             my $class = $method->{ header }->{ parts }->[0];
39             eval "require $class" || die $@; ## no critic (ProhibitStringyEval)
40             $header = $class->new($header);
41             }
42             }
43             return $self->SUPER::call($method, $body, $header);
44             }
45              
46             1;
47              
48             __END__