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
|
package TestModperl::cookie2;
use strict;
use warnings FATAL => 'all';
use Apache::TestTrace;
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::Const -compile => 'OK';
sub access {
my $r = shift;
$r->subprocess_env if $r->args eq 'subprocess_env';
my ($key, $val) = cookie($r);
die "I shouldn't get the cookie" if $r->args eq 'env' && defined $val;
return Apache2::Const::OK;
}
sub handler {
my $r = shift;
my ($key, $val) = cookie($r);
$r->print($val) if defined $val;
return Apache2::Const::OK;
}
sub cookie {
my $r = shift;
my $header = $r->headers_in->{Cookie} || '';
my $env = $ENV{HTTP_COOKIE} || $ENV{COOKIE} || ''; # from CGI::cookie2
debug "cookie (" .$r->args . "): header: [$header], env: [$env]";
return split '=', $r->args eq 'header' ? $header : $env;
}
1;
__DATA__
SetHandler modperl
PerlModule TestModperl::cookie2
PerlAccessHandler TestModperl::cookie2::access
PerlResponseHandler TestModperl::cookie2
|
