File: apache.pm

package info (click to toggle)
libapache2-mod-perl2 2.0.9~1624218-2%2Bdeb8u2
  • links: PTS, VCS
  • area: main
  • in suites: jessie
  • size: 11,912 kB
  • ctags: 4,588
  • sloc: perl: 95,064; ansic: 14,527; makefile: 49; sh: 18
file content (133 lines) | stat: -rw-r--r-- 4,051 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
package TestCompat::apache;

# Apache->"method" and Apache::"function" compat layer tests

# these tests are all run and validated on the server side.

use strict;
use warnings FATAL => 'all';

use Apache::TestUtil;
use Apache::Test;

use ModPerl::Util ();
use Apache2::compat ();
use Apache::Constants qw(DIR_MAGIC_TYPE OPT_EXECCGI :common :response);

use File::Spec::Functions qw(catfile canonpath);

sub fixup {
    my $r = shift;
    Apache->httpd_conf('Options +ExecCGI');
    OK;
}

sub handler {
    my $r = shift;

    plan $r, tests => 24;

    $r->send_http_header('text/plain');

    ### Apache-> tests
    my $fh = Apache->gensym;
    ok t_cmp(ref($fh), 'GLOB', "Apache->gensym");

    ok t_cmp(Apache->module('mod_perl.c'), 1,
             "Apache2::module('mod_perl.c')");
    ok t_cmp(Apache->module('mod_ne_exists.c'), 0,
             "Apache2::module('mod_ne_exists.c')");

    ok t_cmp(Apache->define('MODPERL2'),
             Apache2::ServerUtil::exists_config_define('MODPERL2'),
             'Apache->define');

    ok t_cmp($r->current_callback,
             'PerlResponseHandler',
             'inside PerlResponseHandler');

    t_server_log_error_is_expected();
    Apache::log_error("Apache::log_error test ok");
    ok 1;

    t_server_log_warn_is_expected();
    Apache->warn('Apache->warn ok');
    ok 1;

    t_server_log_warn_is_expected();
    Apache::warn('Apache::warn ok');
    ok 1;

    t_server_log_warn_is_expected();
    Apache::Server->warn('Apache::Server->warn ok');
    ok 1;

    t_server_log_warn_is_expected();
    Apache::Server::warn('Apache::Server::warn ok');
    ok 1;

    # explicitly imported
    ok t_cmp(DIR_MAGIC_TYPE, "httpd/unix-directory",
             'DIR_MAGIC_TYPE');

    # :response is ignored, but is now aliased in :common
    ok t_cmp(REDIRECT, "302",
             'REDIRECT');

    # from :common
    ok t_cmp(AUTH_REQUIRED, "401",
             'AUTH_REQUIRED');

    ok t_cmp(OK, "0",
             'OK');

    my $exec_cgi = $r->allow_options & Apache2::Const::OPT_EXECCGI;
    ok t_cmp($exec_cgi, Apache2::Const::OPT_EXECCGI, 'Apache->httpd_conf');

    # (Apache||$r)->server_root_relative
    {
        my $server_root = Apache::Test::config()->{vars}->{serverroot};
        ok t_filepath_cmp(canonpath($Apache::Server::CWD),
                          canonpath($server_root),
                          '$server_root');

        ok t_filepath_cmp(canonpath($r->server_root_relative),
                          canonpath($server_root),
                          '$r->server_root_relative()');

        ok t_filepath_cmp(canonpath($r->server_root_relative('conf')),
                          catfile($server_root, 'conf'),
                          "\$r->server_root_relative('conf')");

        ok t_filepath_cmp(canonpath(Apache->server_root_relative('conf')),
                          catfile($server_root, 'conf'),
                          "Apache2::ServerUtil->server_root_relative('conf')");

        ok t_filepath_cmp(canonpath(Apache->server_root_relative),
                          canonpath($server_root),
                          'Apache2::ServerUtil->server_root_relative()');

        my $path = catfile(Apache2::ServerUtil::server_root, 'logs');
        ok t_filepath_cmp(canonpath(Apache->server_root_relative($path)),
                          canonpath($path),
                          "Apache->server_root_relative('$path')");
    }

    ok t_cmp(Apache->unescape_url_info("/foo+bar%20baz"),
             '/foo bar baz',
             'Apache->unescape_url_info');

    ok t_cmp $Apache::Server::Starting,   0, '$Apache::Server::Starting';
    ok t_cmp $Apache::Server::ReStarting, 1, '$Apache::Server::ReStarting';

    OK;
}

1;

__END__
# so we can test whether send_httpd_header() works fine
PerlOptions +ParseHeaders +GlobalRequest
PerlModule TestCompat::apache
PerlFixupHandler TestCompat::apache::fixup