The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use Test::More qw(no_plan);
use_ok qw(SOAP::Transport::HTTP);

# Try mocking LWP::UserAgent to simulate sending something over the wire.
# Skip if we don't have Test::MockObject.
SKIP: {
    eval "require Test::MockObject"
        or skip "Cannot simulate transport layer without Test::MockObject", 3;

    require HTTP::Response;

    my $mock = Test::MockObject->new();
    $mock->fake_module( 'LWP::UserAgent',
        'new' => sub { return bless {}, $_[0] },
        'agent' => sub {
            return $_[1]
                ? $_[0]->{ agent } = $_[1]
                : $_[0]->{ agent }
        },
        # TODO return something meaningful
        'request' => sub {
            return HTTP::Response->new(200, '200 OK');
        },
    );
    my $client;
    ok $client = SOAP::Transport::HTTP::Client->new();
    $client->send_receive(endpoint => 'http://example.org',
		envelope => '');
    is $client->code(), '200';
    is $client->message(), '200 OK';
}

# client
my $client;
ok $client = SOAP::Transport::HTTP::Client->new(), 'SOAP::Transport::HTTP::Client->new()';

# just use twice to avoid warning
undef $SOAP::Constants::PATCH_HTTP_KEEPALIVE;
undef $SOAP::Constants::PATCH_HTTP_KEEPALIVE;
ok $client = SOAP::Transport::HTTP::Client->new(), 'SOAP::Transport::HTTP::Client->new() - PATCH_KEEPALIVE = undef';

is $client, $client->new(), '$client->new() returns $client';

is $client->http_request('foo'), $client;
is $client->http_request(), 'foo';

is $client->http_response('foo'), $client;
is $client->http_response(), 'foo';
undef $client;

# package SOAP::Transport::HTTP::Server;
my $server;
ok $server = SOAP::Transport::HTTP::Server->new(), 'SOAP::Transport::HTTP::Server->new()';
isa_ok $server, 'SOAP::Transport::HTTP::Server';
isa_ok $server, 'SOAP::Server';
is $server, $server->new(), '$server->new() returns $server';

like $server->product_tokens(), qr{SOAP::Lite}x;

test_make_fault($server);

undef $server;

# package SOAP::Transport::HTTP::CGI;

ok $server = SOAP::Transport::HTTP::CGI->new();
isa_ok $server, 'SOAP::Transport::HTTP::Server';
isa_ok $server, 'SOAP::Server';

test_make_fault($server);

# package SOAP::Transport::HTTP::Daemon
my $transport;

ok $transport = SOAP::Transport::HTTP::Daemon->new(), 'SOAP::Transport::HTTP::Daemon->new()';
is $transport, $transport->new(), '$transport->new() is $transport';
is $transport->SSL(1), $transport;
is $transport->SSL(), 1;
is $transport->http_daemon_class(), 'HTTP::Daemon::SSL';
is $transport->SSL(0), $transport;
is $transport->SSL(), 0;
is $transport->http_daemon_class(), 'HTTP::Daemon';

undef $transport;

# package SOAP::Transport::HTTP::Apache is untestable under mod_perl 1.x
# due to missing exports in Apache::Constant

SKIP: {
    eval "require FCGI;"
        or skip "Can't test without FCGI", 1;

    # package SOAP::Transport::HTTP::FCGI
    ok $transport = SOAP::Transport::HTTP::FCGI->new(), 'SOAP::Transport::HTTP::FCGI->new()';
    undef $transport;

}


sub test_make_fault {
    my $server = shift;
    # try creating a fault
    my $request = HTTP::Request->new();
    is $server->request($request), $server, '$server->request($request)';
    is $server->request(), $request, '$server->request()';
    $server->make_fault();
    is $server->response()->code(), 500, 'fault response code is 500';
    like $server->response->content(), qr{\bFault\b}x, 'Fault content';
}