stas 02/05/19 04:41:53
Modified: . Changes
lib/Apache compat.pm
t/response/TestApache compat2.pm
Log:
add the err_header_out() wrapper to Apache::compat + corresponding tests.
Revision Changes Path
1.11 +2 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- Changes 14 May 2002 01:14:19 -0000 1.10
+++ Changes 19 May 2002 11:41:53 -0000 1.11
@@ -10,6 +10,8 @@
=item 1.99_02-dev
+add the err_header_out() wrapper to Apache::compat + corresponding tests
+
add Apache::Util::unescape_uri alias to Apache::unescape_url in Apache::compat
change Apache::unescape_url to return the escaped url as 1.x does
1.45 +8 -0 modperl-2.0/lib/Apache/compat.pm
Index: compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- compat.pm 18 May 2002 01:12:15 -0000 1.44
+++ compat.pm 19 May 2002 11:41:53 -0000 1.45
@@ -142,6 +142,14 @@
: scalar($r->table_get_set(scalar($r->headers_in), @_));
}
+sub err_header_out {
+ my $r = shift;
+ return wantarray()
+ ? ($r->table_get_set(scalar($r->err_headers_out), @_))
+ : scalar($r->table_get_set(scalar($r->err_headers_out), @_));
+}
+
+
sub register_cleanup {
shift->pool->cleanup_register(@_);
}
1.7 +47 -43 modperl-2.0/t/response/TestApache/compat2.pm
Index: compat2.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestApache/compat2.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- compat2.pm 14 May 2002 01:14:19 -0000 1.6
+++ compat2.pm 19 May 2002 11:41:53 -0000 1.7
@@ -24,7 +24,7 @@
sub handler {
my $r = shift;
- plan $r, tests => 35;
+ plan $r, tests => 39;
$r->send_http_header('text/plain');
@@ -35,51 +35,55 @@
ok t_cmp('GLOB', ref($fh), "Apache->gensym");
# test header_in and header_out
- for my $way (qw(in out)) {
- my $sub_test = "header_$way";
- my $sub_good = "headers_$way";
- my $key = 'header-test';
-
- # scalar context
- {
- my $key;
- if ($way eq 'in') {
- $key = "user-agent"; # should exist with lwp
+ # and err_header_out
+ for my $prefix ('err_', '') {
+ my @ways = 'out';
+ push @ways, 'in' unless $prefix;
+ for my $way (@ways) {
+ my $sub_test = "${prefix}header_$way";
+ my $sub_good = "${prefix}headers_$way";
+ my $key = 'header-test';
+
+ # scalar context
+ {
+ my $key;
+ if ($way eq 'in') {
+ $key = "user-agent"; # should exist with lwp
+ } else {
+ # outgoing headers aren't set yet, so we set one
+ $key = "X-barabara";
+ $r->$sub_good->set($key, $key x 2);
+ }
+
+ ok t_cmp($r->$sub_good->get($key),
+ $r->$sub_test($key),
+ "\$r->$sub_test in scalar context");
}
- else {
- # outgoing headers aren't set yet, so we set one
- $key = "X-barabara";
- $r->$sub_good->set($key, $key x 2);
+
+ # list context
+ {
+ my @exp = qw(foo bar);
+ $r->$sub_good->add($key => $_) for @exp;
+ ok t_cmp(\@exp,
+ [ $r->$sub_test($key) ],
+ "\$r->$sub_test in list context");
+ }
+
+ # set
+ {
+ my $exp = $key x 2;
+ $r->$sub_test($key => $exp);
+ my $got = $r->$sub_test($key);
+ ok t_cmp($exp, $got, "\$r->$sub_test set()");
}
- ok t_cmp($r->$sub_good->get($key),
- $r->$sub_test($key),
- "\$r->$sub_test in scalar context");
- }
-
- # list context
- {
- my @exp = qw(foo bar);
- $r->$sub_good->add($key => $_) for @exp;
- ok t_cmp(\@exp,
- [ $r->$sub_test($key) ],
- "\$r->$sub_test in list context");
- }
-
- # set
- {
- my $exp = $key x 2;
- $r->$sub_test($key => $exp);
- my $got = $r->$sub_test($key);
- ok t_cmp($exp, $got, "\$r->$sub_test set()");
- }
-
- # unset
- {
- my $exp = undef;
- $r->$sub_test($key => $exp);
- my $got = $r->$sub_test($key);
- ok t_cmp($exp, $got, "\$r->$sub_test unset()");
+ # unset
+ {
+ my $exp = undef;
+ $r->$sub_test($key => $exp);
+ my $got = $r->$sub_test($key);
+ ok t_cmp($exp, $got, "\$r->$sub_test unset()");
+ }
}
}
