File Coverage

lib/Mojo/SOAP/Client.pm
Criterion Covered Total %
statement 85 89 95.5
branch 6 10 60.0
condition 2 3 66.6
subroutine 18 19 94.7
pod 2 3 66.6
total 113 124 91.1


line stmt bran cond sub pod time code
1             package Mojo::SOAP::Client;
2              
3             =pod
4              
5             =begin markdown
6              
7             ![](https://github.com/oposs/mojo-soap-client/workflows/Unit%20Tests/badge.svg?branch=master)
8              
9             =end markdown
10              
11             =head1 NAME
12              
13             Mojo::SOAP::Client - Talk to SOAP Services mojo style
14              
15             =head1 SYNPOSYS
16              
17             use Mojo::SOAP::Client;
18             use Mojo::File qw(curfile);
19             my $client = Mojo::SOAP::Client->new(
20             wsdl => curfile->sibling('fancy.wsdl'),
21             xsds => [ curfile->sibling('fancy.xsd')],
22             port => 'FancyPort'
23             );
24              
25             $client->call_p('getFancyInfo',{
26             color => 'green'
27             })->then(sub {
28             my $answer = shift;
29             my $trace = shift;
30             });
31              
32             =head1 DESCRIPTION
33              
34             The Mojo::SOAP::Client is based on the L
35             family of packages, and especially on L.
36              
37             =cut
38              
39 2     2   1039748 use Mojo::Base -base, -signatures;
  2         10  
  2         13  
40              
41 2     2   7195 use Mojo::Promise;
  2         4  
  2         12  
42 2     2   946 use XML::Compile::WSDL11; # use WSDL version 1.1
  2         424254  
  2         86  
43 2     2   856 use XML::Compile::SOAP11; # use SOAP version 1.1
  2         35336  
  2         63  
44 2     2   887 use XML::Compile::SOAP12;
  2         20768  
  2         59  
45 2     2   925 use XML::Compile::Transport::SOAPHTTP_MojoUA;
  2         168433  
  2         73  
46 2     2   18 use HTTP::Headers;
  2         16  
  2         56  
47 2     2   11 use File::Basename qw(dirname);
  2         4  
  2         92  
48 2     2   39 use Mojo::Util qw(b64_encode dumper);
  2         6  
  2         87  
49 2     2   19 use Mojo::Log;
  2         3  
  2         14  
50 2     2   71 use Carp;
  2         4  
  2         2399  
51              
52             our $VERSION = '0.1.8';
53              
54             =head2 Properties
55              
56             The module provides the following properties to customize its behavior. Note that setting any properties AFTER using the C or C methods, will lead to undefined behavior.
57              
58             =head3 log
59              
60             a pointer to a L instance
61              
62             =cut
63              
64             has log => sub ($self) {
65             Mojo::Log->new;
66             };
67              
68             =head3 request_timeout
69              
70             How many seconds to wait for the soap server to respond. Defaults to 5 seconds.
71              
72             =cut
73              
74             has request_timeout => 5;
75              
76             =head3 insecure
77              
78             Set this to allow communication with a soap server that uses a
79             self-signed or otherwhise invalid certificate.
80              
81             =cut
82              
83             has insecure => 0;
84              
85             =head3 wsdl
86              
87             Where to load the wsdl file from. At the moment this MUST be a file.
88              
89             =cut
90              
91             has 'wsdl' => sub ($self) {
92             croak "path to wsdl spec file must be provided in wsdl property";
93             };
94              
95             =head3 xsds
96              
97             A pointer to an array of xsd files to load for this service.
98              
99             =cut
100              
101             has 'xsds' => sub ($self) {
102             [];
103             };
104              
105             =head3 port
106              
107             If the wsdl file defines multiple ports, pick the one to use here.
108              
109             =cut
110              
111             has 'port';
112              
113             =head3 endPoint
114              
115             The endPoint to talk to for reaching the SOAP service. This information
116             is normally encoded in the WSDL file, so you will not have to set this
117             explicitly.
118              
119             =cut
120              
121              
122             has 'endPoint' => sub ($self) {
123             $self->wsdlCompiler->endPoint(
124             $self->port ? ( port => $self->port) : ()
125             );
126             };
127              
128             =head3 ca
129              
130             The CA cert of the service. Only for special applications.
131              
132             =cut
133              
134             has 'ca';
135              
136             =head3 cert
137              
138             The client certificate to use when connecting to the soap service.
139              
140             =cut
141              
142             has 'cert';
143              
144             =head3 key
145              
146             The key matching the client cert.
147              
148             =cut
149              
150             has 'key';
151             has 'ua';
152              
153             has wsdlCompiler => sub ($self) {
154             my $wc = XML::Compile::WSDL11->new($self->wsdl);
155             for my $xsd ( @{$self->xsds}) {
156             $wc->importDefinitions($xsd)
157             }
158             return $wc;
159             };
160              
161             has httpUa => sub ($self) {
162             XML::Compile::Transport::SOAPHTTP_MojoUA->new(
163             address => $self->endPoint,
164             mojo_ua => $self->ua,
165             ua_start_callback => sub ($ua,$tx) {
166             $ua->ca($self->ca)
167             if $self->ca;
168             $ua->cert($self->cert)
169             if $self->cert;
170             $ua->key($self->key)
171             if $self->key;
172             $ua->request_timeout($self->request_timeout)
173             if $self->request_timeout;
174             $ua->insecure($self->insecure)
175             if $self->insecure;
176             },
177             );
178             };
179              
180             =head3 uaProperties
181              
182             If special properties must be set on the UA you can set them here. For example a special authorization header was required, this would tbe the place to set it up.
183              
184             my $client = Mojo::SOAP::Client->new(
185             ...
186             uaProperties => {
187             header => HTTP::Headers->new(
188             Authorization => 'Basic '. b64_encode("$user:$password","")
189             })
190             }
191             );
192              
193             =cut
194              
195             has uaProperties => sub {
196             {}
197             };
198              
199             has transport => sub ($self) {
200             $self->httpUa->compileClient(
201             %{$self->uaProperties}
202             );
203             };
204              
205             has clients => sub ($self) {
206             return {};
207             };
208              
209             =head2 Methods
210              
211             The module provides the following methods.
212              
213             =head3 call_p($operation,$params)
214              
215             Call a SOAP operation with parameters and return a L.
216              
217             $client->call_p('queryUsers',{
218             query => {
219             detailLevels => {
220             credentialDetailLevel => 'LOW',
221             userDetailLevel => 'MEDIUM',
222             userDetailLevel => 'LOW',
223             defaultDetailLevel => 'EXCLUDE'
224             },
225             user => {
226             loginId => 'aakeret'
227             }
228             numRecords => 100,
229             skipRecords => 0,
230             }
231             })->then(sub ($anwser,$trace) {
232             print Dumper $answer
233             });
234              
235             =cut
236              
237 5     5 1 435701 sub call_p ($self,$operation,$params={}) {
  5         14  
  5         11  
  5         10  
  5         14  
238 5         23 my $clients = $self->clients;
239 5 50 66     45 my $call = $clients->{$operation} //= $self->wsdlCompiler->compileClient(
240             operation => $operation,
241             transport => $self->transport,
242             async => 1,
243             # oddly repetitive, the port is mentioned in the endPoint
244             # selection as well as here ...
245             ( $self->port ? ( port => $self->port ) : () ),
246             );
247 5         139358 $self->log->debug(__PACKAGE__ . " $operation called");
248 5     5   8 return Mojo::Promise->new(sub ($resolve,$reject) {
  5         265  
  5         15  
  5         9  
249             $call->(
250             %$params,
251 5         9 _callback => sub ($answer,$trace,@rest) {
252 5         19 my $res = $trace->response;
253 5         39 my $client_warning =
254             $res->headers->header('client-warning');
255 5 50       236 return $reject->($client_warning."\n".$self->trace_to_string($trace))
256             if $client_warning;
257 5 100       24 if (not $res->is_success) {
258 2 50       30 if (my $f = $answer->{Fault}){
259 0         0 $self->log->error(__PACKAGE__ . " $operation - ".$f->{_NAME} .": ". $f->{faultstring});
260 0         0 return $reject->($f->{faultstring}."\n".$self->trace_to_string($trace));
261             }
262 2         41 return $reject->($self->endPoint.' - '.$res->code.' '.$res->message."\n".$self->trace_to_string($trace))
263             }
264             # $self->log->debug(__PACKAGE__ . " $operation completed - ".dumper($answer));
265 3         42 return $resolve->($answer,$trace);
266             }
267 5         50 );
268 5         184 });
269             }
270              
271 2     2 0 73 sub trace_to_string ($self,$trace) {
  2         4  
  2         4  
  2         4  
272 2         5 my $ret;
273 2     2   17 open my $fh, '>', \$ret;
  2         3  
  2         13  
  2         121  
274 2         1773 $trace->printErrors($fh);
275 2         38 print $fh "\nRequest:\n";
276 2         12 $trace->printRequest($fh,pretty_print=>1);
277 2         1250 print $fh "\nResponse:\n";
278 2         14 $trace->printResponse($fh,pretty_print=>1);
279 2         1025 print $fh "\n";
280 2         34 $trace->printTimings($fh);
281 2         268 close $fh;
282 2         65 return $ret;
283             }
284              
285             =head3 call($operation,$paramHash)
286              
287             The same as C but for syncronos applications. If there is a problem with the call it will raise a Mojo::SOAP::Exception which is a L child.
288              
289             =cut
290              
291 1     1 1 1613 sub call ($self,$operation,$params) {
  1         3  
  1         2  
  1         2  
  1         2  
292 1         2 my ($ret,$err);
293             $self->call_p($operation,$params)
294 0     0   0 ->then(sub { $ret = shift })
295 1     1   481 ->catch(sub { $err = shift })
296 1         6 ->wait;
297 1 50       206 Mojo::SOAP::Exception->throw($err) if $err;
298 0           return $ret;
299             }
300              
301             package Mojo::SOAP::Exception {
302 2     2   15 use Mojo::Base 'Mojo::Exception';
  2         4  
  2         9  
303             }
304              
305             1;
306              
307             =head1 ACKNOWLEDGEMENT
308              
309             This is really just a very thin layer on top of Mark Overmeers great L module. Thanks Mark!
310              
311             =head1 AUTHOR
312              
313             Stobi@oetiker.chE>
314              
315             =head1 COPYRIGHT
316              
317             Copyright OETIKER+PARTNER AG 2019
318              
319             =head1 LICENSE
320              
321             This library is free software; you can redistribute it and/or modify
322             it under the same terms as Perl itself, either Perl version 5.10 or,
323             at your option, any later version of Perl 5 you may have available.
324              
325             =cut