[Catalyst-commits] r13965 - in Catalyst-Runtime/5.80/trunk: . lib/Catalyst t/aggregate t/lib/TestApp/Controller

[t0m at dev.catalyst.perl.org]

Author: t0m
Date: 2011-02-14 21:35:11 +0000 (Mon, 14 Feb 2011)
New Revision: 13965

Added:
   Catalyst-Runtime/5.80/trunk/t/aggregate/live_engine_response_body.t
Modified:
   Catalyst-Runtime/5.80/trunk/Changes
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Response.pm
   Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Root.pm
Log:
Fix body predicate bug/back compat issue

Modified: Catalyst-Runtime/5.80/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.80/trunk/Changes	2011-02-14 21:12:25 UTC (rev 13964)
+++ Catalyst-Runtime/5.80/trunk/Changes	2011-02-14 21:35:11 UTC (rev 13965)
@@ -1,5 +1,12 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+Bug fixes:
+  - Fix compatibility issue with code which was testing the value of
+    $c->res->body multiple times. Previously this would cause the value
+    to be built, and ergo cause the $c->res->has_body predicate to start
+    returning true.
+    Having a response body is indicated by $c->res->body being defined.
+
 5.80031 2011-01-31 08:13:02
 
  Bug fixes:

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Response.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Response.pm	2011-02-14 21:12:25 UTC (rev 13964)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Response.pm	2011-02-14 21:35:11 UTC (rev 13965)
@@ -6,7 +6,8 @@
 with 'MooseX::Emulate::Class::Accessor::Fast';
 
 has cookies   => (is => 'rw', default => sub { {} });
-has body      => (is => 'rw', default => undef, lazy => 1, predicate => 'has_body');
+has body      => (is => 'rw', default => undef);
+sub has_body { defined($_[0]->body) }
 
 has location  => (is => 'rw');
 has status    => (is => 'rw', default => 200);

Added: Catalyst-Runtime/5.80/trunk/t/aggregate/live_engine_response_body.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/aggregate/live_engine_response_body.t	                        (rev 0)
+++ Catalyst-Runtime/5.80/trunk/t/aggregate/live_engine_response_body.t	2011-02-14 21:35:11 UTC (rev 13965)
@@ -0,0 +1,14 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Test::More;
+use Catalyst::Test 'TestApp';
+
+ok( request('/body_semipredicate')->is_success );
+
+done_testing;

Modified: Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Root.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Root.pm	2011-02-14 21:12:25 UTC (rev 13964)
+++ Catalyst-Runtime/5.80/trunk/t/lib/TestApp/Controller/Root.pm	2011-02-14 21:35:11 UTC (rev 13965)
@@ -75,6 +75,13 @@
     $c->response->body($body);
 }
 
+sub body_semipredicate : Local {
+    my ($self, $c) = @_;
+    $c->res->body; # Old code tests length($c->res->body), which causes the value to be built (undef), which causes the predicate
+    $c->res->status( $c->res->has_body ? 500 : 200 ); # to return the wrong thing, resulting in a 500.
+    $c->res->body('Body');
+}
+
 sub end : Private {
     my ($self,$c) = @_;
 }