diff options
Diffstat (limited to 'debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm')
| -rw-r--r-- | debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm | 1258 |
1 files changed, 1258 insertions, 0 deletions
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm new file mode 100644 index 0000000..55d32c8 --- /dev/null +++ b/debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm @@ -0,0 +1,1258 @@ +# Licensed to the Apache Software Foundation (ASF) under one or more +# contributor license agreements. See the NOTICE file distributed with +# this work for additional information regarding copyright ownership. +# The ASF licenses this file to You under the Apache License, Version 2.0 +# (the "License"); you may not use this file except in compliance with +# the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +package Apache::TestRequest; + +use strict; +use warnings FATAL => 'all'; + +BEGIN { + $ENV{PERL_LWP_USE_HTTP_10} = 1; # default to http/1.0 + $ENV{APACHE_TEST_HTTP_09_OK} ||= 0; # 0.9 responses are ok +} + +use Apache::Test (); +use Apache::TestConfig (); + +use Carp; + +use constant TRY_TIMES => 200; +use constant INTERP_KEY => 'X-PerlInterpreter'; +use constant UA_TIMEOUT => 60 * 10; #longer timeout for debugging + +my $have_lwp = 0; + +# APACHE_TEST_PRETEND_NO_LWP=1 pretends that LWP is not available so +# one can test whether the test suite survives if the user doesn't +# have lwp installed +unless ($ENV{APACHE_TEST_PRETEND_NO_LWP}) { + $have_lwp = eval { + require LWP::UserAgent; + require HTTP::Request::Common; + + unless (defined &HTTP::Request::Common::OPTIONS) { + package HTTP::Request::Common; + no strict 'vars'; + *OPTIONS = sub { _simple_req(OPTIONS => @_) }; + push @EXPORT, 'OPTIONS'; + } + 1; + }; +} + +unless ($have_lwp) { + require Apache::TestClient; +} + +sub has_lwp { $have_lwp } + +unless ($have_lwp) { + #need to define the shortcuts even though the wont be used + #so Perl can parse test scripts + @HTTP::Request::Common::EXPORT = qw(GET HEAD POST PUT OPTIONS); +} + +sub install_http11 { + eval { + die "no LWP" unless $have_lwp; + LWP->VERSION(5.60); #minimal version + require LWP::Protocol::http; + #LWP::Protocol::http10 is used by default + LWP::Protocol::implementor('http', 'LWP::Protocol::http'); + }; +} + +use vars qw(@EXPORT @ISA $RedirectOK $DebugLWP); + +require Exporter; +*import = \&Exporter::import; +@EXPORT = @HTTP::Request::Common::EXPORT; + +@ISA = qw(LWP::UserAgent); + +my $UA; +my $REDIR = $have_lwp ? undef : 1; +my $conn_opts = {}; + +sub module { + my $module = shift; + $Apache::TestRequest::Module = $module if $module; + $Apache::TestRequest::Module; +} + +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(@_); + } + + # No LWP. We don't support redirect on POST. + return 0 if $self->method eq 'POST'; + # Return user setting or our internal calculation. + return $RedirectOK if defined $RedirectOK; + return $REDIR; +} + +my %credentials; + +#subclass LWP::UserAgent +sub new { + my $self = shift->SUPER::new(@_); + + lwp_debug(); #init from %ENV (set by Apache::TestRun) + + my $config = Apache::Test::config(); + if (my $proxy = $config->configure_proxy) { + #t/TEST -proxy + $self->proxy(http => "http://$proxy"); + } + + $self->timeout(UA_TIMEOUT); + + $self; +} + +sub credentials { + my $self = shift; + return $self->get_basic_credentials(@_); +} + +sub get_basic_credentials { + my($self, $realm, $uri, $proxy) = @_; + + for ($realm, '__ALL__') { + next unless $_ && $credentials{$_}; + return @{ $credentials{$_} }; + } + + return (undef,undef); +} + +sub vhost_socket { + my $module = shift; + local $Apache::TestRequest::Module = $module if $module; + + my $hostport = hostport(Apache::Test::config()); + + my($host, $port) = split ':', $hostport; + my(%args) = (PeerAddr => $host, PeerPort => $port); + + if ($module and ($module =~ /ssl/ || $module eq 'h2')) { + require IO::Socket::SSL; + # Add all conn_opts to args + map {$args{$_} = $conn_opts->{$_}} keys %{$conn_opts}; + return IO::Socket::SSL->new(%args, Timeout => UA_TIMEOUT); + } + else { + require IO::Socket; + return IO::Socket::INET->new(%args); + } +} + +#IO::Socket::SSL::getline does not correctly handle OpenSSL *_WANT_*. +#Could care less about performance here, just need a getline() +#that returns the same results with or without ssl. +#Inspired from Net::SSLeay::ssl_read_all(). +my %getline = ( + 'IO::Socket::SSL' => sub { + my $self = shift; + # _get_ssl_object in IO::Socket::SSL only meant for internal use! + # But we need to compensate for unsufficient getline impl there. + my $ssl = $self->_get_ssl_object; + my ($got, $rv, $errs); + my $reply = ''; + + while (1) { + ($got, $rv) = Net::SSLeay::read($ssl, 1); + if (! defined $got) { + my $err = Net::SSLeay::get_error($ssl, $rv); + if ($err != Net::SSLeay::ERROR_WANT_READ() and + $err != Net::SSLeay::ERROR_WANT_WRITE()) { + $errs = Net::SSLeay::print_errs('SSL_read'); + last; + } + next; + } + last if $got eq ''; # EOF + $reply .= $got; + last if $got eq "\n"; + } + + wantarray ? ($reply, $errs) : $reply; + }, +); + +sub getline { + my $sock = shift; + my $class = ref $sock; + my $method = $getline{$class} || 'getline'; + $sock->$method(); +} + +sub socket_trace { + my $sock = shift; + return unless $sock->can('get_peer_certificate'); + + #like having some -v info + my $cert = $sock->get_peer_certificate; + print "#Cipher: ", $sock->get_cipher, "\n"; + print "#Peer DN: ", $cert->subject_name, "\n"; +} + +sub prepare { + my $url = shift; + + if ($have_lwp) { + user_agent(); + $url = resolve_url($url); + } + else { + lwp_debug() if $ENV{APACHE_TEST_DEBUG_LWP}; + } + + my($pass, $keep) = Apache::TestConfig::filter_args(\@_, \%wanted_args); + + %credentials = (); + if (defined $keep->{username}) { + $credentials{$keep->{realm} || '__ALL__'} = + [$keep->{username}, $keep->{password}]; + } + if (defined(my $content = $keep->{content})) { + if ($content eq '-') { + $content = join '', <STDIN>; + } + elsif ($content =~ /^x(\d+)$/) { + $content = 'a' x $1; + } + push @$pass, content => $content; + } + if (exists $keep->{cert}) { + set_client_cert($keep->{cert}); + } + + return ($url, $pass, $keep); +} + +sub UPLOAD { + my($url, $pass, $keep) = prepare(@_); + + local $RedirectOK = exists $keep->{redirect_ok} + ? $keep->{redirect_ok} + : $RedirectOK; + + if ($keep->{filename}) { + return upload_file($url, $keep->{filename}, $pass); + } + else { + return upload_string($url, $keep->{content}); + } +} + +sub UPLOAD_BODY { + UPLOAD(@_)->content; +} + +sub UPLOAD_BODY_ASSERT { + content_assert(UPLOAD(@_)); +} + +#lwp only supports files +sub upload_string { + my($url, $data) = @_; + + my $CRLF = "\015\012"; + my $bound = 742617000027; + my $req = HTTP::Request->new(POST => $url); + + my $content = join $CRLF, + "--$bound", + "Content-Disposition: form-data; name=\"HTTPUPLOAD\"; filename=\"b\"", + "Content-Type: text/plain", "", + $data, "--$bound--", ""; + + $req->header("Content-Length", length($content)); + $req->content_type("multipart/form-data; boundary=$bound"); + $req->content($content); + + $UA->request($req); +} + +sub upload_file { + my($url, $file, $args) = @_; + + my $content = [@$args, filename => [$file]]; + + $UA->request(HTTP::Request::Common::POST($url, + Content_Type => 'form-data', + Content => $content, + )); +} + +#useful for POST_HEAD and $DebugLWP (see below) +sub lwp_as_string { + my($r, $want_body) = @_; + my $content = $r->content; + + unless ($r->isa('HTTP::Request') or + $r->header('Content-Length') or + $r->header('Transfer-Encoding')) + { + $r->header('Content-Length' => length $content); + $r->header('X-Content-length-note' => 'added by Apache::TestRequest'); + } + + $r->content('') unless $want_body; + + (my $string = $r->as_string) =~ s/^/\#/mg; + $r->content($content); #reset + $string; +} + +$DebugLWP = 0; #1 == print METHOD URL and header response for all requests + #2 == #1 + response body + #other == passed to LWP::Debug->import + +sub lwp_debug { + package main; #wtf: else package in perldb changes + my $val = $_[0] || $ENV{APACHE_TEST_DEBUG_LWP}; + + return unless $val; + + if ($val =~ /^\d+$/) { + $Apache::TestRequest::DebugLWP = $val; + return "\$Apache::TestRequest::DebugLWP = $val\n"; + } + else { + my(@args) = @_ ? @_ : split /\s+/, $val; + require LWP::Debug; + LWP::Debug->import(@args); + return "LWP::Debug->import(@args)\n"; + } +} + +sub lwp_trace { + my $r = shift; + + unless ($r->request->protocol) { + #lwp always sends a request, but never sets + #$r->request->protocol, happens deeper in the + #LWP::Protocol::http* modules + my $proto = user_agent_request_num($r) ? "1.1" : "1.0"; + $r->request->protocol("HTTP/$proto"); + } + + my $want_body = $DebugLWP > 1; + print "#lwp request:\n", + lwp_as_string($r->request, $want_body); + + print "#server response:\n", + lwp_as_string($r, $want_body); +} + +sub lwp_call { + my($name, $shortcut) = (shift, shift); + + my $r = (\&{$name})->(@_); + + Carp::croak("$name(@_) didn't return a response object") unless $r; + + my $error = ""; + unless ($shortcut) { + #GET, HEAD, POST + if ($r->method eq "POST" && !defined($r->header("Content-Length"))) { + $r->header('Content-Length' => length($r->content)); + } + $r = $UA ? $UA->request($r) : $r; + my $proto = $r->protocol; + if (defined($proto)) { + if ($proto !~ /^HTTP\/(\d\.\d)$/) { + $error = "response had no protocol (is LWP broken or something?)"; + } + if ($1 ne "1.0" && $1 ne "1.1") { + $error = "response had protocol HTTP/$1 (headers not sent?)" + unless ($1 eq "0.9" && $ENV{APACHE_TEST_HTTP_09_OK}); + } + } + } + + if ($DebugLWP and not $shortcut) { + lwp_trace($r); + } + + Carp::croak($error) if $error; + + return $shortcut ? $r->$shortcut() : $r; +} + +my %shortcuts = (RC => sub { shift->code }, + OK => sub { shift->is_success }, + STR => sub { shift->as_string }, + HEAD => sub { lwp_as_string(shift, 0) }, + BODY => sub { shift->content }, + BODY_ASSERT => sub { content_assert(shift) }, +); + +for my $name (@EXPORT) { + my $package = $have_lwp ? + 'HTTP::Request::Common': 'Apache::TestClient'; + + my $method = join '::', $package, $name; + no strict 'refs'; + + next unless defined &$method; + + *$name = sub { + my($url, $pass, $keep) = prepare(@_); + local $RedirectOK = exists $keep->{redirect_ok} + ? $keep->{redirect_ok} + : $RedirectOK; + return lwp_call($method, undef, $url, @$pass); + }; + + while (my($shortcut, $cv) = each %shortcuts) { + my $alias = join '_', $name, $shortcut; + *$alias = sub { lwp_call($name, $cv, @_) }; + } +} + +my @export_std = @EXPORT; +for my $method (@export_std) { + push @EXPORT, map { join '_', $method, $_ } keys %shortcuts; +} + +push @EXPORT, qw(UPLOAD UPLOAD_BODY UPLOAD_BODY_ASSERT); + +sub to_string { + my $obj = shift; + ref($obj) ? $obj->as_string : $obj; +} + +# request an interpreter instance and use this interpreter id to +# select the same interpreter in requests below +sub same_interp_tie { + my($url) = @_; + + my $res = GET($url, INTERP_KEY, 'tie'); + unless ($res->code == 200) { + die sprintf "failed to init the same_handler data (url=%s). " . + "Failed with code=%s, response:\n%s", + $url, $res->code, $res->content; + } + my $same_interp = $res->header(INTERP_KEY); + + return $same_interp; +} + +# run the request though the selected perl interpreter, by polling +# until we found it +# currently supports only GET, HEAD, PUT, POST subs +sub same_interp_do { + my($same_interp, $sub, $url, @args) = @_; + + die "must pass an interpreter id, obtained via same_interp_tie()" + unless defined $same_interp and $same_interp; + + push @args, (INTERP_KEY, $same_interp); + + my $res = ''; + my $times = 0; + my $found_same_interp = ''; + do { + #loop until we get a response from our interpreter instance + $res = $sub->($url, @args); + die "no result" unless $res; + my $code = $res->code; + if ($code == 200) { + $found_same_interp = $res->header(INTERP_KEY) || ''; + } + elsif ($code == 404) { + # try again + } + else { + die sprintf "failed to run the request (url=%s):\n" . + "code=%s, response:\n%s", $url, $code, $res->content; + } + + unless ($found_same_interp eq $same_interp) { + $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"; +} + +1; + +=head1 NAME + +Apache::TestRequest - Send requests to your Apache test server + +=head1 SYNOPSIS + + use Apache::Test qw(ok have_lwp); + use Apache::TestRequest qw(GET POST); + use Apache::Constants qw(HTTP_OK); + + plan tests => 1, have_lwp; + + my $res = GET '/test.html'; + ok $res->code == HTTP_OK, "Request is ok"; + +=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> +parameter: + + my $res = GET $uri, redirect_ok => 0; + +Alternately, if all of your tests need to disable redirects, tell +C<Apache::TestRequest> to use an C<LWP::UserAgent> object that +disables redirects: + + Apache::TestRequest::user_agent( reset => 1, + requests_redirectable => 0 ); + +=item cert + +If you need to force an SSL request to use a particular SSL +certificate, pass the name of the certificate via the C<cert> +parameter: + + my $res = GET $uri, cert => 'my_cert'; + +=item content + +If you need to add content to your request, use the C<content> +parameter: + + my $res = GET $uri, content => 'hello world!'; + +=item filename + +The name of a local file on the file system to be sent to the Apache +test server via C<UPLOAD()> and its friends. + +=back + +=head2 The Functions + +=head3 GET + + my $res = GET $uri; + +Sends a simple GET request to the Apache test server. Returns an +C<HTTP::Response> object. + +You can also supply additional headers to be sent with the request by +adding their name/value pairs after the C<url> parameter, for example: + + my $res = GET $url, 'Accept-Language' => 'de,en-us,en;q=0.5'; + +=head3 GET_STR + +A shortcut function for C<GET($uri)-E<gt>as_string>. + +=head3 GET_BODY + +A shortcut function for C<GET($uri)-E<gt>content>. + +=head3 GET_BODY_ASSERT + +Use this function when your test is outputting content that you need +to check, and you want to make sure that the request was successful +before comparing the contents of the request. If the request was +unsuccessful, C<GET_BODY_ASSERT> will return an error +message. Otherwise it will simply return the content of the request +just as C<GET_BODY> would. + +=head3 GET_OK + +A shortcut function for C<GET($uri)-E<gt>is_success>. + +=head3 GET_RC + +A shortcut function for C<GET($uri)-E<gt>code>. + +=head3 GET_HEAD + +Throws out the content of the request, and returns the string +representation of the request. Since the body has been thrown out, the +representation will consist solely of the headers. Furthermore, +C<GET_HEAD> inserts a "#" at the beginning of each line of the return +string, so that the contents are suitable for printing to STDERR +during your tests without interfering with the workings of +C<Test::Harness>. + +=head3 HEAD + + my $res = HEAD $uri; + +Sends a HEAD request to the Apache test server. Returns an +C<HTTP::Response> object. + +=head3 HEAD_STR + +A shortcut function for C<HEAD($uri)-E<gt>as_string>. + +=head3 HEAD_BODY + +A shortcut function for C<HEAD($uri)-E<gt>content>. Of course, this +means that it will likely return nothing. + +=head3 HEAD_BODY_ASSERT + +Use this function when your test is outputting content that you need +to check, and you want to make sure that the request was successful +before comparing the contents of the request. If the request was +unsuccessful, C<HEAD_BODY_ASSERT> will return an error +message. Otherwise it will simply return the content of the request +just as C<HEAD_BODY> would. + +=head3 HEAD_OK + +A shortcut function for C<GET($uri)-E<gt>is_success>. + +=head3 HEAD_RC + +A shortcut function for C<GET($uri)-E<gt>code>. + +=head3 HEAD_HEAD + +Throws out the content of the request, and returns the string +representation of the request. Since the body has been thrown out, the +representation will consist solely of the headers. Furthermore, +C<GET_HEAD> inserts a "#" at the beginning of each line of the return +string, so that the contents are suitable for printing to STDERR +during your tests without interfering with the workings of +C<Test::Harness>. + +=head3 PUT + + my $res = PUT $uri; + +Sends a simple PUT request to the Apache test server. Returns an +C<HTTP::Response> object. + +=head3 PUT_STR + +A shortcut function for C<PUT($uri)-E<gt>as_string>. + +=head3 PUT_BODY + +A shortcut function for C<PUT($uri)-E<gt>content>. + +=head3 PUT_BODY_ASSERT + +Use this function when your test is outputting content that you need +to check, and you want to make sure that the request was successful +before comparing the contents of the request. If the request was +unsuccessful, C<PUT_BODY_ASSERT> will return an error +message. Otherwise it will simply return the content of the request +just as C<PUT_BODY> would. + +=head3 PUT_OK + +A shortcut function for C<PUT($uri)-E<gt>is_success>. + +=head3 PUT_RC + +A shortcut function for C<PUT($uri)-E<gt>code>. + +=head3 PUT_HEAD + +Throws out the content of the request, and returns the string +representation of the request. Since the body has been thrown out, the +representation will consist solely of the headers. Furthermore, +C<PUT_HEAD> inserts a "#" at the beginning of each line of the return +string, so that the contents are suitable for printing to STDERR +during your tests without interfering with the workings of +C<Test::Harness>. + +=head3 POST + + my $res = POST $uri, [ arg => $val, arg2 => $val ]; + +Sends a POST request to the Apache test server and returns an +C<HTTP::Response> object. An array reference of parameters passed as +the second argument will be submitted to the Apache test server as the +POST content. Parameters corresponding to those documented in +L<Optional Parameters|/Optional +Parameters> can follow the optional array reference of parameters, or after +C<$uri>. + +To upload a chunk of data, simply use: + + my $res = POST $uri, content => $data; + +=head3 POST_STR + +A shortcut function for C<POST($uri, @args)-E<gt>content>. + +=head3 POST_BODY + +A shortcut function for C<POST($uri, @args)-E<gt>content>. + +=head3 POST_BODY_ASSERT + +Use this function when your test is outputting content that you need +to check, and you want to make sure that the request was successful +before comparing the contents of the request. If the request was +unsuccessful, C<POST_BODY_ASSERT> will return an error +message. Otherwise it will simply return the content of the request +just as C<POST_BODY> would. + +=head3 POST_OK + +A shortcut function for C<POST($uri, @args)-E<gt>is_success>. + +=head3 POST_RC + +A shortcut function for C<POST($uri, @args)-E<gt>code>. + +=head3 POST_HEAD + +Throws out the content of the request, and returns the string +representation of the request. Since the body has been thrown out, the +representation will consist solely of the headers. Furthermore, +C<POST_HEAD> inserts a "#" at the beginning of each line of the return +string, so that the contents are suitable for printing to STDERR +during your tests without interfering with the workings of +C<Test::Harness>. + +=head3 UPLOAD + + my $res = UPLOAD $uri, \@args, filename => $filename; + +Sends a request to the Apache test server that includes an uploaded +file. Other POST parameters can be passed as a second argument as an +array reference. + +C<Apache::TestRequest> will read in the contents of the file named via +the C<filename> parameter for submission to the server. If you'd +rather, you can submit use the C<content> parameter instead of +C<filename>, and its value will be submitted to the Apache server as +file contents: + + my $res = UPLOAD $uri, undef, content => "This is file content"; + +The name of the file sent to the server will simply be "b". Note that +in this case, you cannot pass other POST arguments to C<UPLOAD()> -- +they would be ignored. + +=head3 UPLOAD_BODY + +A shortcut function for C<UPLOAD($uri, @params)-E<gt>content>. + +=head3 UPLOAD_BODY_ASSERT + +Use this function when your test is outputting content that you need +to check, and you want to make sure that the request was successful +before comparing the contents of the request. If the request was +unsuccessful, C<UPLOAD_BODY_ASSERT> will return an error +message. Otherwise it will simply return the content of the request +just as C<UPLOAD_BODY> would. + +=head3 OPTIONS + + my $res = OPTIONS $uri; + +Sends an C<OPTIONS> request to the Apache test server. Returns an +C<HTTP::Response> object with the I<Allow> header, indicating which +methods the server supports. Possible methods include C<OPTIONS>, +C<GET>, C<HEAD> and C<POST>. This function thus can be useful for +testing what options the Apache server supports. Consult the HTTPD 1.1 +specification, section 9.2, at +I<http://www.faqs.org/rfcs/rfc2616.html> for more information. + + + + + +=head2 URL Manipulation Functions + +C<Apache::TestRequest> also includes a few helper functions to aid in +the creation of urls used in the functions above. + + + +=head3 C<module2path> + + $path = Apache::TestRequest::module2path($module_name); + +Convert a module name to a path, safe for use in the various request +methods above. e.g. C<::> can't be used in URLs on win32. For example: + + $path = Apache::TestRequest::module2path('Foo::Bar'); + +returns: + + /Foo__Bar + + + + +=head3 C<module2url> + + $url = Apache::TestRequest::module2url($module); + $url = Apache::TestRequest::module2url($module, \%options); + +Convert a module name to a full URL including the current +configurations C<hostname:port> and sets C<module> accordingly. + + $url = Apache::TestRequest::module2url('Foo::Bar'); + +returns: + + http://$hostname:$port/Foo__Bar + +The default scheme used is C<http>. You can override this by passing +your preferred scheme into an optional second param. For example: + + $module = 'MyTestModule::TestHandler'; + $url = Apache::TestRequest::module2url($module, {scheme => 'https'}); + +returns: + + https://$hostname:$port/MyTestModule__TestHandler + +You may also override the default path with a path of your own: + + $module = 'MyTestModule::TestHandler'; + $url = Apache::TestRequest::module2url($module, {path => '/foo'}); + +returns: + + http://$hostname:$port/foo + + + + + +=head1 ENVIRONMENT VARIABLES + +The following environment variables can affect the behavior of +C<Apache::TestRequest>: + +=over + +=item APACHE_TEST_PRETEND_NO_LWP + +If the environment variable C<APACHE_TEST_PRETEND_NO_LWP> is set to a +true value, C<Apache::TestRequest> will pretend that LWP is not +available so one can test whether the test suite will survive on a +system which doesn't have libwww-perl installed. + +=item APACHE_TEST_HTTP_09_OK + +If the environment variable C<APACHE_TEST_HTTP_09_OK> is set to a +true value, C<Apache::TestRequest> will allow HTTP/0.9 responses +from the server to proceed. The default behavior is to die if +the response protocol is not either HTTP/1.0 or HTTP/1.1. + +=back + +=head1 SEE ALSO + +L<Apache::Test|Apache::Test> is the main Apache testing module. Use it +to set up your tests, create a plan, and to ensure that you have the +Apache version and modules you need. + +Use L<Apache::TestMM|Apache::TestMM> in your I<Makefile.PL> to set up +your distribution for testing. + +=head1 AUTHOR + +Doug MacEachern with contributions from Geoffrey Young, Philippe +M. Chiasson, Stas Bekman and others. Documentation by David Wheeler. + +Questions can be asked at the test-dev <at> httpd.apache.org list. For +more information see: I<http://httpd.apache.org/test/> and +I<http://perl.apache.org/docs/general/testing/testing.html>. |