New test for no Args() order mismatch

[catagits/Catalyst-Runtime.git] / lib / Catalyst / Engine.pm

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index 80ff49f..ce90738 100644 (file)
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -2,12 +2,13 @@ package Catalyst::Engine;
 
 use strict;
 use base 'Class::Accessor::Fast';
-use CGI::Cookie;
-use Data::Dumper;
+use CGI::Simple::Cookie;
+use Data::Dump qw/dump/;
 use HTML::Entities;
 use HTTP::Body;
 use HTTP::Headers;
 use URI::QueryParam;
+use Scalar::Util ();
 
 # input position and length
 __PACKAGE__->mk_accessors(qw/read_position read_length/);
@@ -54,7 +55,8 @@ sub finalize_body {
 
 =head2 $self->finalize_cookies($c)
 
-Create CGI::Cookies from $c->res->cookies, and set them as response headers.
+Create CGI::Simple::Cookie objects from $c->res->cookies, and set them as
+response headers.
 
 =cut
 
@@ -62,15 +64,22 @@ sub finalize_cookies {
     my ( $self, $c ) = @_;
 
     my @cookies;
-    while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
-
-        my $cookie = CGI::Cookie->new(
-            -name    => $name,
-            -value   => $cookie->{value},
-            -expires => $cookie->{expires},
-            -domain  => $cookie->{domain},
-            -path    => $cookie->{path},
-            -secure  => $cookie->{secure} || 0
+
+    foreach my $name ( keys %{ $c->response->cookies } ) {
+
+        my $val = $c->response->cookies->{$name};
+
+        my $cookie = (
+            Scalar::Util::blessed($val)
+            ? $val
+            : CGI::Simple::Cookie->new(
+                -name    => $name,
+                -value   => $val->{value},
+                -expires => $val->{expires},
+                -domain  => $val->{domain},
+                -path    => $val->{path},
+                -secure  => $val->{secure} || 0
+            )
         );
 
         push @cookies, $cookie->as_string;
@@ -99,7 +108,6 @@ sub finalize_error {
     if ( $c->debug ) {
 
         # For pretty dumps
-        local $Data::Dumper::Terse = 1;
         $error = join '', map {
                 '<p><code class="error">'
               . encode_entities($_)
@@ -120,15 +128,11 @@ sub finalize_error {
         # Don't show response header state in dump
         delete $c->res->{_finalized_headers};
 
-        my $req   = _fixup_debug_info($c->req);
-        my $res   = _fixup_debug_info($c->res);
-        my $stash = _fixup_debug_info($c->stash);
-
         my @infos;
         my $i = 0;
         for my $dump ( $c->dump_these ) {
             my $name  = $dump->[0];
-            my $value = encode_entities( Dumper $dump->[1] );
+            my $value = encode_entities( dump( $dump->[1] ));
             push @infos, sprintf <<"EOF", $name, $value;
 <h2><a href="#" onclick="toggleDump('dump_$i'); return false">%s</a></h2>
 <div id="dump_$i">
@@ -365,7 +369,7 @@ sub prepare_connection { }
 
 =head2 $self->prepare_cookies($c)
 
-Parse cookies from header. Sets a L<CGI::Cookie> object.
+Parse cookies from header. Sets a L<CGI::Simple::Cookie> object.
 
 =cut
 
@@ -373,7 +377,7 @@ sub prepare_cookies {
     my ( $self, $c ) = @_;
 
     if ( my $header = $c->request->header('Cookie') ) {
-        $c->req->cookies( { CGI::Cookie->parse($header) } );
+        $c->req->cookies( { CGI::Simple::Cookie->parse($header) } );
     }
 }
 
@@ -393,13 +397,15 @@ sub prepare_parameters {
     my ( $self, $c ) = @_;
 
     # We copy, no references
-    while ( my ( $name, $param ) = each %{ $c->request->query_parameters } ) {
+    foreach my $name ( keys %{ $c->request->query_parameters } ) {
+        my $param = $c->request->query_parameters->{$name};
         $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
         $c->request->parameters->{$name} = $param;
     }
 
     # Merge query and body parameters
-    while ( my ( $name, $param ) = each %{ $c->request->body_parameters } ) {
+    foreach my $name ( keys %{ $c->request->body_parameters } ) {
+        my $param = $c->request->body_parameters->{$name};
         $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
         if ( my $old_param = $c->request->parameters->{$name} ) {
             if ( ref $old_param eq 'ARRAY' ) {
@@ -576,12 +582,6 @@ sub write {
     print STDOUT $buffer;
 }
 
-sub _fixup_debug_info {
-    my $info   = encode_entities Dumper shift;
-     my @info = split "\n", $info; 
-     pop @info; shift @info;
-     return join "\n",@info;    
-}
 
 =head2 $self->finalize_output