Below is a patch from Philippe that should get cgi_header_out()
functionality in the latest mod_perl 2 Apache::compat layer.
This functionality may make it such Apache::ASP works fully
under mod_perl 2. Apache::ASP automatically loads Apache::compat
for you when loading for running under mod_perl 2.
Regards,
Josh
-------- Original Message --------
Subject: [Patch] cgi_header_out() in Apache::compat
From: Philippe M. Chiasson <[EMAIL PROTECTED]>
To: Josh Chamas <[EMAIL PROTECTED]>
Cc: [EMAIL PROTECTED]
On Sun, 2002-10-27 at 07:24, Josh Chamas wrote:
> Hello modperl dev team,
>
> Any change we could get cgi_header_out() implemented in
> the Apache::compat layer. Apache::ASP uses it for cookie headers
> and a user just reported the lack of this throwing errors
> even with Apache::compat loaded.
Here it is, and I believe it should be backwards compatible with the 1.x
version, except for support of $Apache::DoInternalRedirects when
redirecting with a Location: header.
--- /dev/null 2002-08-31 07:31:37.000000000 +0800
+++ t/compat/cgi_header_out.t 2002-10-27 19:31:33.000000000 +0800
@@ -0,0 +1,33 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest;
+
+plan tests => 8;
+
+my $package = 'TestCompat::cgi_header_out';
+my $status = 202;
+my $length = 42;
+
+my $res = GET "/$package?" .
+ "status=$status&" .
+ "content-length=$length&".
+ "content-type=$package&".
+ "x-other=$package&".
+ "set-cookie=$package&".
+ "transfer-encoding=$package";
+
+ok t_cmp ($status, $res->code(), 'Status:');
+ok t_cmp ($length, $res->header('Content-length'), 'Content-length:');
+ok t_cmp ($package, $res->header('Content-type'), 'Content-type:');
+ok t_cmp ($package, $res->header('Transfer-Encoding'), 'Transfer-Encoding:');
+ok t_cmp ($package, $res->header('Set-Cookie'), 'Set-Cookie:');
+ok t_cmp ($package, $res->header('X-Other'), 'Other:');
+
+$res = GET "/$package?location=/$package", redirect_ok => 0;
+ok t_cmp(302, $res->code, 'Location: redirect status code');
+ok t_cmp("/$package", $res->header('Location'), 'Location: redirect');
+
+1;
--- /dev/null 2002-08-31 07:31:37.000000000 +0800
+++ t/response/TestCompat/cgi_header_out.pm 2002-10-27 19:15:00.000000000 +0800
@@ -0,0 +1,23 @@
+package TestCompat::cgi_header_out;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::compat ();
+use Apache::Constants qw(OK);
+
+sub handler {
+ my $r = shift;
+
+ my %args = $r->Apache::args();
+
+ while (my ($key, $value) = each %args) {
+ $r->cgi_header_out($key, $value);
+ }
+
+ $r->print("OK");
+
+ OK;
+}
+
+1;
Index: lib/Apache/compat.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.70
diff -u -b -B -r1.70 compat.pm
--- lib/Apache/compat.pm 21 Oct 2002 20:21:34 -0000 1.70
+++ lib/Apache/compat.pm 27 Oct 2002 11:31:03 -0000
@@ -191,6 +192,44 @@
return wantarray()
? ($r->table_get_set(scalar($r->headers_in), @_))
: scalar($r->table_get_set(scalar($r->headers_in), @_));
+}
+
+sub cgi_header_out {
+ my ($r, $key, $val) = @_;
+ my $retval = $r->headers_out->get($key);
+
+ if(defined $val) {
+ if('content-type' eq lc $key) {
+ $r->content_type($val);
+ }
+ elsif('status' eq lc $key) {
+ $r->status($val);
+ }
+ elsif('location' eq lc $key) {
+ if($val =~ m|^/|) {
+ $r->status(302);
+ $r->headers_out->set($key,$val);
+ }
+ }
+ elsif('content-length' eq lc $key) {
+ $r->set_content_length($val);
+ }
+ elsif('transfer-encoding' eq lc $key) {
+ $r->headers_out->set($key => $val);
+ }
+ elsif('set-cookie' eq lc $key) {
+ #The HTTP specification says that it is legal to merge duplicate
+ #headers into one. Some browsers that support Cookies don't like
+ #merged headers and prefer that each Set-Cookie header is sent
+ #separately. Lets humour those browsers.
+ $r->err_headers_out->add($key => $val);
+ }
+ else {
+ $r->err_header_out->merge($key => $val);
+ }
+ }
+
+ return $retval;
}
sub err_header_out {
Index: todo/api.txt
===================================================================
RCS file: /home/cvspublic/modperl-2.0/todo/api.txt,v
retrieving revision 1.28
diff -u -b -B -r1.28 api.txt
--- todo/api.txt 22 Oct 2002 15:13:22 -0000 1.28
+++ todo/api.txt 27 Oct 2002 11:31:09 -0000
@@ -73,9 +73,6 @@
need to deal with subclass objects which are not a request_rec
(e.g. HASH ref)
-$r->cgi_header_out:
-anything in 1.x land actually using it?
-
$r->slurp_filename:
optimized version not yet implemented (compat version exists in
Apache::compat)
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
