my
$r
=
shift
;
$r
->send_http_header(
"text/plain"
);
unless
(have_module
"Apache::Table"
) {
print
"1..0\n"
;
return
;
}
my
$i
= 0;
my
$tests
= 32;
print
"1..$tests\n"
;
my
$headers_in
=
$r
->headers_in;
my
$table
=
tied
%$headers_in
;
test ++
$i
, UNIVERSAL::isa(
$headers_in
,
'HASH'
);
test ++
$i
,
$table
->isa(
'Apache::Table'
);
test ++
$i
,
$table
->get(
'User-Agent'
);
test ++
$i
,
$r
->headers_in->get(
'User-Agent'
);
test ++
$i
,
$headers_in
->{
'User-Agent'
};
test ++
$i
,
$table
->get(
'User-Agent'
) eq
$headers_in
->{
'User-Agent'
};
$table
->merge(
Accept
=>
"application/x-perl"
);
test ++
$i
,
$table
->get(
"Accept"
) =~ /x-perl/;
test ++
$i
, not
$table
->get(
"NoChance"
);
test ++
$i
, not
$headers_in
->{
"NoChance"
};
test ++
$i
,
keys
%$headers_in
> 0;
my
%save
=
%$headers_in
;
delete
$headers_in
->{
'User-Agent'
};
test ++
$i
, not
$table
->get(
'User-Agent'
);
%$headers_in
= ();
test ++
$i
,
scalar
keys
%$headers_in
== 0;
%$headers_in
=
%save
;
my
%my_hash
= (
two
=> 2,
three
=> 3);
@{
$r
->notes }{
keys
%my_hash
} = (
values
%my_hash
);
for
(
keys
%my_hash
) {
test ++
$i
,
scalar
$r
->notes->get(
$_
);
}
$r
->notes->add(
three
=>
"tre"
);
my
(
@notes
) =
$r
->notes->get(
"three"
);
print
"\@notes = @notes\n"
;
test ++
$i
,
@notes
== 2;
sub
print_header {
my
(
$k
,
$v
) =
@_
;
print
"DO: $k => $v\n"
;
$Seen
{
$k
}++;
1;
}
%Seen
= ();
$r
->notes->
do
(\
&print_header
);
test ++
$i
,
$Seen
{three} == 2;
test ++
$i
,
$Seen
{two};
%Seen
= ();
$r
->notes->
do
(\
&print_header
,
qw(three)
);
test ++
$i
, not
exists
$Seen
{two};
sub
my_as_string {
my
$r
=
shift
;
my
@retval
= ();
push
@retval
,
$r
->the_request;
my
$str_header
=
sub
{
my
(
$k
,
$v
) =
@_
;
push
@retval
,
"$k: $v"
;
1;
};
$r
->headers_in->
do
(
$str_header
);
push
@retval
,
""
;
push
@retval
,
join
(
" "
,
$r
->protocol,
$r
->status_line);
for
my
$meth
(
qw(headers_out err_headers_out)
) {
$r
->
$meth
()->
do
(
$str_header
);
}
push
@retval
,
""
,
""
;
join
"\n"
,
grep
{
defined
$_
}
@retval
;
}
if
(my_as_string(
$r
) eq
$r
->as_string) {
print
"as_string match\n"
;
}
else
{
print
"as_string MIS-match\n"
;
print
"-"
x 20, $/;
print
my_as_string(
$r
);
print
"-"
x 20, $/;
print
$r
->as_string;
print
"-"
x 20, $/;
}
for
my
$meth
(
qw{
headers_in headers_out err_headers_out notes dir_config subprocess_env
}
)
{
my
$hash_ref
=
$r
->
$meth
();
my
$tab
=
tied
%$hash_ref
;
print
"$meth:\n"
;
while
(
my
(
$k
,
$v
) =
each
%$hash_ref
) {
print
"$k = $v\n"
;
}
print
"TOTAL: "
,
scalar
keys
%$hash_ref
,
"\n\n"
;
test ++
$i
, UNIVERSAL::isa(
$hash_ref
,
'HASH'
);
test ++
$i
,
$tab
->isa(
'Apache::Table'
);
}
my
$tabobj
= Apache::Table->new(
$r
);
test ++
$i
,
$tabobj
;
$tabobj
->{
'a'
} = 1;
test ++
$i
,
$tabobj
->get(
'a'
);