home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / TestRequest.pm < prev    next >
Encoding:
Perl POD Document  |  2003-11-12  |  29.2 KB  |  1,028 lines
  1. package Apache::TestRequest;
  2.  
  3. use strict;
  4. use warnings FATAL => 'all';
  5.  
  6. BEGIN { $ENV{PERL_LWP_USE_HTTP_10} = 1; } #default to http/1.0
  7.  
  8. use Apache::Test ();
  9. use Apache::TestConfig ();
  10.  
  11. use Carp;
  12.  
  13. use constant TRY_TIMES => 200;
  14. use constant INTERP_KEY => 'X-PerlInterpreter';
  15. use constant UA_TIMEOUT => 60 * 10; #longer timeout for debugging
  16.  
  17. my $have_lwp = 0;
  18.  
  19. # APACHE_TEST_PRETEND_NO_LWP=1 pretends that LWP is not available so
  20. # one can test whether the test suite survives if the user doesn't
  21. # have lwp installed
  22. unless ($ENV{APACHE_TEST_PRETEND_NO_LWP}) {
  23.     $have_lwp = eval {
  24.         require LWP::UserAgent;
  25.         require HTTP::Request::Common;
  26.  
  27.         unless (defined &HTTP::Request::Common::OPTIONS) {
  28.             package HTTP::Request::Common;
  29.             no strict 'vars';
  30.             *OPTIONS = sub { _simple_req(OPTIONS => @_) };
  31.             push @EXPORT, 'OPTIONS';
  32.         }
  33.     };
  34. }
  35.  
  36. unless ($have_lwp) {
  37.     require Apache::TestClient;
  38. }
  39.  
  40. sub has_lwp { $have_lwp }
  41.  
  42. unless ($have_lwp) {
  43.     #need to define the shortcuts even though the wont be used
  44.     #so Perl can parse test scripts
  45.     @HTTP::Request::Common::EXPORT = qw(GET HEAD POST PUT OPTIONS);
  46. }
  47.  
  48. sub install_http11 {
  49.     eval {
  50.         die "no LWP" unless $have_lwp;
  51.         LWP->VERSION(5.60); #minimal version
  52.         require LWP::Protocol::http;
  53.         #LWP::Protocol::http10 is used by default
  54.         LWP::Protocol::implementor('http', 'LWP::Protocol::http');
  55.     };
  56. }
  57.  
  58. use vars qw(@EXPORT @ISA $RedirectOK $DebugLWP);
  59.  
  60. require Exporter;
  61. *import = \&Exporter::import;
  62. @EXPORT = @HTTP::Request::Common::EXPORT;
  63.  
  64. @ISA = qw(LWP::UserAgent);
  65.  
  66. my $UA;
  67.  
  68. sub module {
  69.     my $module = shift;
  70.     $Apache::TestRequest::Module = $module if $module;
  71.     $Apache::TestRequest::Module;
  72. }
  73.  
  74. sub scheme {
  75.     my $scheme = shift;
  76.     $Apache::TestRequest::Scheme = $scheme if $scheme;
  77.     $Apache::TestRequest::Scheme;
  78. }
  79.  
  80. sub module2path {
  81.     my $package = shift;
  82.  
  83.     # httpd (1.3 && 2) / winFU have problems when the first path's
  84.     # segment includes ':' (security precaution which breaks the rfc)
  85.     # so we can't use /TestFoo::bar as path_info
  86.     (my $path = $package) =~ s/::/__/g;
  87.  
  88.     return $path;
  89. }
  90.  
  91. sub user_agent {
  92.     my $args = {@_};
  93.  
  94.     if (delete $args->{reset}) {
  95.         $UA = undef;
  96.     }
  97.  
  98.     if (exists $args->{requests_redirectable}) {
  99.         my $redir = $args->{requests_redirectable};
  100.         if (ref $redir and (@$redir > 1 or $redir->[0] ne 'POST')) {
  101.             $RedirectOK = 1;
  102.         } else {
  103.             $RedirectOK = 0;
  104.         }
  105.     }
  106.  
  107.     $args->{keep_alive} ||= $ENV{APACHE_TEST_HTTP11};
  108.  
  109.     if ($args->{keep_alive}) {
  110.         install_http11();
  111.         eval {
  112.             require LWP::Protocol::https; #https10 is the default
  113.             LWP::Protocol::implementor('https', 'LWP::Protocol::https');
  114.         };
  115.     }
  116.  
  117.     eval { $UA ||= __PACKAGE__->new(%$args); };
  118. }
  119.  
  120. sub user_agent_request_num {
  121.     my $res = shift;
  122.     $res->header('Client-Request-Num') ||  #lwp 5.60
  123.         $res->header('Client-Response-Num'); #lwp 5.62+
  124. }
  125.  
  126. sub user_agent_keepalive {
  127.     $ENV{APACHE_TEST_HTTP11} = shift;
  128. }
  129.  
  130. sub do_request {
  131.     my($ua, $method, $url, $callback) = @_;
  132.     my $r = HTTP::Request->new($method, resolve_url($url));
  133.     my $response = $ua->request($r, $callback);
  134.     lwp_trace($response);
  135. }
  136.  
  137. sub hostport {
  138.     my $config = shift || Apache::Test::config();
  139.     local $config->{vars}->{scheme} =
  140.       $Apache::TestRequest::Scheme || $config->{vars}->{scheme};
  141.     my $hostport = $config->hostport;
  142.  
  143.     if (my $module = $Apache::TestRequest::Module) {
  144.         $hostport = $config->{vhosts}->{$module}->{hostport}
  145.           unless $module eq 'default';
  146.     }
  147.  
  148.     $hostport;
  149. }
  150.  
  151. sub resolve_url {
  152.     my $url = shift;
  153.     Carp::croak("no url passed") unless defined $url;
  154.  
  155.     return $url if $url =~ m,^(\w+):/,;
  156.     $url = "/$url" unless $url =~ m,^/,;
  157.  
  158.     my $vars = Apache::Test::vars();
  159.  
  160.     local $vars->{scheme} =
  161.       $Apache::TestRequest::Scheme || $vars->{scheme} || 'http';
  162.  
  163.     scheme_fixup($vars->{scheme});
  164.  
  165.     my $hostport = hostport();
  166.  
  167.     return "$vars->{scheme}://$hostport$url";
  168. }
  169.  
  170. my %wanted_args = map {$_, 1} qw(username password realm content filename
  171.                                  redirect_ok cert);
  172.  
  173. sub wanted_args {
  174.     \%wanted_args;
  175. }
  176.  
  177. $RedirectOK = 1;
  178.  
  179. sub redirect_ok {
  180.     my($self, $request) = @_;
  181.     return 0 if $request->method eq 'POST';
  182.     $RedirectOK;
  183. }
  184.  
  185. my %credentials;
  186.  
  187. #subclass LWP::UserAgent
  188. sub new {
  189.     my $self = shift->SUPER::new(@_);
  190.  
  191.     lwp_debug(); #init from %ENV (set by Apache::TestRun)
  192.  
  193.     my $config = Apache::Test::config();
  194.     if (my $proxy = $config->configure_proxy) {
  195.         #t/TEST -proxy
  196.         $self->proxy(http => "http://$proxy");
  197.     }
  198.  
  199.     $self->timeout(UA_TIMEOUT);
  200.  
  201.     $self;
  202. }
  203.  
  204. sub get_basic_credentials {
  205.     my($self, $realm, $uri, $proxy) = @_;
  206.  
  207.     for ($realm, '__ALL__') {
  208.         next unless $credentials{$_};
  209.         return @{ $credentials{$_} };
  210.     }
  211.  
  212.     return (undef,undef);
  213. }
  214.  
  215. sub vhost_socket {
  216.     my $module = shift;
  217.     local $Apache::TestRequest::Module = $module if $module;
  218.  
  219.     my $hostport = hostport(Apache::Test::config());
  220.     die "can't find hostport for '$module',\n",
  221.         "make sure that vhost_socket() was passed a valid module name"
  222.             unless defined $hostport;
  223.     my($host, $port) = split ':', $hostport;
  224.     my(%args) = (PeerAddr => $host, PeerPort => $port);
  225.  
  226.     if ($module and $module =~ /ssl/) {
  227.         require Net::SSL;
  228.         local $ENV{https_proxy} ||= ""; #else uninitialized value in Net/SSL.pm
  229.         return Net::SSL->new(%args, Timeout => UA_TIMEOUT);
  230.     }
  231.     else {
  232.         require IO::Socket;
  233.         return IO::Socket::INET->new(%args);
  234.     }
  235. }
  236.  
  237. #Net::SSL::getline is nothing like IO::Handle::getline
  238. #could care less about performance here, just need a getline()
  239. #that returns the same results with or without ssl
  240. my %getline = (
  241.     'Net::SSL' => sub {
  242.         my $self = shift;
  243.         my $buf = '';
  244.         my $c = '';
  245.         do {
  246.             $self->read($c, 1);
  247.             $buf .= $c;
  248.         } until ($c eq "\n");
  249.         $buf;
  250.     },
  251. );
  252.  
  253. sub getline {
  254.     my $sock = shift;
  255.     my $class = ref $sock;
  256.     my $method = $getline{$class} || 'getline';
  257.     $sock->$method();
  258. }
  259.  
  260. sub socket_trace {
  261.     my $sock = shift;
  262.     return unless $sock->can('get_peer_certificate');
  263.  
  264.     #like having some -v info
  265.     my $cert = $sock->get_peer_certificate;
  266.     print "#Cipher:  ", $sock->get_cipher, "\n";
  267.     print "#Peer DN: ", $cert->subject_name, "\n";
  268. }
  269.  
  270. sub prepare {
  271.     my $url = shift;
  272.  
  273.     if ($have_lwp) {
  274.         user_agent();
  275.         $url = resolve_url($url);
  276.     }
  277.     else {
  278.         lwp_debug() if $ENV{APACHE_TEST_DEBUG_LWP};
  279.     }
  280.  
  281.     my($pass, $keep) = Apache::TestConfig::filter_args(\@_, \%wanted_args);
  282.  
  283.     %credentials = ();
  284.     if (defined $keep->{username}) {
  285.         $credentials{$keep->{realm} || '__ALL__'} =
  286.           [$keep->{username}, $keep->{password}];
  287.     }
  288.     if (defined(my $content = $keep->{content})) {
  289.         if ($content eq '-') {
  290.             $content = join '', <STDIN>;
  291.         }
  292.         elsif ($content =~ /^x(\d+)$/) {
  293.             $content = 'a' x $1;
  294.         }
  295.         push @$pass, content => $content;
  296.     }
  297.     if ($keep->{cert}) {
  298.         set_client_cert($keep->{cert});
  299.     }
  300.  
  301.     return ($url, $pass, $keep);
  302. }
  303.  
  304. sub UPLOAD {
  305.     my($url, $pass, $keep) = prepare(@_);
  306.  
  307.     local $RedirectOK = exists $keep->{redirect_ok} 
  308.         ? $keep->{redirect_ok}
  309.         : $RedirectOK;
  310.  
  311.     if ($keep->{filename}) {
  312.         return upload_file($url, $keep->{filename}, $pass);
  313.     }
  314.     else {
  315.         return upload_string($url, $keep->{content});
  316.     }
  317. }
  318.  
  319. sub UPLOAD_BODY {
  320.     UPLOAD(@_)->content;
  321. }
  322.  
  323. sub UPLOAD_BODY_ASSERT {
  324.     content_assert(UPLOAD(@_));
  325. }
  326.  
  327. #lwp only supports files
  328. sub upload_string {
  329.     my($url, $data) = @_;
  330.  
  331.     my $CRLF = "\015\012";
  332.     my $bound = 742617000027;
  333.     my $req = HTTP::Request->new(POST => $url);
  334.  
  335.     my $content = join $CRLF,
  336.       "--$bound",
  337.       "Content-Disposition: form-data; name=\"HTTPUPLOAD\"; filename=\"b\"",
  338.       "Content-Type: text/plain", "",
  339.       $data, "--$bound--", "";
  340.  
  341.     $req->header("Content-Length", length($content));
  342.     $req->content_type("multipart/form-data; boundary=$bound");
  343.     $req->content($content);
  344.  
  345.     $UA->request($req);
  346. }
  347.  
  348. sub upload_file {
  349.     my($url, $file, $args) = @_;
  350.  
  351.     my $content = [@$args, filename => [$file]];
  352.  
  353.     $UA->request(HTTP::Request::Common::POST($url,
  354.                  Content_Type => 'form-data',
  355.                  Content      => $content,
  356.     ));
  357. }
  358.  
  359. #useful for POST_HEAD and $DebugLWP (see below)
  360. sub lwp_as_string {
  361.     my($r, $want_body) = @_;
  362.     my $content = $r->content;
  363.  
  364.     unless ($r->isa('HTTP::Request') or
  365.             $r->header('Content-Length') or
  366.             $r->header('Transfer-Encoding'))
  367.     {
  368.         $r->header('Content-Length' => length $content);
  369.         $r->header('X-Content-length-note' => 'added by Apache::TestRequest');
  370.     }
  371.  
  372.     $r->content(undef) unless $want_body;
  373.  
  374.     (my $string = $r->as_string) =~ s/^/\#/mg;
  375.     $r->content($content); #reset
  376.     $string;
  377. }
  378.  
  379. $DebugLWP = 0; #1 == print METHOD URL and header response for all requests
  380.                #2 == #1 + response body
  381.                #other == passed to LWP::Debug->import
  382.  
  383. sub lwp_debug {
  384.     package main; #wtf: else package in perldb changes
  385.     my $val = $_[0] || $ENV{APACHE_TEST_DEBUG_LWP};
  386.  
  387.     return unless $val;
  388.  
  389.     if ($val =~ /^\d+$/) {
  390.         $Apache::TestRequest::DebugLWP = $val;
  391.         return "\$Apache::TestRequest::DebugLWP = $val\n";
  392.     }
  393.     else {
  394.         my(@args) = @_ ? @_ : split /\s+/, $val;
  395.         require LWP::Debug;
  396.         LWP::Debug->import(@args);
  397.         return "LWP::Debug->import(@args)\n";
  398.     }
  399. }
  400.  
  401. sub lwp_trace {
  402.     my $r = shift;
  403.  
  404.     unless ($r->request->protocol) {
  405.         #lwp always sends a request, but never sets
  406.         #$r->request->protocol, happens deeper in the
  407.         #LWP::Protocol::http* modules
  408.         my $proto = user_agent_request_num($r) ? "1.1" : "1.0";
  409.         $r->request->protocol("HTTP/$proto");
  410.     }
  411.  
  412.     my $want_body = $DebugLWP > 1;
  413.     print "#lwp request:\n",
  414.       lwp_as_string($r->request, $want_body);
  415.  
  416.     print "#server response:\n",
  417.       lwp_as_string($r, $want_body);
  418. }
  419.  
  420. sub lwp_call {
  421.     my($name, $shortcut) = (shift, shift);
  422.  
  423.     my $r = (\&{$name})->(@_);
  424.  
  425.     Carp::croak("$name(@_) didn't return a response object") unless $r;
  426.  
  427.     my $error = "";
  428.     unless ($shortcut) {
  429.         #GET, HEAD, POST
  430.         if ($r->method eq "POST" && !defined($r->header("Content-Length"))) {
  431.             $r->header('Content-Length' => length($r->content));
  432.         }
  433.         $r = $UA ? $UA->request($r) : $r;
  434.         my $proto = $r->protocol;
  435.         if (defined($proto)) {
  436.             if ($proto !~ /^HTTP\/(\d\.\d)$/) {
  437.                 $error = "response had no protocol (is LWP broken or something?)";
  438.             }
  439.             if ($1 ne "1.0" && $1 ne "1.1") {
  440.                 $error = "response had protocol HTTP/$1 (headers not sent?)";
  441.             }
  442.         }
  443.     }
  444.  
  445.     if ($DebugLWP and not $shortcut) {
  446.         lwp_trace($r);
  447.     }
  448.  
  449.     Carp::croak($error) if $error;
  450.  
  451.     return $shortcut ? $r->$shortcut() : $r;
  452. }
  453.  
  454. my %shortcuts = (RC   => sub { shift->code },
  455.                  OK   => sub { shift->is_success },
  456.                  STR  => sub { shift->as_string },
  457.                  HEAD => sub { lwp_as_string(shift, 0) },
  458.                  BODY => sub { shift->content },
  459.                  BODY_ASSERT => sub { content_assert(shift) },
  460. );
  461.  
  462. for my $name (@EXPORT) {
  463.     my $package = $have_lwp ?
  464.       'HTTP::Request::Common': 'Apache::TestClient';
  465.  
  466.     my $method = join '::', $package, $name;
  467.     no strict 'refs';
  468.  
  469.     next unless defined &$method;
  470.  
  471.     *$name = sub {
  472.         my($url, $pass, $keep) = prepare(@_);
  473.         local $RedirectOK = exists $keep->{redirect_ok}
  474.             ? $keep->{redirect_ok}
  475.             : $RedirectOK;
  476.         return lwp_call($method, undef, $url, @$pass);
  477.     };
  478.  
  479.     while (my($shortcut, $cv) = each %shortcuts) {
  480.         my $alias = join '_', $name, $shortcut;
  481.         *$alias = sub { lwp_call($name, $cv, @_) };
  482.     }
  483. }
  484.  
  485. my @export_std = @EXPORT;
  486. for my $method (@export_std) {
  487.     push @EXPORT, map { join '_', $method, $_ } keys %shortcuts;
  488. }
  489.  
  490. push @EXPORT, qw(UPLOAD UPLOAD_BODY UPLOAD_BODY_ASSERT);
  491.  
  492. sub to_string {
  493.     my $obj = shift;
  494.     ref($obj) ? $obj->as_string : $obj;
  495. }
  496.  
  497. # request an interpreter instance and use this interpreter id to
  498. # select the same interpreter in requests below
  499. sub same_interp_tie {
  500.     my($url) = @_;
  501.  
  502.     my $res = GET($url, INTERP_KEY, 'tie');
  503.  
  504.     my $same_interp = $res->header(INTERP_KEY);
  505.  
  506.     return $same_interp;
  507. }
  508.  
  509. # run the request though the selected perl interpreter, by polling
  510. # until we found it
  511. # currently supports only GET, HEAD, PUT, POST subs
  512. sub same_interp_do {
  513.     my($same_interp, $sub, $url, @args) = @_;
  514.  
  515.     die "must pass an interpreter id to work with"
  516.         unless defined $same_interp and $same_interp;
  517.  
  518.     push @args, (INTERP_KEY, $same_interp);
  519.  
  520.     my $res      = '';
  521.     my $times    = 0;
  522.     my $found_same_interp = '';
  523.     do {
  524.         #loop until we get a response from our interpreter instance
  525.         $res = $sub->($url, @args);
  526.  
  527.         if ($res and $res->code == 200) {
  528.             $found_same_interp = $res->header(INTERP_KEY) || '';
  529.         }
  530.  
  531.         unless ($found_same_interp eq $same_interp) {
  532.             $found_same_interp = '';
  533.         }
  534.  
  535.         if ($times++ > TRY_TIMES) { #prevent endless loop
  536.             die "unable to find interp $same_interp\n";
  537.         }
  538.     } until ($found_same_interp);
  539.  
  540.     return $found_same_interp ? $res : undef;
  541. }
  542.  
  543.  
  544. sub set_client_cert {
  545.     my $name = shift;
  546.     my $vars = Apache::Test::vars();
  547.     my $dir = join '/', $vars->{sslca}, $vars->{sslcaorg};
  548.  
  549.     if ($name) {
  550.         $ENV{HTTPS_CERT_FILE} = "$dir/certs/$name.crt";
  551.         $ENV{HTTPS_KEY_FILE}  = "$dir/keys/$name.pem";
  552.     }
  553.     else {
  554.         for (qw(CERT KEY)) {
  555.             delete $ENV{"HTTPS_${_}_FILE"};
  556.         }
  557.     }
  558. }
  559.  
  560. #want news: urls to work with the LWP shortcuts
  561. #but cant find a clean way to override the default nntp port
  562. #by brute force we trick Net::NTTP into calling FixupNNTP::new
  563. #instead of IO::Socket::INET::new, we fixup the args then forward
  564. #to IO::Socket::INET::new
  565.  
  566. #also want KeepAlive on for Net::HTTP
  567. #XXX libwww-perl 5.53_xx has: LWP::UserAgent->new(keep_alive => 1);
  568.  
  569. sub install_net_socket_new {
  570.     my($module, $code) = @_;
  571.  
  572.     return unless Apache::Test::have_module($module);
  573.  
  574.     no strict 'refs';
  575.  
  576.     my $new;
  577.     my $isa = \@{"$module\::ISA"};
  578.  
  579.     for (@$isa) {
  580.         last if $new = $_->can('new');
  581.     }
  582.  
  583.     my $fixup_class = "Apache::TestRequest::$module";
  584.     unshift @$isa, $fixup_class;
  585.  
  586.     *{"$fixup_class\::new"} = sub {
  587.         my $class = shift;
  588.         my $args = {@_};
  589.         $code->($args);
  590.         return $new->($class, %$args);
  591.     };
  592. }
  593.  
  594. my %scheme_fixups = (
  595.     'news' => sub {
  596.         return if $INC{'Net/NNTP.pm'};
  597.         eval {
  598.             install_net_socket_new('Net::NNTP' => sub {
  599.                 my $args = shift;
  600.                 my($host, $port) = split ':',
  601.                   Apache::TestRequest::hostport();
  602.                 $args->{PeerPort} = $port;
  603.                 $args->{PeerAddr} = $host;
  604.             });
  605.         };
  606.     },
  607. );
  608.  
  609. sub scheme_fixup {
  610.     my $scheme = shift;
  611.     my $fixup = $scheme_fixups{$scheme};
  612.     return unless $fixup;
  613.     $fixup->();
  614. }
  615.  
  616. # when the client side simply prints the response body which should
  617. # include the test's output, we need to make sure that the request
  618. # hasn't failed, or the test will be skipped instead of indicating the
  619. # error.
  620. sub content_assert {
  621.     my $res = shift;
  622.  
  623.     return $res->content if $res->is_success;
  624.  
  625.     die join "\n", 
  626.         "request has failed (the response code was: " . $res->code . ")",
  627.         "see t/logs/error_log for more details\n";
  628. }
  629.  
  630. 1;
  631.  
  632. =head1 NAME
  633.  
  634. Apache::TestRequest - Send requests to your Apache test server
  635.  
  636. =head1 SYNOPSIS
  637.  
  638.   use Apache::Test qw(ok have_lwp);
  639.   use Apache::TestRequest qw(GET POST);
  640.   use Apache::Constants qw(HTTP_OK);
  641.  
  642.   plan tests => 1, have_lwp;
  643.  
  644.   my $res = GET '/test.html';
  645.   ok $res->code == HTTP_OK, "Request is ok";
  646.  
  647. =head1 DESCRIPTION
  648.  
  649. B<Apache::TestRequest> provides convenience functions to allow you to
  650. make requests to your Apache test server in your test scripts. It
  651. subclasses C<LWP::UserAgent>, so that you have access to all if its
  652. methods, but also exports a number of useful functions likely useful
  653. for majority of your test requests. Users of the old C<Apache::test>
  654. (or C<Apache::testold>) module, take note! Herein lie most of the
  655. functions you'll need to use to replace C<Apache::test> in your test
  656. suites.
  657.  
  658. Each of the functions exported by C<Apache::TestRequest> uses an
  659. C<LWP::UserAgent> object to submit the request and retrieve its
  660. results. The return value for many of these functions is an
  661. HTTP::Response object. See L<HTTP::Response|HTTP::Response> for
  662. documentation of its methods, which you can use in your tests. For
  663. example, use the C<code()> and C<content()> methods to test the
  664. response code and content of your request. Using C<GET>, you can
  665. perform a couple of tests using these methods like this:
  666.  
  667.   use Apache::Test qw(ok have_lwp);
  668.   use Apache::TestRequest qw(GET POST);
  669.   use Apache::Constants qw(HTTP_OK);
  670.  
  671.   plan tests => 2, have_lwp;
  672.  
  673.   my $uri = "/test.html?foo=1&bar=2";
  674.   my $res = GET $uri;
  675.   ok $res->code == HTTP_OK, "Check that the request was OK";
  676.   ok $res->content eq "foo => 1, bar => 2", "Check its content";
  677.  
  678. Note that you can also use C<Apache::TestRequest> with
  679. C<Test::Builder> and its derivatives, including C<Test::More>:
  680.  
  681.   use Test::More;
  682.   # ...
  683.   is $res->code, HTTP_OK, "Check that the request was OK";
  684.   is $res->content, "foo => 1, bar => 2", "Check its content";
  685.  
  686. =head1 CONFIGURATION FUNCTION
  687.  
  688. You can tell C<Apache::TestRequest> what kind of C<LWP::UserAgent>
  689. object to use for its convenience functions with C<user_agent()>. This
  690. function uses its arguments to construct an internal global
  691. C<LWP::UserAgent> object that will be used for all subsequent requests
  692. made by the convenience functions. The arguments it takes are the same
  693. as for the C<LWP::UserAgent> constructor. See the
  694. C<L<LWP::UserAgent|LWP::UserAgent>> documentation for a complete list.
  695.  
  696. The C<user_agent()> function only creates the internal
  697. C<LWP::UserAgent> object the first time it is called. Since this
  698. function is called internally by C<Apache::TestRequest>, you should
  699. always use the C<reset> parameter to force it to create a new global
  700. C<LWP::UserAgent> Object:
  701.  
  702.   Apache::TestRequest::user_agent(reset => 1, %params);
  703.  
  704. C<user_agent()> differs from C<< LWP::UserAgent->new >> in two
  705. additional ways. First, it supports an additional parameter,
  706. C<keep_alive>, which enables connection persistence, where the same
  707. connection is used to process multiple requests (and, according to the
  708. C<L<LWP::UserAgent|LWP::UserAgent>> documentation, has the effect of
  709. loading and enabling the new experimental HTTP/1.1 protocol module).
  710.  
  711. And finally, the semantics of the C<requests_redirectable> parameter
  712. is different than for C<LWP::UserAgent>: It either follows
  713. redirects for a request, or it doesn't. Thus
  714. C<requests_redirectable> is a boolean value instead of the array
  715. reference that C<LWP::UserAgent> expects. To force
  716. C<Apache::TestRequest> not to follow redirects in any of its
  717. convenience functions, pass a false value to C<requests_redirectable>:
  718.  
  719.   Apache::TestRequest::user_agent(reset => 1,
  720.                                   requests_redirectable => 0);
  721.  
  722. =head1 FUNCTIONS
  723.  
  724. C<Apache::TestRequest> exports a number of functions that will likely
  725. prove convenient for use in the majority of your request tests.
  726.  
  727. =head2 Optional Parameters
  728.  
  729. Each function also takes a number of optional arguments.
  730.  
  731. =over 4
  732.  
  733. =item redirect_ok
  734.  
  735. By default a request will follow redirects retrieved from the server. To
  736. prevent this behavior, pass a false value to a C<redirect_ok>
  737. parameter:
  738.  
  739.   my $res = GET $uri, redirect_ok => 0;
  740.  
  741. Alternately, if all of your tests need to disable redirects, tell
  742. C<Apache::TestRequest> to use an C<LWP::UserAgent> object that
  743. disables redirects:
  744.  
  745.   Apache::TestRequest::user_agent( reset => 1,
  746.                                    requests_redirectable => 0 );
  747.  
  748. =item cert
  749.  
  750. If you need to force an SSL request to use a particular SSL
  751. certificate, pass the name of the certificate via the C<cert>
  752. parameter:
  753.  
  754.   my $res = GET $uri, cert => 'my_cert';
  755.  
  756. =item content
  757.  
  758. If you need to add content to your request, use the C<content>
  759. parameter:
  760.  
  761.   my $res = GET $uri, content => 'hello world!';
  762.  
  763. =item filename
  764.  
  765. The name of a local file on the file system to be sent to the Apache
  766. test server via C<UPLOAD()> and its friends.
  767.  
  768. =back
  769.  
  770. =head2 The Functions
  771.  
  772. =head3 GET
  773.  
  774.   my $res = GET $uri;
  775.  
  776. Sends a simple GET request to the Apache test server. Returns an
  777. C<HTTP::Response> object.
  778.  
  779. =head3 GET_STR
  780.  
  781. A shortcut function for C<GET($uri)-E<gt>as_string>.
  782.  
  783. =head3 GET_BODY
  784.  
  785. A shortcut function for C<GET($uri)-E<gt>content>.
  786.  
  787. =head3 GET_BODY_ASSERT
  788.  
  789. Use this function when your test is outputting content that you need
  790. to check, and you want to make sure that the request was successful
  791. before comparing the contents of the request. If the request was
  792. unsuccessful, C<GET_BODY_ASSERT> will return an error
  793. message. Otherwise it will simply return the content of the request
  794. just as C<GET_BODY> would.
  795.  
  796. =head3 GET_OK
  797.  
  798. A shortcut function for C<GET($uri)-E<gt>is_success>.
  799.  
  800. =head3 GET_RC
  801.  
  802. A shortcut function for C<GET($uri)-E<gt>code>.
  803.  
  804. =head3 GET_HEAD
  805.  
  806. Throws out the content of the request, and returns the string
  807. representation of the request. Since the body has been thrown out, the
  808. representation will consist solely of the headers. Furthermore,
  809. C<GET_HEAD> inserts a "#" at the beginning of each line of the return
  810. string, so that the contents are suitable for printing to STDERR
  811. during your tests without interfering with the workings of
  812. C<Test::Harness>.
  813.  
  814. =head3 HEAD
  815.  
  816.   my $res = HEAD $uri;
  817.  
  818. Sends a HEAD request to the Apache test server. Returns an
  819. C<HTTP::Response> object.
  820.  
  821. =head3 HEAD_STR
  822.  
  823. A shortcut function for C<HEAD($uri)-E<gt>as_string>.
  824.  
  825. =head3 HEAD_BODY
  826.  
  827. A shortcut function for C<HEAD($uri)-E<gt>content>. Of course, this
  828. means that it will likely return nothing.
  829.  
  830. =head3 HEAD_BODY_ASSERT
  831.  
  832. Use this function when your test is outputting content that you need
  833. to check, and you want to make sure that the request was successful
  834. before comparing the contents of the request. If the request was
  835. unsuccessful, C<HEAD_BODY_ASSERT> will return an error
  836. message. Otherwise it will simply return the content of the request
  837. just as C<HEAD_BODY> would.
  838.  
  839. =head3 HEAD_OK
  840.  
  841. A shortcut function for C<GET($uri)-E<gt>is_success>.
  842.  
  843. =head3 HEAD_RC
  844.  
  845. A shortcut function for C<GET($uri)-E<gt>code>.
  846.  
  847. =head3 HEAD_HEAD
  848.  
  849. Throws out the content of the request, and returns the string
  850. representation of the request. Since the body has been thrown out, the
  851. representation will consist solely of the headers. Furthermore,
  852. C<GET_HEAD> inserts a "#" at the beginning of each line of the return
  853. string, so that the contents are suitable for printing to STDERR
  854. during your tests without interfering with the workings of
  855. C<Test::Harness>.
  856.  
  857. =head3 PUT
  858.  
  859.   my $res = PUT $uri;
  860.  
  861. Sends a simple PUT request to the Apache test server. Returns an
  862. C<HTTP::Response> object.
  863.  
  864. =head3 PUT_STR
  865.  
  866. A shortcut function for C<PUT($uri)-E<gt>as_string>.
  867.  
  868. =head3 PUT_BODY
  869.  
  870. A shortcut function for C<PUT($uri)-E<gt>content>.
  871.  
  872. =head3 PUT_BODY_ASSERT
  873.  
  874. Use this function when your test is outputting content that you need
  875. to check, and you want to make sure that the request was successful
  876. before comparing the contents of the request. If the request was
  877. unsuccessful, C<PUT_BODY_ASSERT> will return an error
  878. message. Otherwise it will simply return the content of the request
  879. just as C<PUT_BODY> would.
  880.  
  881. =head3 PUT_OK
  882.  
  883. A shortcut function for C<PUT($uri)-E<gt>is_success>.
  884.  
  885. =head3 PUT_RC
  886.  
  887. A shortcut function for C<PUT($uri)-E<gt>code>.
  888.  
  889. =head3 PUT_HEAD
  890.  
  891. Throws out the content of the request, and returns the string
  892. representation of the request. Since the body has been thrown out, the
  893. representation will consist solely of the headers. Furthermore,
  894. C<PUT_HEAD> inserts a "#" at the beginning of each line of the return
  895. string, so that the contents are suitable for printing to STDERR
  896. during your tests without interfering with the workings of
  897. C<Test::Harness>.
  898.  
  899. =head3 POST
  900.  
  901.   my $res = POST $uri, [ arg => $val, arg2 => $val ];
  902.  
  903. Sends a POST request to the Apache test server and returns an
  904. C<HTTP::Response> object. An array reference of parameters passed as
  905. the second argument will be submitted to the Apache test server as the
  906. POST content. Parameters corresponding to those documented in
  907. L<Optional Parameters|/Optional
  908. Parameters> can follow the optional array reference of parameters, or after
  909. C<$uri>.
  910.  
  911. To upload a chunk of data, simply use:
  912.  
  913.   my $res = POST $uri, content => $data;
  914.  
  915. =head3 POST_STR
  916.  
  917. A shortcut function for C<POST($uri, @args)-E<gt>content>.
  918.  
  919. =head3 POST_BODY
  920.  
  921. A shortcut function for C<POST($uri, @args)-E<gt>content>.
  922.  
  923. =head3 POST_BODY_ASSERT
  924.  
  925. Use this function when your test is outputting content that you need
  926. to check, and you want to make sure that the request was successful
  927. before comparing the contents of the request. If the request was
  928. unsuccessful, C<POST_BODY_ASSERT> will return an error
  929. message. Otherwise it will simply return the content of the request
  930. just as C<POST_BODY> would.
  931.  
  932. =head3 POST_OK
  933.  
  934. A shortcut function for C<POST($uri, @args)-E<gt>is_success>.
  935.  
  936. =head3 POST_RC
  937.  
  938. A shortcut function for C<POST($uri, @args)-E<gt>code>.
  939.  
  940. =head3 POST_HEAD
  941.  
  942. Throws out the content of the request, and returns the string
  943. representation of the request. Since the body has been thrown out, the
  944. representation will consist solely of the headers. Furthermore,
  945. C<POST_HEAD> inserts a "#" at the beginning of each line of the return
  946. string, so that the contents are suitable for printing to STDERR
  947. during your tests without interfering with the workings of
  948. C<Test::Harness>.
  949.  
  950. =head3 UPLOAD
  951.  
  952.   my $res = UPLOAD $uri, \@args, filename => $filename;
  953.  
  954. Sends a request to the Apache test server that includes an uploaded
  955. file. Other POST parameters can be passed as a second argument as an
  956. array reference.
  957.  
  958. C<Apache::TestRequest> will read in the contents of the file named via
  959. the C<filename> parameter for submission to the server. If you'd
  960. rather, you can submit use the C<content> parameter instead of
  961. C<filename>, and its value will be submitted to the Apache server as
  962. file contents:
  963.  
  964.   my $res = UPLOAD $uri, undef, content => "This is file content";
  965.  
  966. The name of the file sent to the server will simply be "b". Note that
  967. in this case, you cannot pass other POST arguments to C<UPLOAD()> --
  968. they would be ignored.
  969.  
  970. =head3 UPLOAD_BODY
  971.  
  972. A shortcut function for C<UPLOAD($uri, @params)-E<gt>content>.
  973.  
  974. =head3 UPLOAD_BODY_ASSERT
  975.  
  976. Use this function when your test is outputting content that you need
  977. to check, and you want to make sure that the request was successful
  978. before comparing the contents of the request. If the request was
  979. unsuccessful, C<UPLOAD_BODY_ASSERT> will return an error
  980. message. Otherwise it will simply return the content of the request
  981. just as C<UPLOAD_BODY> would.
  982.  
  983. =head3 OPTIONS
  984.  
  985.   my $res = OPTIONS $uri;
  986.  
  987. Sends an C<OPTIONS> request to the Apache test server. Returns an
  988. C<HTTP::Response> object with the I<Allow> header, indicating which
  989. methods the server supports. Possible methods include C<OPTIONS>,
  990. C<GET>, C<HEAD> and C<POST>. This function thus can be useful for
  991. testing what options the Apache server supports. Consult the HTTPD 1.1
  992. specification, section 9.2, at
  993. I<http://www.faqs.org/rfcs/rfc2616.html> for more information.
  994.  
  995. =head1 ENVIRONMENT VARIABLES
  996.  
  997. The following environment variables can affect the behavior of
  998. C<Apache::TestRequest>:
  999.  
  1000. =over
  1001.  
  1002. =item APACHE_TEST_PRETEND_NO_LWP
  1003.  
  1004. If the environment variable C<APACHE_TEST_PRETEND_NO_LWP> is set to a
  1005. true value, C<Apache::TestRequest> will pretend that LWP is not
  1006. available so one can test whether the test suite will survive on a
  1007. system which doesn't have libwww-perl installed.
  1008.  
  1009. =back
  1010.  
  1011. =head1 SEE ALSO
  1012.  
  1013. L<Apache::Test|Apache::Test> is the main Apache testing module. Use it
  1014. to set up your tests, create a plan, and to ensure that you have the
  1015. Apache version and modules you need.
  1016.  
  1017. Use L<Apache::TestMM|Apache::TestMM> in your I<Makefile.PL> to set up
  1018. your distribution for testing.
  1019.  
  1020. =head1 AUTHOR
  1021.  
  1022. Doug MacEachern with contributions from Geoffrey Young, Philippe
  1023. M. Chiasson, Stas Bekman and others. Documentation by David Wheeler.
  1024.  
  1025. Questions can be asked at the test-dev <at> httpd.apache.org list. For
  1026. more information see: I<http://httpd.apache.org/test/> and
  1027. I<http://perl.apache.org/docs/general/testing/testing.html>.
  1028.