Apache-Test
view release on metacpan or search on metacpan
lib/Apache/TestRequest.pm view on Meta::CPAN
}
sub scheme {
my $scheme = shift;
$Apache::TestRequest::Scheme = $scheme if $scheme;
$Apache::TestRequest::Scheme;
}
sub module2path {
my $package = shift;
# httpd (1.3 && 2) / winFU have problems when the first path's
# segment includes ':' (security precaution which breaks the rfc)
# so we can't use /TestFoo::bar as path_info
(my $path = $package) =~ s/::/__/g;
return $path;
}
sub module2url {
my $module = shift;
my $opt = shift || {};
my $scheme = $opt->{scheme} || 'http';
my $path = exists $opt->{path} ? $opt->{path} : module2path($module);
module($module);
my $config = Apache::Test::config();
my $hostport = hostport($config);
$path =~ s|^/||;
return "$scheme://$hostport/$path";
}
sub user_agent {
my $args = {@_};
if (delete $args->{reset}) {
$UA = undef;
}
if (exists $args->{requests_redirectable}) {
my $redir = $args->{requests_redirectable};
if (ref $redir and (@$redir > 1 or $redir->[0] ne 'POST')) {
# Set our internal flag if there's no LWP.
$REDIR = $have_lwp ? undef : 1;
} elsif ($redir) {
if ($have_lwp) {
$args->{requests_redirectable} = [ qw/GET HEAD POST/ ];
$REDIR = undef;
} else {
# Set our internal flag.
$REDIR = 1;
}
} else {
# Make sure our internal flag is false if there's no LWP.
$REDIR = $have_lwp ? undef : 0;
}
}
$args->{keep_alive} ||= $ENV{APACHE_TEST_HTTP11};
if ($args->{keep_alive}) {
install_http11();
eval {
require LWP::Protocol::https; #https10 is the default
LWP::Protocol::implementor('https', 'LWP::Protocol::https');
};
}
# in LWP 6, verify_hostname defaults to on, so SSL_ca_file
# needs to be set accordingly
if ($have_lwp and $LWP::VERSION >= 6.0 and not exists $args->{ssl_opts}->{SSL_ca_file}) {
my $vars = Apache::Test::vars();
my $cafile = "$vars->{sslca}/$vars->{sslcaorg}/certs/ca.crt";
$args->{ssl_opts}->{SSL_ca_file} = $cafile;
# IO::Socket:SSL raw socket compatibility
$conn_opts->{SSL_ca_file} = $cafile;
}
eval { $UA ||= __PACKAGE__->new(%$args); };
}
sub user_agent_request_num {
my $res = shift;
$res->header('Client-Request-Num') || #lwp 5.60
$res->header('Client-Response-Num'); #lwp 5.62+
}
sub user_agent_keepalive {
$ENV{APACHE_TEST_HTTP11} = shift;
}
sub do_request {
my($ua, $method, $url, $callback) = @_;
my $r = HTTP::Request->new($method, resolve_url($url));
my $response = $ua->request($r, $callback);
lwp_trace($response);
}
sub hostport {
my $config = shift || Apache::Test::config();
my $vars = $config->{vars};
local $vars->{scheme} =
$Apache::TestRequest::Scheme || $vars->{scheme};
my $hostport = $config->hostport;
my $default_hostport = join ':', $vars->{servername}, $vars->{port};
if (my $module = $Apache::TestRequest::Module) {
$hostport = $module eq 'default'
? $default_hostport
: $config->{vhosts}->{$module}->{hostport};
}
$hostport || $default_hostport;
}
sub resolve_url {
my $url = shift;
Carp::croak("no url passed") unless defined $url;
return $url if $url =~ m,^(\w+):/,;
$url = "/$url" unless $url =~ m,^/,;
my $vars = Apache::Test::vars();
local $vars->{scheme} =
$Apache::TestRequest::Scheme || $vars->{scheme} || 'http';
scheme_fixup($vars->{scheme});
my $hostport = hostport();
return "$vars->{scheme}://$hostport$url";
}
my %wanted_args = map {$_, 1} qw(username password realm content filename
redirect_ok cert);
sub wanted_args {
\%wanted_args;
}
sub redirect_ok {
my $self = shift;
if ($have_lwp) {
# Return user setting or let LWP handle it.
return $RedirectOK if defined $RedirectOK;
return $self->SUPER::redirect_ok(@_);
}
lib/Apache/TestRequest.pm view on Meta::CPAN
$found_same_interp = '';
}
if ($times++ > TRY_TIMES) { #prevent endless loop
die "unable to find interp $same_interp\n";
}
} until ($found_same_interp);
return $found_same_interp ? $res : undef;
}
sub set_client_cert {
my $name = shift;
my $vars = Apache::Test::vars();
my $dir = join '/', $vars->{sslca}, $vars->{sslcaorg};
if ($name) {
my ($cert, $key) = ("$dir/certs/$name.crt", "$dir/keys/$name.pem");
# IO::Socket:SSL raw socket compatibility
$conn_opts->{SSL_cert_file} = $cert;
$conn_opts->{SSL_key_file} = $key;
if ($LWP::VERSION >= 6.0) {
# IO::Socket:SSL doesn't look at environment variables
if ($UA) {
$UA->ssl_opts(SSL_cert_file => $cert);
$UA->ssl_opts(SSL_key_file => $key);
} else {
user_agent(ssl_opts => { SSL_cert_file => $cert,
SSL_key_file => $key });
}
}
}
else {
# IO::Socket:SSL raw socket compatibility
$conn_opts->{SSL_cert_file} = undef;
$conn_opts->{SSL_key_file} = undef;
if ($LWP::VERSION >= 6.0 and $UA) {
$UA->ssl_opts(SSL_cert_file => undef);
$UA->ssl_opts(SSL_key_file => undef);
}
}
}
# Only for IO::Socket:SSL raw socket compatibility,
# when using user_agent() already done in its
# constructor.
sub set_ca_cert {
my $vars = Apache::Test::vars();
my $cafile = "$vars->{sslca}/$vars->{sslcaorg}/certs/ca.crt";
$conn_opts->{SSL_ca_file} = $cafile;
}
#want news: urls to work with the LWP shortcuts
#but cant find a clean way to override the default nntp port
#by brute force we trick Net::NTTP into calling FixupNNTP::new
#instead of IO::Socket::INET::new, we fixup the args then forward
#to IO::Socket::INET::new
#also want KeepAlive on for Net::HTTP
#XXX libwww-perl 5.53_xx has: LWP::UserAgent->new(keep_alive => 1);
sub install_net_socket_new {
my($module, $code) = @_;
return unless Apache::Test::have_module($module);
no strict 'refs';
my $new;
my $isa = \@{"$module\::ISA"};
for (@$isa) {
last if $new = $_->can('new');
}
my $fixup_class = "Apache::TestRequest::$module";
unshift @$isa, $fixup_class;
*{"$fixup_class\::new"} = sub {
my $class = shift;
my $args = {@_};
$code->($args);
return $new->($class, %$args);
};
}
my %scheme_fixups = (
'news' => sub {
return if $INC{'Net/NNTP.pm'};
eval {
install_net_socket_new('Net::NNTP' => sub {
my $args = shift;
my($host, $port) = split ':',
Apache::TestRequest::hostport();
$args->{PeerPort} = $port;
$args->{PeerAddr} = $host;
});
};
},
);
sub scheme_fixup {
my $scheme = shift;
my $fixup = $scheme_fixups{$scheme};
return unless $fixup;
$fixup->();
}
# when the client side simply prints the response body which should
# include the test's output, we need to make sure that the request
# hasn't failed, or the test will be skipped instead of indicating the
# error.
sub content_assert {
my $res = shift;
return $res->content if $res->is_success;
die join "\n",
"request has failed (the response code was: " . $res->code . ")",
"see t/logs/error_log for more details\n";
lib/Apache/TestRequest.pm view on Meta::CPAN
=head1 DESCRIPTION
B<Apache::TestRequest> provides convenience functions to allow you to
make requests to your Apache test server in your test scripts. It
subclasses C<LWP::UserAgent>, so that you have access to all if its
methods, but also exports a number of useful functions likely useful
for majority of your test requests. Users of the old C<Apache::test>
(or C<Apache::testold>) module, take note! Herein lie most of the
functions you'll need to use to replace C<Apache::test> in your test
suites.
Each of the functions exported by C<Apache::TestRequest> uses an
C<LWP::UserAgent> object to submit the request and retrieve its
results. The return value for many of these functions is an
HTTP::Response object. See L<HTTP::Response|HTTP::Response> for
documentation of its methods, which you can use in your tests. For
example, use the C<code()> and C<content()> methods to test the
response code and content of your request. Using C<GET>, you can
perform a couple of tests using these methods like this:
use Apache::Test qw(ok have_lwp);
use Apache::TestRequest qw(GET POST);
use Apache::Constants qw(HTTP_OK);
plan tests => 2, have_lwp;
my $uri = "/test.html?foo=1&bar=2";
my $res = GET $uri;
ok $res->code == HTTP_OK, "Check that the request was OK";
ok $res->content eq "foo => 1, bar => 2", "Check its content";
Note that you can also use C<Apache::TestRequest> with
C<Test::Builder> and its derivatives, including C<Test::More>:
use Test::More;
# ...
is $res->code, HTTP_OK, "Check that the request was OK";
is $res->content, "foo => 1, bar => 2", "Check its content";
=head1 CONFIGURATION FUNCTION
You can tell C<Apache::TestRequest> what kind of C<LWP::UserAgent>
object to use for its convenience functions with C<user_agent()>. This
function uses its arguments to construct an internal global
C<LWP::UserAgent> object that will be used for all subsequent requests
made by the convenience functions. The arguments it takes are the same
as for the C<LWP::UserAgent> constructor. See the
C<L<LWP::UserAgent|LWP::UserAgent>> documentation for a complete list.
The C<user_agent()> function only creates the internal
C<LWP::UserAgent> object the first time it is called. Since this
function is called internally by C<Apache::TestRequest>, you should
always use the C<reset> parameter to force it to create a new global
C<LWP::UserAgent> Object:
Apache::TestRequest::user_agent(reset => 1, %params);
C<user_agent()> differs from C<< LWP::UserAgent->new >> in two
additional ways. First, it supports an additional parameter,
C<keep_alive>, which enables connection persistence, where the same
connection is used to process multiple requests (and, according to the
C<L<LWP::UserAgent|LWP::UserAgent>> documentation, has the effect of
loading and enabling the new experimental HTTP/1.1 protocol module).
And finally, the semantics of the C<requests_redirectable> parameter is
different than for C<LWP::UserAgent> in that you can pass it a boolean
value as well as an array for C<LWP::UserAgent>. To force
C<Apache::TestRequest> not to follow redirects in any of its convenience
functions, pass a false value to C<requests_redirectable>:
Apache::TestRequest::user_agent(reset => 1,
requests_redirectable => 0);
If LWP is not installed, then you can still pass in an array reference
as C<LWP::UserAgent> expects. C<Apache::TestRequest> will examine the
array and allow redirects if the array contains more than one value or
if there is only one value and that value is not "POST":
# Always allow redirection.
my $redir = have_lwp() ? [qw(GET HEAD POST)] : 1;
Apache::TestRequest::user_agent(reset => 1,
requests_redirectable => $redir);
But note that redirection will B<not> work with C<POST> unless LWP is
installed. It's best, therefore, to check C<have_lwp> before running
tests that rely on a redirection from C<POST>.
Sometimes it is desireable to have C<Apache::TestRequest> remember
cookies sent by the pages you are testing and send them back to the
server on subsequent requests. This is especially necessary when
testing pages whose functionality relies on sessions or the presence
of preferences stored in cookies.
By default, C<LWP::UserAgent> does B<not> remember cookies between
requests. You can tell it to remember cookies between request by
adding:
Apache::TestRequest::user_agent(cookie_jar => {});
before issuing the requests.
=head1 FUNCTIONS
C<Apache::TestRequest> exports a number of functions that will likely
prove convenient for use in the majority of your request tests.
=head2 Optional Parameters
Each function also takes a number of optional arguments.
=over 4
=item redirect_ok
By default a request will follow redirects retrieved from the server. To
prevent this behavior, pass a false value to a C<redirect_ok>
( run in 1.091 second using v1.01-cache-2.11-cpan-df04353d9ac )