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