view release on metacpan or  search on metacpan

lib/W3C/SOAP/Client.pm  view on Meta::CPAN

package W3C::SOAP::Client;

# Created on: 2012-05-28 07:40:20
# Create by:  Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use Moose;
use warnings;
use Carp qw/carp croak cluck confess longmess/;
use Scalar::Util;
use List::Util;
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use LWP::UserAgent;
use Try::Tiny;
use XML::LibXML;
use W3C::SOAP::Exception;
use W3C::SOAP::Header;
use Moose::Util::TypeConstraints qw/duck_type/;

extends 'W3C::SOAP::Base';

our $VERSION = 0.14;
our $DEBUG_REQUEST_RESPONSE = $ENV{W3C_SOAP_DEBUG_CLIENT};

has location => (
    is       => 'rw',
    isa      => 'Str',
    required => 1,
);
has mech => (
    is        => 'rw',
    predicate => 'has_mech',
    init_arg  => 0,
);
has ua => (
    is       => 'rw',
    isa      => 'LWP::UserAgent',
    builder  => '_ua',
    required => 1,
    lazy     => 1,
);
has response => (
    is      => 'rw',
    isa     => 'HTTP::Response',
    clearer => 'clear_response',
);
has log => (
    is        => 'rw',
    isa       => duck_type([qw/ debug info warn error fatal /]),
    predicate => 'has_log',
    clearer   => 'clear_log',
);
has content_type => (
    is      => 'rw',
    isa     => 'Str',
    default => 'text/xml;charset=UTF-8',
);

sub post {
    my ($self, $action, $xml) = @_;
    my $url = $self->location;

    cluck "The mech attribute has been deprecated and is replaced by ua attribute!"
        if $self->has_mech;

    $self->clear_response;
    my $response = $self->ua->post(
        $url,
        'Content-Type'     => $self->content_type,
        'SOAPAction'       => qq{"$action"},
        'Proxy-Connection' => 'Keep-Alive',
        'Accept-Encoding'  => 'gzip, deflate',
        Content            => $xml->toString,
    );
    $self->response($response);

    return $response->decoded_content;