package Mojo::SOAP::Client;


=begin markdown


=end markdown

=head1 NAME

Mojo::SOAP::Client - Talk to SOAP Services mojo style


  use Mojo::SOAP::Client;
  use Mojo::File qw(curfile);
  my $client = Mojo::SOAP::Client->new(
      wsdl => curfile->sibling('fancy.wsdl'),
      xsds => [ curfile->sibling('fancy.xsd')],
      port => 'FancyPort'

      color => 'green'
  })->then(sub { 
      my $answer = shift;
      my $trace = shift;


The Mojo::SOAP::Client is based on the L<XML::Compile::SOAP>
family of packages, and especially on L<XML::Compile::SOAP::Mojolicious>.


use Mojo::Base -base, -signatures;

use Mojo::Promise;
use XML::Compile::WSDL11;      # use WSDL version 1.1
use XML::Compile::SOAP11;      # use SOAP version 1.1
use XML::Compile::SOAP12;
use XML::Compile::Transport::SOAPHTTP_MojoUA;
use HTTP::Headers;
use File::Basename qw(dirname);
use Mojo::Util qw(b64_encode dumper);
use Mojo::Log;
use Carp;

our $VERSION = '0.1.8';

=head2 Properties

The module provides the following properties to customize its behavior. Note that setting any properties AFTER using the C<call> or C<call_p> methods, will lead to undefined behavior.

=head3 log

a pointer to a L<Mojo::Log> instance


has log => sub ($self) {

=head3 request_timeout

How many seconds to wait for the soap server to respond. Defaults to 5 seconds.


has request_timeout => 5;

=head3 insecure

Set this to allow communication with a soap server that uses a 
self-signed or otherwhise invalid certificate.


has insecure => 0;

=head3 wsdl

Where to load the wsdl file from. At the moment this MUST be a file.


has 'wsdl' => sub ($self) {
    croak "path to wsdl spec file must be provided in wsdl property";

=head3 xsds

A pointer to an array of xsd files to load for this service.


has 'xsds' => sub ($self) {

=head3 port

If the wsdl file defines multiple ports, pick the one to use here.


has 'port';

=head3 endPoint

The endPoint to talk to for reaching the SOAP service. This information
is normally encoded in the WSDL file, so you will not have to set this


has 'endPoint' => sub ($self) {
        $self->port ? ( port => $self->port) : ()

=head3 ca

The CA cert of the service. Only for special applications.


has 'ca';

=head3 cert

The client certificate to use when connecting to the soap service.


has 'cert';

=head3 key

The key matching the client cert.


has 'key';
has 'ua';

has wsdlCompiler => sub ($self) {
    my $wc = XML::Compile::WSDL11->new($self->wsdl);
    for my $xsd ( @{$self->xsds}) {
    return $wc;

has httpUa => sub ($self) {
        address => $self->endPoint,
        mojo_ua => $self->ua,
        ua_start_callback => sub ($ua,$tx) {
                if $self->ca;
                if $self->cert;
                if $self->key;
                if $self->request_timeout;
                if $self->insecure;

=head3 uaProperties

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.

  my $client = Mojo::SOAP::Client->new(
      uaProperties => {
          header => HTTP::Headers->new(
             Authorization => 'Basic '. b64_encode("$user:$password","")


has uaProperties => sub {

has transport => sub ($self) {

has clients => sub ($self) {
    return {};

=head2 Methods

The module provides the following methods.

=head3 call_p($operation,$params)

Call a SOAP operation with parameters and return a L<Mojo::Promise>.

    query => {
        detailLevels => {
            credentialDetailLevel => 'LOW',
            userDetailLevel => 'MEDIUM',
            userDetailLevel => 'LOW',
            defaultDetailLevel => 'EXCLUDE'
        user => {
            loginId => 'aakeret'
        numRecords => 100,
        skipRecords => 0,
 })->then(sub ($anwser,$trace) {
     print Dumper $answer


sub call_p ($self,$operation,$params={}) {
    my $clients = $self->clients;
    my $call = $clients->{$operation} //= $self->wsdlCompiler->compileClient(
        operation => $operation,
        transport => $self->transport,
        async => 1,
        # oddly repetitive, the port is mentioned in the endPoint
        # selection as well as here ... 
        ( $self->port ? ( port => $self->port ) : () ),
    $self->log->debug(__PACKAGE__ . " $operation called");
    return Mojo::Promise->new(sub ($resolve,$reject) {
            _callback => sub ($answer,$trace,@rest) {
                my $res = $trace->response;
                my $client_warning =
                return $reject->($client_warning."\n".$self->trace_to_string($trace))
                    if $client_warning;
                if (not $res->is_success) {
                    if (my $f = $answer->{Fault}){
                        $self->log->error(__PACKAGE__ . " $operation - ".$f->{_NAME} .": ". $f->{faultstring});
                        return $reject->($f->{faultstring}."\n".$self->trace_to_string($trace));
                    return $reject->($self->endPoint.' - '.$res->code.' '.$res->message."\n".$self->trace_to_string($trace))
                # $self->log->debug(__PACKAGE__ . " $operation completed - ".dumper($answer));
                return $resolve->($answer,$trace);

sub trace_to_string ($self,$trace) {
    my $ret;
    open my $fh, '>', \$ret;
    print $fh "\nRequest:\n";
    print $fh "\nResponse:\n";
    print $fh "\n";
    close $fh;
    return $ret;

=head3 call($operation,$paramHash)

The same as C<call_p> but for syncronos applications. If there is a problem with the call it will raise a Mojo::SOAP::Exception which is a L<Mojo::Exception> child.


sub call ($self,$operation,$params) {
    my ($ret,$err);
        ->then(sub { $ret = shift })
        ->catch(sub { $err = shift })
    Mojo::SOAP::Exception->throw($err) if $err;
    return $ret;

package Mojo::SOAP::Exception {
  use Mojo::Base 'Mojo::Exception';



This is really just a very thin layer on top of Mark Overmeers great L<XML::Compile::SOAP> module. Thanks Mark!

=head1 AUTHOR

S<Tobias Oetiker, E<lt>tobi@oetiker.chE<gt>>



=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10 or,
at your option, any later version of Perl 5 you may have available.