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';
}