Merge branch 'release/1.3002'

CHANGES

@@ -1,3 +1,21 @@
+Dancer 1.3002
+
+	[ API CHANGES ]
+
+	* to_json and from_json accept options as hashref instead of hash.
+	  Passing arguments as hash is deprecated 
+	  (Franck Cuny).
+
+	[ BUGFIXES ]
+
+	* status is kept even when halt is used in a before filter
+	  (Alexis Sukrieh)
+
+	[ ENHANCEMENTS ]
+
+	* In development, pretty-print JSON serializations for easier development 
+	  (Ask Bjørn Hansen)
+
 Dancer 1.3001
 
 	[ Flavio Poletti ]

MANIFEST

@@ -222,6 +222,7 @@ t/12_response/02_headers.t
 t/12_response/03_charset.t
 t/12_response/04_charset_server.t
 t/12_response/05_api.t
+t/12_response/06_filter_halt_status.t
 t/13_engines/00_load.t
 t/13_engines/02_template_init.t
 t/14_serializer/000_create_fake_env.t

lib/Dancer.pm

@@ -4,8 +4,12 @@ use strict;
 use warnings;
 use Carp;
 use Cwd 'abs_path', 'realpath';
+
 use vars qw($VERSION $AUTHORITY @EXPORT);
 
+$VERSION   = '1.3002';
+$AUTHORITY = 'SUKRIA';
+
 use Dancer::Config;
 use Dancer::FileUtils;
 use Dancer::GetOpt;
@@ -30,8 +34,6 @@ use File::Basename 'basename';
 
 use base 'Exporter';
 
-$AUTHORITY = 'SUKRIA';
-$VERSION   = '1.3001';
 @EXPORT    = qw(
   after
   any

lib/Dancer/Response.pm

@@ -127,8 +127,13 @@ sub halt {
         $CURRENT = $content;
     }
     else {
-        my $resp = Dancer::Response->new(content => $content);
-         $CURRENT = $resp;
+        # FIXME we probably want to do better here, I think this class really deserves a
+        # complete rewrite ;-)
+        my $resp = Dancer::Response->new(
+        status => ($CURRENT->{status} || 200),
+        content => $content,
+        );
+        $CURRENT = $resp;
     }
     $CURRENT->{halted} = 1;
     return $content;

lib/Dancer/Serializer/JSON.pm

@@ -31,25 +31,52 @@ sub init {
 }
 
 sub serialize {
-    my ($self, $entity, %options) = @_;
+    my $self   = shift;
+    my $entity = shift;
+
+    my $options = $self->_options_as_hashref(@_) || {};
 
     # Why doesn't $self->config have this?
     my $config = setting('engines') || {};
     $config = $config->{JSON} || {};
 
-    if ($config->{allow_blessed} && !defined $options{allow_blessed}) {
-        $options{allow_blessed} = $config->{allow_blessed};
+    if ( $config->{allow_blessed} && !defined $options->{allow_blessed} ) {
+        $options->{allow_blessed} = $config->{allow_blessed};
+    }
+    if ( $config->{convert_blessed} ) {
+        $options->{convert_blessed} = $config->{convert_blessed};
     }
-    if ($config->{convert_blessed}) {
-        $options{convert_blessed} = $config->{convert_blessed};
+
+    if (setting('environment') eq 'development' and not defined $options->{pretty}) {
+        $options->{pretty} = 1;
     }
 
-    JSON::to_json($entity, \%options);
+    JSON::to_json( $entity, $options );
 }
 
 sub deserialize {
-    my ($self, $entity, %options) = @_;
-    JSON::from_json($entity, \%options);
+    my $self   = shift;
+    my $entity = shift;
+
+    my $options = $self->_options_as_hashref(@_);
+    JSON::from_json( $entity, $options );
+}
+
+sub _options_as_hashref {
+    my $self = shift;
+
+    return if scalar @_ == 0;
+
+    if ( scalar @_ == 1 ) {
+        return shift;
+    }
+    elsif ( scalar @_ % 2 ) {
+        carp "options for to_json/from_json must be key value pairs (as a hashref)";
+    }
+    else {
+        carp "options as hash for to_json/from_json is DEPRECATED. please pass a hashref.";
+        return { @_ };
+    }
 }
 
 sub content_type {'application/json'}

t/12_response/03_charset.t

@@ -9,6 +9,8 @@ use Encode;
 
 plan tests => 16;
 
+set environment => 'production';
+
 my $res = Dancer::Response->new(headers => [ 'Content-Type' => 'text/html' ], content_type => 'text/html');
 my $psgi_res = Dancer::Handler->render_response($res);
 is(@$psgi_res, 3);

t/12_response/06_filter_halt_status.t

@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+use Test::More;
+
+# make sure we keep the status when halt is used
+
+{
+    package SomeApp;
+    use Dancer;
+
+    set serializer => 'JSON';
+    set environment => 'production';
+
+    before sub {
+        if (params->{'troll'}) {
+            status 401;
+            return halt({error => "Go away you troll!"})
+        }
+    };
+
+    get '/' => sub {
+        "root"
+    };
+}
+
+use Dancer::Test;
+
+my @tests = (
+    ['/', {}, 200, 'root'],
+    ['/', {troll => 1}, 401, 
+        '{"error":"Go away you troll!"}'],
+    );
+
+plan tests => scalar(@tests) * 2;
+
+for my $t (@tests) {
+    my ($path, $params, $status, $content) = @{ $t };
+
+    my $resp = dancer_response(GET => $path, { params => $params });
+    is $resp->{status}, $status, "status is $status";
+    is $resp->{content}, $content, "content is $content";
+}
+
+

t/14_serializer/02_json.t

@@ -5,7 +5,7 @@ use Dancer;
 
 plan skip_all => "JSON is needed to run this tests"
     unless Dancer::ModuleLoader->load('JSON');
-plan tests => 14;
+plan tests => 17;
 
 eval {
     setting serializer => 'FooBar';
@@ -23,21 +23,24 @@ isa_ok($s, $_) for qw(
 can_ok $s, qw(serialize deserialize);
 
 my $data = { foo => 42 };
-my $json = $s->serialize($data);
+my $json = $s->serialize($data, { pretty => 0 });
 is $json, '{"foo":42}', "data is correctly serialized";
 my $data2 = $s->deserialize($json);
 is_deeply $data2, $data, "data is correctly deserialized";
 
 # helpers
 
 $json = to_json($data);
-is $json, '{"foo":42}', "data is correctly serialized";
+is $json, '{
+   "foo" : 42
+}
+', "data is correctly serialized";
 
 $data2 = from_json($json);
 is_deeply($data2, $data, "data is correctly deserialized");
 
 $data = {foo => {bar => {baz => [qw/23 42/]}}};
-$json = to_json($data, pretty => 1);
+$json = to_json($data, {pretty => 1});
 like $json, qr/"foo" : {/, "data is pretty!";
 $data2 = from_json($json);
 is_deeply($data2, $data, "data is correctly deserialized");
@@ -47,6 +50,7 @@ my $config = {
         JSON => {
             allow_blessed   => 1,
             convert_blessed => 1,
+            pretty          => 0,
         }
     }
 };
@@ -56,3 +60,16 @@ ok $s = Dancer::Serializer->init( 'JSON', $config ),
 $data = { foo => 'bar' };
 my $res = $s->serialize($data);
 is_deeply( $data, JSON::decode_json($res), 'data is correctly serialized' );
+
+# XXX tests for deprecation
+my $warn;
+local $SIG{__WARN__} = sub { $warn = $_[0] };
+$s->_options_as_hashref(foo => 'bar');
+ok $warn, 'deprecation warning';
+undef $warn;
+
+$s->_options_as_hashref({foo => 'bar'});
+ok !$warn, 'no deprecation warning';
+
+to_json({foo => 'bar'}, indent => 0);
+ok $warn, 'deprecation warning';

t/14_serializer/04_mutable.t

@@ -13,6 +13,8 @@ BEGIN {
 
 plan tests => 17;
 
+set environment => 'production';
+
 ok(setting('serializer' => 'Mutable'), "serializer Mutable loaded");
 my $s = Dancer::Serializer->engine;
 

t/14_serializer/05_live.t

@@ -2,6 +2,9 @@ use strict;
 use warnings;
 use Test::More import => ['!pass'];
 
+use Carp;
+$Carp::Verbose = 1;
+
 BEGIN {
     use Dancer::ModuleLoader;
 
@@ -18,6 +21,7 @@ use LWP::UserAgent;
 use HTTP::Request;
 
 plan tests => 30;
+set environment => 'production';
 
 test_json();
 test_yaml();

t/14_serializer/06_serialize_response.t

@@ -15,6 +15,7 @@ my $json = JSON::encode_json($data);
     use Dancer ':syntax';
 
     set serializer => 'JSON';
+    set environment => 'production';
 
     get '/data' => sub {
         $data;

t/14_serializer/14_show_errors.t

@@ -36,6 +36,7 @@ Test::TCP::test_tcp(
         setting port => $port;
         setting access_log => 0;
         setting serializer => 'JSON';
+        set environment => 'production';
 
         get '/with_errors' => sub {
             setting show_errors => 1;

t/lib/TestSerializer.pm

@@ -5,7 +5,7 @@ use Dancer;
 setting serializer => 'JSON';
 
 get '/json' => sub {
-    to_json({foo => 'bar'}, pretty => 1);
+    to_json({foo => 'bar'}, { pretty => 1});
 };
 
 get '/' => sub {