"Fossies" - the Fresh Open Source Software Archive

Member "mod_perl-2.0.11/t/response/TestAPI/request_util.pm" (5 Oct 2019, 2509 Bytes) of package /linux/www/apache_httpd_modules/mod_perl-2.0.11.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "request_util.pm": 2.0.8_vs_2.0.9.

    1 # please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
    2 package TestAPI::request_util;
    3 
    4 use strict;
    5 use warnings FATAL => 'all';
    6 
    7 use Apache::Test;
    8 use Apache::TestUtil;
    9 
   10 use Apache2::RequestUtil ();
   11 use Apache2::MPM ();
   12 use Apache2::Log ();
   13 use APR::Pool ();
   14 
   15 use Apache2::Const -compile => 'OK';
   16 
   17 my %status_lines = (
   18    200 => '200 OK',
   19    400 => '400 Bad Request',
   20    500 => '500 Internal Server Error',
   21 );
   22 
   23 sub handler {
   24     my $r = shift;
   25 
   26     plan $r, tests => (scalar keys %status_lines) + 11;
   27 
   28     # default_type() is gone as of httpd 2.3.2-dev
   29     ok !defined(&Apache2::RequestRec::default_type) || $r->default_type;
   30 
   31     my $document_root = $r->document_root;
   32 
   33     ok $document_root;
   34 
   35     if (!Apache2::MPM->is_threaded) {
   36         my $path_orig = my $path = '/tmp/foo';
   37         ok t_cmp($document_root, $r->document_root($path));
   38         # make sure that the new docroot string is copied internally,
   39         # and later manipulations of the passed scalar don't affect it
   40         $path .= "suffix";
   41         ok t_cmp($path_orig, $r->document_root($document_root));
   42     }
   43     else {
   44         eval { $r->document_root('/tmp/foo') };
   45         ok t_cmp($@, qr/Can't run.*in the threaded env/,
   46                  "document_root is read-only under threads");
   47         ok 1;
   48     }
   49 
   50     ok $r->get_server_name;
   51 
   52     ok $r->get_server_port;
   53 
   54     ok $r->get_limit_req_body || 1;
   55 
   56     ok $r->is_initial_req;
   57 
   58     my $sig = $r->psignature("Here is the sig: ");
   59     t_debug $sig;
   60     ok $sig;
   61 
   62     my $pattern =
   63         qr!(?s)GET /TestAPI__request_util.*Host:.*200 OK.*Content-Type:!;
   64 
   65     ok t_cmp($r->as_string,
   66              $pattern,
   67              "test for the request_line, host, status, and few " .
   68              "headers that should always be there");
   69 
   70     while (my ($code, $line) = each %status_lines) {
   71         ok t_cmp(Apache2::RequestUtil::get_status_line($code),
   72                  $line,
   73                  "Apache2::RequestUtil::get_status_line($code)");
   74     }
   75 
   76     if (Apache2::MPM->is_threaded) {
   77         eval { $r->child_terminate() };
   78         ok t_cmp($@, qr/Can't run.*in a threaded mpm/, "child_terminate");
   79     }
   80     else {
   81         t_server_log_error_is_expected();
   82         ok $r->child_terminate() || 1;
   83         $r->pool->cleanup_register(
   84             sub {
   85                 my $r = shift;
   86                 $r->log_error("Process $$ terminates itself\n");
   87             }, $r);
   88     }
   89 
   90     Apache2::Const::OK;
   91 }
   92 
   93 1;