Merge branch 'master' into gsoc_breadboard
André Walker [Thu, 6 Oct 2011 12:51:41 +0000 (09:51 -0300)]
Changes
lib/Catalyst.pm
lib/Catalyst/Controller.pm
lib/Catalyst/Engine/HTTP.pm
lib/Catalyst/Response.pm
lib/Catalyst/Runtime.pm
lib/Catalyst/Script/Server.pm
t/aggregate/unit_core_controller_actions_config.t [new file with mode: 0644]
t/lib/TestApp/Controller/Action/ConfigSmashArrayRefs.pm [new file with mode: 0644]
t/live_fork.t
t/live_redirect_body.t [moved from t/aggregate/live_redirect_body.t with 98% similarity]

diff --git a/Changes b/Changes
index 7133408..4228e94 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,17 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+5.90003 - 2011-10-05 08:32:00
+  Bug fixes:
+
+   - Make default body reponses for 302s W3C compliant. RT#71237
+
+   - Fix issue where groups of attributes to override controller actions
+     in config would be (incorrectly) overwritten, if the parser for that
+     attribute mangled the contents of the attribute. This was found
+     with Catalyst::Controller::ActionRole, where Does => [ '+Foo' ]
+     would be transformed to Does => [ 'Foo' ] and written back to config,
+     whereas Does => '+Foo' would not be changed in config. RT#65463
+
   Enhancements:
 
    - Set a matching Content-type for the redirect if Catalyst sets the
    - Document Catalyst::Plugin::Authentication fails tests unless
      you use the latest version with Catalyst 5.9
 
+   - Clarify that prepare is called as a class method
+
+   - Clarify use of uri_for further. RT#57011
+
 5.90002 - 2011-08-22 21:44:00
   Backward compatibility fixes:
 
index 1b47918..1522bf5 100644 (file)
@@ -83,7 +83,7 @@ __PACKAGE__->stats_class('Catalyst::Stats');
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.90002';
+our $VERSION = '5.90003';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -1710,9 +1710,17 @@ sub finalize_headers {
 
         if ( !$response->has_body ) {
             # Add a default body if none is already present
-            $response->body(
-                qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
-            );
+            $response->body(<<"EOF");
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml"> 
+  <head>
+    <title>Moved</title>
+  </head>
+  <body>
+     <p>This item has moved <a href="$location">here</a>.</p>
+  </body>
+</html>
+EOF
             $response->content_type('text/html; charset=utf-8');
         }
     }
@@ -1824,7 +1832,7 @@ sub handle_request {
     return $status;
 }
 
-=head2 $c->prepare( @arguments )
+=head2 $class->prepare( @arguments )
 
 Creates a Catalyst context from an engine-specific request (Apache, CGI,
 etc.).
index cc1a514..31b96d2 100644 (file)
@@ -327,7 +327,9 @@ sub _parse_attrs {
 
     %raw_attributes = (
         %raw_attributes,
-        exists $actions_config->{$name} ? %{ $actions_config->{$name } } : (),
+        # Note we deep copy array refs here to stop crapping on config
+        # when attributes are parsed. RT#65463
+        exists $actions_config->{$name} ? map { ref($_) eq 'ARRAY' ? [ @$_ ] : $_ } %{ $actions_config->{$name } } : (),
     );
 
     # Private actions with additional attributes will raise a warning and then
index e354a8a..526fec9 100644 (file)
@@ -5,6 +5,17 @@ use warnings;
 
 use base 'Catalyst::Engine';
 
+warn("You are loading Catalyst::Engine::HTTP explicitly.
+
+This is almost certainally a bad idea, as Catalyst::Engine::HTTP
+has been removed in this version of Catalyst.
+
+Please update your application's scripts with:
+
+  catalyst.pl -force -scripts MyApp
+
+to update your scripts to not do this.\n");
+
 1;
 
 # This is here only as some old generated scripts require Catalyst::Engine::HTTP
index 818ae86..1e1e4bf 100644 (file)
@@ -14,6 +14,7 @@ has status    => (is => 'rw', default => 200);
 has finalized_headers => (is => 'rw', default => 0);
 has headers   => (
   is      => 'rw',
+  isa => 'HTTP::Headers',
   handles => [qw(content_encoding content_length content_type header)],
   default => sub { HTTP::Headers->new() },
   required => 1,
@@ -148,6 +149,12 @@ redirect destination, and then sets the response status.  You will
 want to C< return > or C<< $c->detach() >> to interrupt the normal
 processing flow if you want the redirect to occur straight away.
 
+B<Note:> do not give a relative URL as $url, i.e: one that is not fully
+qualified (= C<http://...>, etc.) or that starts with a slash
+(= C</path/here>). While it may work, it is not guaranteed to do the right
+thing and is not a standard behaviour. You may opt to use uri_for() or
+uri_for_action() instead.
+
 =cut
 
 sub redirect {
index 3d9f95f..f9b880c 100644 (file)
@@ -7,7 +7,7 @@ BEGIN { require 5.008004; }
 
 # Remember to update this in Catalyst as well!
 
-our $VERSION = '5.90002';
+our $VERSION = '5.90003';
 
 =head1 NAME
 
index df61d9d..2de60b9 100644 (file)
@@ -163,7 +163,7 @@ has follow_symlinks => (
 
 sub _plack_engine_name {
     my $self = shift;
-    return $self->fork ? 'Starman' : $self->keepalive ? 'Starman' : 'Standalone';
+    return $self->fork || $self->keepalive ? 'Starman' : 'Standalone';
 }
 
 sub _restarter_args {
diff --git a/t/aggregate/unit_core_controller_actions_config.t b/t/aggregate/unit_core_controller_actions_config.t
new file mode 100644 (file)
index 0000000..1709650
--- /dev/null
@@ -0,0 +1,12 @@
+use strict;
+use warnings;
+use Test::More;
+use FindBin qw/ $Bin /;
+use lib "$Bin/../lib";
+
+use TestApp;
+
+is(TestApp->controller("Action::ConfigSmashArrayRefs")->config->{action}{foo}{CustomAttr}[0], 'Bar', 'Config un-mangled. RT#65463');
+
+done_testing;
+
diff --git a/t/lib/TestApp/Controller/Action/ConfigSmashArrayRefs.pm b/t/lib/TestApp/Controller/Action/ConfigSmashArrayRefs.pm
new file mode 100644 (file)
index 0000000..5f77f41
--- /dev/null
@@ -0,0 +1,22 @@
+package TestApp::Controller::Action::ConfigSmashArrayRefs;
+
+use strict;
+use base 'Catalyst::Controller';
+
+ sub foo : Action {}
+
+# check configuration for an inherited action
+__PACKAGE__->config(
+    action => {
+        foo => { CustomAttr => [ 'Bar' ] }
+    }
+);
+
+sub _parse_CustomAttr_attr {
+    my ($self, $app, $name, $value) = @_;
+    return CustomAttr => "PoopInYourShoes";
+}
+
+
+1;
+
index 1fefc2a..9c053e3 100644 (file)
@@ -23,37 +23,46 @@ plan skip_all => 'Using remote server (and REMOTE_FORK not set)'
 plan skip_all => 'Skipping fork tests: no /bin/ls'
     if !-e '/bin/ls'; # see if /bin/ls exists
 
-plan tests => 13; # otherwise
-
 {
     ok(my $result = get('/fork/system/%2Fbin%2Fls'), 'system');
-    my @result = split /$/m, $result;
-    $result = join q{}, @result[-4..-1];
 
-    my $result_ref = eval { Load($result) };
-    ok($result_ref, 'is YAML');
-    is($result_ref->{result}, 0, 'exited OK');
+    if (my $result_ref = result_ok($result)) {
+        ok($result_ref, 'is YAML');
+        is($result_ref->{result}, 0, 'exited OK');
+    }
 }
 
 {
     ok(my $result = get('/fork/backticks/%2Fbin%2Fls'), '`backticks`');
-    my @result = split /$/m, $result;
-    $result = join q{}, @result[-4..-1];
-
-    my $result_ref = eval { Load($result) };
-    ok($result_ref, 'is YAML');
-    is($result_ref->{code}, 0, 'exited successfully');
-    like($result_ref->{result}, qr{^/bin/ls[^:]}, 'contains ^/bin/ls$');
-    like($result_ref->{result}, qr{\n.*\n}m, 'contains two newlines');
+
+    if (my $result_ref = result_ok($result)) {
+        ok($result_ref, 'is YAML');
+        is($result_ref->{code}, 0, 'exited successfully');
+        like($result_ref->{result}, qr{^/bin/ls[^:]}, 'contains ^/bin/ls$');
+        like($result_ref->{result}, qr{\n.*\n}m, 'contains two newlines');
+    }
 }
+
 {
     ok(my $result = get('/fork/fork'), 'fork');
-    my @result = split /$/m, $result;
-    $result = join q{}, @result[-4..-1];
-
-    my $result_ref = eval { Load($result) };
-    ok($result_ref, 'is YAML');
-    isnt($result_ref->{pid}, 0, q{fork's "pid" wasn't 0});
-    isnt($result_ref->{pid}, $$, 'fork got a new pid');
-    is($result_ref->{result}, 'ok', 'fork was effective');
+
+    if (my $result_ref = result_ok($result)) {
+        ok($result_ref, 'is YAML');
+        isnt($result_ref->{pid}, 0, q{fork's "pid" wasn't 0});
+        isnt($result_ref->{pid}, $$, 'fork got a new pid');
+        is($result_ref->{result}, 'ok', 'fork was effective');
+    }
+}
+
+sub result_ok {
+    my $result = shift;
+
+    unlike( $result, qr/FATAL/, 'result is not an error' )
+        or return;
+
+    $result =~ s/\r\n|\r/\n/g;
+
+    return eval { Load($result) };
 }
+
+done_testing;
similarity index 98%
rename from t/aggregate/live_redirect_body.t
rename to t/live_redirect_body.t
index c7bb241..b6d4c96 100644 (file)
@@ -1,5 +1,5 @@
 use FindBin;
-use lib "$FindBin::Bin/../lib";
+use lib "$FindBin::Bin/lib";
 use Catalyst::Test 'TestApp', {default_host => 'default.com'};
 use Catalyst::Request;