The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 10;

use Protocol::XMLRPC::Client;

Protocol::XMLRPC::Client->new(
    http_req_cb        => sub       { $_[-1]->($_[0], 500, {}, '') })->call(
    'http://empty.com' => 'foo.bar' => sub {
    },
    sub {
        my $self = shift;

        ok($self);
    }
    );

Protocol::XMLRPC::Client->new(
    http_req_cb        => sub       { $_[-1]->($_[0], 500, {}, '') })->call(
    'http://empty.com' => 'foo.bar' => sub {
        is(scalar @_, 1);
    }
    );

Protocol::XMLRPC::Client->new(
    http_req_cb => sub {
        my ($self, $url, $method, $headers, $body, $cb) = @_;

        is($body,
            '<?xml version="1.0"?><methodCall><methodName>foo.bar</methodName><params></params></methodCall>'
        );
        is($headers->{'Host'}, 'empty.com');

        $cb->(
            $self, 200, {},
            '<?xml version="1.0"?><methodResponse><params><param><value>FooBar</value></param></params></methodResponse>'
        );
    }
  )->call(
    'http://empty.com/foo/bar' => 'foo.bar' => sub {
        my ($self, $method_response) = @_;

        ok($method_response);
    }
  );

Protocol::XMLRPC::Client->new(
    http_req_cb => sub {
        my ($self, $url, $method, $headers, $body, $cb) = @_;

        $cb->($self, 400, {}, '');
    }
  )->call(
    '' => 'foo.bar' => sub {
    },
    sub {
        ok($_[0]);
    }
  );

Protocol::XMLRPC::Client->new(
    http_req_cb => sub {
        is($_[4],
            '<?xml version="1.0"?><methodCall><methodName>foo.bar</methodName><params><param><value><i4>1</i4></value></param></params></methodCall>'
        );
    }
)->call('' => 'foo.bar' => [1] => sub { });

Protocol::XMLRPC::Client->new(
    http_req_cb => sub {
        is($_[4],
            '<?xml version="1.0"?><methodCall><methodName>foo.bar</methodName><params><param><value><string>1</string></value></param></params></methodCall>'
        );
    }
  )
  ->call(
    '' => 'foo.bar' => [Protocol::XMLRPC::Value::String->new(1)] => sub { });

Protocol::XMLRPC::Client->new(
    http_req_cb => sub {
        is($_[4],
            '<?xml version="1.0"?><methodCall><methodName>foo.bar</methodName><params><param><value><array><data><value><string>1</string></value></data></array></value></param></params></methodCall>'
        );
    }
  )
  ->call(
    '' => 'foo.bar' => [[Protocol::XMLRPC::Value::String->new(1)]] => sub { }
  );

Protocol::XMLRPC::Client->new(
    http_req_cb => sub {
        is($_[4],
            '<?xml version="1.0"?><methodCall><methodName>foo.bar</methodName><params><param><value><struct><member><name>foo</name><value><string>bar</string></value></member></struct></value></param></params></methodCall>'
        );
    }
)->call('' => 'foo.bar' => [{foo => 'bar'}] => sub { });