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)
> Thanks,
>
> Josh
> ________________________________________________________________
> Josh Chamas, Founder phone:925-552-0128
> Chamas Enterprises Inc. http://www.chamas.com
> NodeWorks Link Checking http://www.nodeworks.com
>
>
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: [EMAIL PROTECTED]
> For additional commands, e-mail: [EMAIL PROTECTED]
>
>
--
--------------------------------------------------------------------------------
Philippe M. Chiasson /gozer\@(cpan|ectoplasm)\.org/ 88C3A5A5
(122FF51B/C634E37B)
http://gozer.ectoplasm.org/ F9BF E0C2 480E 7680 1AE5 3631 CB32 A107
88C3 A5A5
Q: It is impossible to make anything foolproof because fools are so
ingenious.
perl
-e'$$=\${gozer};{$_=unpack(P7,pack(L,$$));/^JAm_pH\n$/&&print||$$++&&redo}'
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
