1package SOAP::WSDL::Client;
2use strict;
3use warnings;
4use Carp;
5
6use Class::Std::Fast::Storable;
7use Scalar::Util qw(blessed);
8
9use SOAP::WSDL::Factory::Deserializer;
10use SOAP::WSDL::Factory::Serializer;
11use SOAP::WSDL::Factory::Transport;
12use SOAP::WSDL::Expat::MessageParser;
13
14our $VERSION = 3.004;
15
16my %class_resolver_of   :ATTR(:name<class_resolver> :default<()>);
17my %no_dispatch_of      :ATTR(:name<no_dispatch>    :default<()>);
18my %prefix_of           :ATTR(:name<prefix>         :default<()>);
19my %outputxml_of        :ATTR(:name<outputxml>      :default<()>);
20my %transport_of        :ATTR(:name<transport>      :default<()>);
21my %endpoint_of         :ATTR(:name<endpoint>       :default<()>);
22
23my %soap_version_of     :ATTR(:get<soap_version>    :init_attr<soap_version> :default<1.1>);
24
25my %on_action_of        :ATTR(:name<on_action>      :default<()>);
26my %content_type_of     :ATTR(:name<content_type>   :default<text/xml; charset=utf-8>);  #/#trick editors
27my %encoding_of         :ATTR(:name<encoding>       :default<utf-8>);
28my %serializer_of       :ATTR(:name<serializer>     :default<()>);
29my %deserializer_of     :ATTR(:name<deserializer>   :default<()>);
30my %deserializer_args_of   :ATTR(:name<deserializer_args>   :default<{}>);
31
32sub BUILD {
33    my ($self, $ident, $attrs_of_ref) = @_;
34
35    if (exists $attrs_of_ref->{ proxy }) {
36        $self->set_proxy( $attrs_of_ref->{ proxy } );
37        delete $attrs_of_ref->{ proxy };
38    }
39    return;
40}
41
42sub get_proxy {                         ## no critic RequireArgUnpacking
43    return $_[0]->get_transport();
44}
45
46sub set_proxy {
47    my ($self, @args_from) = @_;
48    my $ident = ${ $self };
49
50    # remember old value to return it later - Class::Std does so, too
51    my $old_value = $transport_of{ $ident };
52
53    # accept both list and list ref args
54    @args_from =  @{ $args_from[0] } if ref $args_from[0];
55
56    # remember endpoint
57    $endpoint_of{ $ident } = $args_from[0];
58
59    # set transport - SOAP::Lite works similar...
60    $transport_of{ $ident } =  SOAP::WSDL::Factory::Transport
61      ->get_transport( @args_from );
62
63    return $old_value;
64}
65
66sub set_soap_version {
67    my $ident = ${ $_[0] };
68
69    # remember old value to return it later - Class::Std does so, too
70    my $soap_version = $soap_version_of{ $ident };
71
72    # re-setting the soap version invalidates the
73    # serializer object
74    delete $serializer_of{ $ident };
75    delete $deserializer_of{ $ident };
76
77    $soap_version_of{ $ident } = $_[1];
78
79    return $soap_version;
80}
81
82# Mimic SOAP::Lite's behaviour for getter/setter routines
83SUBFACTORY: {
84    for (qw(class_resolver no_dispatch outputxml proxy prefix)) {
85        my $setter = "set_$_";
86        my $getter = "get_$_";
87        no strict qw(refs);     ## no critic ProhibitNoStrict
88        *{ $_ } = sub { my $self = shift;
89            if (@_) {
90                $self->$setter(@_);
91                return $self;
92            }
93            return $self->$getter()
94        };
95    }
96}
97
98sub call {
99    my ($self, $method, @data_from) = @_;
100    my $ident = ${ $self };
101
102    # the only valid idiom for calling a method with both a header and a body
103    # is
104    # ->call($method, $body_ref, $header_ref);
105    #
106    # These other idioms all assume an empty header:
107    # ->call($method, %body_of);    # %body_of is a hash
108    # ->call($method, $body);       # $body is a scalar
109    my ($data, $header) = ref $data_from[0]
110      ? ($data_from[0], $data_from[1] )
111      : (@data_from>1)
112          ? ( { @data_from }, undef )
113          : ( $data_from[0], undef );
114
115    # get operation name and soap_action
116    my ($operation, $soap_action) = (ref $method eq 'HASH')
117        ? ( $method->{ operation }, $method->{ soap_action } )
118        : (blessed $data
119            && $data->isa('SOAP::WSDL::XSD::Typelib::Builtin::anyType'))
120            ? ( $method , (join q{/}, $data->get_xmlns(), $method) )
121            : ( $method, q{} );
122    $serializer_of{ $ident } ||= SOAP::WSDL::Factory::Serializer->get_serializer({
123        soap_version => $self->get_soap_version(),
124    });
125
126    my $envelope = $serializer_of{ $ident }->serialize({
127        method => $operation,
128        body => $data,
129        header => $header,
130        options => {prefix => $prefix_of{ $ident }},
131    });
132
133    return $envelope if $self->no_dispatch();
134
135    # always quote SOAPAction header.
136    # WS-I BP 1.0 R1109
137    if ($soap_action) {
138        $soap_action =~s{\A(:?"|')?}{"}xms;
139        $soap_action =~s{(:?"|')?\Z}{"}xms;
140    }
141    else {
142        $soap_action = q{""};
143    }
144
145    # get response via transport layer.
146    # Normally, SOAP::Lite's transport layer is used, though users
147    # may provide their own.
148    my $transport = $self->get_transport();
149    my $response = $transport->send_receive(
150       endpoint => $self->get_endpoint(),
151       content_type => $content_type_of{ $ident },
152       encoding => $encoding_of{ $ident },
153       envelope => $envelope,
154       action => $soap_action,
155       # on_receive_chunk => sub {}     # optional, may be used for parsing large responses as they arrive.
156    );
157
158    return $response if ($outputxml_of{ $ident } );
159
160    # get deserializer
161    use Data::Dumper;
162    $deserializer_of{ $ident } ||= SOAP::WSDL::Factory::Deserializer->get_deserializer({
163        soap_version => $soap_version_of{ $ident },
164        %{ $deserializer_args_of{ $ident } },
165    });
166
167    # set class resolver if serializer supports it
168    $deserializer_of{ $ident }->set_class_resolver( $class_resolver_of{ $ident } )
169        if ( $deserializer_of{ $ident }->can('set_class_resolver') );
170
171    # Try deserializing response - there may be some,
172    # even if transport did not succeed (got a 500 response)
173    if ( $response ) {
174        # as our faults are false, returning a success marker is the only
175        # reliable way of determining whether the deserializer succeeded.
176        # Custom deserializers may return an empty list, or undef,
177        # and $@ is not guaranteed to be undefined.
178        my ($success, $result_body, $result_header) = eval {
179            (1, $deserializer_of{ $ident }->deserialize( $response ));
180        };
181        if (defined $success) {
182            return wantarray
183                ? ($result_body, $result_header)
184                : $result_body;
185        }
186        elsif (blessed $@) { #}&& $@->isa('SOAP::WSDL::SOAP::Typelib::Fault11')) {
187            return $@;
188        }
189        else {
190            return $deserializer_of{ $ident }->generate_fault({
191                code => 'soap:Server',
192                role => 'urn:localhost',
193                message => "Error deserializing message: $@. \n"
194                    . "Message was: \n$response"
195            });
196        }
197    };
198
199    # if we had no success (Transport layer error status code)
200    # or if transport layer failed
201    if ( ! $transport->is_success() ) {
202
203        # generate & return fault if we cannot serialize response
204        # or have none...
205        return $deserializer_of{ $ident }->generate_fault({
206            code => 'soap:Server',
207            role => 'urn:localhost',
208            message => 'Error sending / receiving message: '
209                . $transport->message()
210        });
211    }
212} ## end sub call
213
2141;
215
216__END__
217
218=pod
219
220=head1 NAME
221
222SOAP::WSDL::Client - SOAP::WSDL's SOAP Client
223
224=head1 SYNOPSIS
225
226 use SOAP::WSDL::Client;
227 my $soap = SOAP::WSDL::Client->new({
228     proxy => 'http://www.example.org/webservice/test'
229 });
230 $soap->call( \%method, $body, $header);
231
232=head1 METHODS
233
234=head2 call
235
236 $soap->call( \%method, \@parts );
237
238%method is a hash with the following keys:
239
240 Name           Description
241 ----------------------------------------------------
242 operation      operation name
243 soap_action    SOAPAction HTTP header to use
244 style          Operation style. One of (document|rpc)
245 use            SOAP body encoding. One of (literal|encoded)
246
247The style and use keys have no influence yet.
248
249@parts is a list containing the elements of the message parts.
250
251For backward compatibility, call may also be called as below:
252
253 $soap->call( $method, \@parts );
254
255In this case, $method is the SOAP operation name, and the SOAPAction header
256is guessed from the first part's namespace and the operation name (which is
257mostly correct, but may fail). Operation style and body encoding are assumed to
258be document/literal
259
260=head2 Configuration methods
261
262=head3 outputxml
263
264 $soap->outputxml(1);
265
266When set, call() returns the raw XML of the SOAP Envelope.
267
268=head3 set_content_type
269
270 $soap->set_content_type('application/xml; charset: utf8');
271
272Sets the content type and character encoding.
273
274You probably should not use a character encoding different from utf8:
275SOAP::WSDL::Client will not convert the request into a different encoding
276(yet).
277
278To leave out the encoding, just set the content type without appending charset
279like this:
280
281  $soap->set_content_type('text/xml');
282
283Default:
284
285 text/xml; charset: utf8
286
287=head3 set_prefix
288
289 $soap->set_prefix('ns2');
290
291If set, alters the serialization of the request XML such that the supplied value is used as a namespace prefix for SOAP method calls. By way of example, the default XML serialization returns something like this:
292
293    <?xml version="1.0"?>
294    <SOAP-ENV:Envelope
295        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
296        xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
297      <SOAP-ENV:Body>
298        <getElementId xmlns="http://services.exmaple.org/">
299          <elementId>12345</elementId>
300        </getElementId>
301      </SOAP-ENV:Body>
302    </SOAP-ENV:Envelope>
303
304If the sample set_prefix() call above is used prior to calling your SOAP method, the XML serialization returns this instead:
305
306    <?xml version="1.0"?>
307    <SOAP-ENV:Envelope
308        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
309        xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
310        xmlns:ns2="http://services.example.org/">
311      <SOAP-ENV:Body>
312        <ns2:getElementId>
313          <elementId>12345</elementId>
314        </ns2:getElementId>
315      </SOAP-ENV:Body>
316    </SOAP-ENV:Envelope>
317
318This is useful in cases where, for instance, one is communicating with a JAX L<https://jax-ws.dev.java.net/> webservice, which tends to understand the latter but not the former. Note that this implementation is currently limited to a single additional namespace; if you require multiple custom namespaces, you should probably look into creating your own serializer.
319
320=head2 Features different from SOAP::Lite
321
322SOAP::WSDL does not aim to be a complete replacement for SOAP::Lite - the
323SOAP::Lite module has its strengths and weaknesses and SOAP::WSDL is
324designed as a cure for the weakness of little WSDL support - nothing more,
325nothing less.
326
327Nonetheless SOAP::WSDL mimics part of SOAP::Lite's API and behaviour,
328so SOAP::Lite users can switch without looking up every method call in the
329documentation.
330
331A few things are quite different from SOAP::Lite, though:
332
333=head3 SOAP request data
334
335SOAP request data may either be given as message object, or as a hash ref (in
336which case it will automatically be encoded into a message object).
337
338=head3 Return values
339
340The result from call() is not a SOAP::SOM object, but a message object.
341
342Message objects' classes may be generated from WSDL definitions automatically
343- see SOAP::WSDL::Generator::Typelib on how to generate your own WSDL based
344message class library.
345
346=head3 Fault handling
347
348SOAP::WSDL::Client returns a fault object on errors, even on transport layer
349errors.
350
351The fault object is a SOAP1.1 fault object of the following
352C<SOAP::WSDL::SOAP::Typelib::Fault11>.
353
354SOAP::WSDL::SOAP::Typelib::Fault11 objects are false in boolean context, so
355you can just do something like:
356
357 my $result = $soap->call($method, $data);
358
359 if ($result) {
360    # handle result
361 }
362 else {
363    die $result->faultstring();
364 }
365
366=head3 outputxml
367
368SOAP::Lite returns only the content of the SOAP body when outputxml is set
369to true. SOAP::WSDL::Client returns the complete XML response.
370
371=head3 Auto-Dispatching
372
373SOAP::WSDL::Client B<does not> support auto-dispatching.
374
375This is on purpose: You may easily create interface classes by using
376SOAP::WSDL::Client and implementing something like
377
378 sub mySoapMethod {
379     my $self = shift;
380     $soap_wsdl_client->call( mySoapMethod, @_);
381 }
382
383You may even do this in a class factory - see L<wsdl2perl.pl> for creating
384such interfaces.
385
386=head1 TROUBLESHOOTING
387
388=head2 Accessing protected web services
389
390Accessing protected web services is very specific for the transport
391backend used.
392
393In general, you may pass additional arguments to the set_proxy method (or
394a list ref of the web service address and any additional arguments to the
395new method's I<proxy> argument).
396
397Refer to the appropriate transport module for documentation.
398
399=head1 LICENSE AND COPYRIGHT
400
401Copyright 2004-2007 Martin Kutter.
402
403This file is part of SOAP-WSDL. You may distribute/modify it under the same
404terms as perl itself
405
406=head1 AUTHOR
407
408Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
409
410=head1 REPOSITORY INFORMATION
411
412 $Rev: 851 $
413 $LastChangedBy: kutterma $
414 $Id: Client.pm 851 2009-05-15 22:45:18Z kutterma $
415 $HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Client.pm $
416
417=cut
418
419