Merge branch 'master' of git://github.com/bobtfish/catalyst-action-rest

Changes

@@ -1,3 +1,18 @@
+  Fix test if CATALYST_DEBUG environment variable is set
+
+Fri Aug 21 21:20:52 BST 2009 (t0m) - Release 0.76
+
+  Added two new status response helpers (202 no content and 410 gone),
+  and tests - Franck Cuny
+
+Mon Aug 17 14:07:41 BST 2009 (t0m) - Release 0.75
+
+  Fix optional test failures in catalyst-action-serialize-accept.t
+
+  Added a serializer for JSON::XS
+
+  Made test independent of YAML::Syck bugs (dandv)
+
 Wed Jul 22 23:49:16 BST 2009 (t0m) - Release 0.74
 
   Switch from NEXT to MRO::Compat (agladdish).

README

@@ -2,7 +2,7 @@ NAME
     Catalyst::Controller::REST - A RESTful controller
 
 VERSION
-    0.73
+    0.75
 
 SYNOPSIS
         package Foo::Controller::Bar;

lib/Catalyst/Action/REST.pm

@@ -17,7 +17,8 @@ use Catalyst::Controller::REST;
 
 BEGIN { require 5.008001; }
 
-our $VERSION = '0.74';
+our $VERSION = '0.76';
+$VERSION = eval $VERSION;
 
 sub new {
   my $class  = shift;

lib/Catalyst/Action/Serialize/JSON.pm

@@ -24,7 +24,7 @@ sub execute {
         ) || 'rest';
     my $output;
     eval {
-        $output = encode_json( $c->stash->{$stash_key} );
+        $output = $self->serialize( $c->stash->{$stash_key} );
     };
     if ($@) {
         return $@;
@@ -33,4 +33,9 @@ sub execute {
     return 1;
 }
 
+sub serialize {
+    my $self = shift;
+    encode_json( shift );
+}
+
 1;

lib/Catalyst/Action/Serialize/JSON/XS.pm

@@ -0,0 +1,14 @@
+package Catalyst::Action::Serialize::JSON::XS;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action::Serialize::JSON';
+use JSON::XS qw(encode_json);
+
+sub serialize {
+    my $self = shift;
+    encode_json( shift );
+}
+
+1;

lib/Catalyst/Action/Serialize/YAML.pm

@@ -24,7 +24,7 @@ sub execute {
         ) || 'rest';
     my $output;
     eval {
-        $output = Dump($c->stash->{$stash_key});
+        $output = $self->serialize($c->stash->{$stash_key});
     };
     if ($@) {
         return $@;
@@ -33,4 +33,10 @@ sub execute {
     return 1;
 }
 
+sub serialize {
+    my $self = shift;
+    my $data = shift;
+    Dump($data);
+}
+
 1;

lib/Catalyst/Controller/REST.pm

@@ -1,6 +1,9 @@
 package Catalyst::Controller::REST;
+use strict;
+use warnings;
 
-our $VERSION = '0.74';
+our $VERSION = '0.76';
+$VERSION = eval $VERSION;
 
 =head1 NAME
 
@@ -167,8 +170,8 @@ you serialize be a HASHREF, we transform outgoing data to be in the form of:
 Uses a regular Catalyst view.  For example, if you wanted to have your
 C<text/html> and C<text/xml> views rendered by TT:
 
-	'text/html' => [ 'View', 'TT' ],
-	'text/xml'  => [ 'View', 'XML' ],
+  'text/html' => [ 'View', 'TT' ],
+  'text/xml'  => [ 'View', 'XML' ],
 
 Will do the trick nicely.
 
@@ -179,7 +182,7 @@ response if an attempt to use an unsupported content-type is made.  You
 can ensure that something is always returned by setting the C<default>
 config option:
 
-   __PACKAGE__->config->{'default'} = 'text/x-yaml';
+  __PACKAGE__->config->{'default'} = 'text/x-yaml';
 
 Would make it always fall back to the serializer plugin defined for text/x-yaml.
 
@@ -209,8 +212,6 @@ such require you pass the current context ($c) as the first argument.
 
 =cut
 
-use strict;
-use warnings;
 use base 'Catalyst::Controller';
 use Params::Validate qw(SCALAR OBJECT);
 
@@ -331,6 +332,20 @@ sub status_accepted {
     return 1;
 }
 
+=item status_no_content
+
+Returns a "204 NO CONTENT" response.
+
+=cut
+
+sub status_no_content {
+    my $self = shift;
+    my $c    = shift;
+    $c->response->status(204);
+    $self->_set_entity( $c, undef );
+    return 1.;
+}
+
 =item status_bad_request
 
 Returns a "400 BAD REQUEST" response.  Takes a "message" argument
@@ -383,6 +398,31 @@ sub status_not_found {
     return 1;
 }
 
+=item gone
+
+Returns a "41O GONE" response.  Takes a "message" argument as a scalar,
+which will become the value of "error" in the serialized response.
+
+Example:
+
+  $self->status_gone(
+    $c,
+    message => "The document have been deleted by foo",
+  );
+
+=cut
+
+sub status_gone {
+    my $self = shift;
+    my $c    = shift;
+    my %p    = Params::Validate::validate( @_, { message => { type => SCALAR }, }, );
+
+    $c->response->status(410);
+    $c->log->debug( "Status Gone " . $p{'message'} ) if $c->debug;
+    $self->_set_entity( $c, { error => $p{'message'} } );
+    return 1;
+}
+
 sub _set_entity {
     my $self   = shift;
     my $c      = shift;

t/catalyst-action-serialize-accept.t

@@ -6,31 +6,32 @@ use FindBin;
 
 use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib", "$FindBin::Bin/broken");
 use Test::Rest;
+use Catalyst::Action::Serialize::YAML;
 
-# Should use Data::Dumper, via YAML 
+# Should use Data::Dumper, via YAML
 my $t = Test::Rest->new('content_type' => 'text/x-yaml');
 
 use_ok 'Catalyst::Test', 'Test::Catalyst::Action::REST';
 
-my $data = <<EOH;
---- 
-lou: is my cat
-EOH
+# to avoid whatever serialization bugs YAML::Syck has,
+# e.g. http://rt.cpan.org/Public/Bug/Display.html?id=46983,
+# we won't hardcode the expected output
+my $output_YAML = Catalyst::Action::Serialize::YAML->serialize({lou => 'is my cat'});
 
 {
-	my $req = $t->get(url => '/serialize/test');
-	$req->remove_header('Content-Type');
-	$req->header('Accept', 'text/x-yaml');
-	my $res = request($req);
+    my $req = $t->get(url => '/serialize/test');
+    $req->remove_header('Content-Type');
+    $req->header('Accept', 'text/x-yaml');
+    my $res = request($req);
     SKIP: {
         skip "can't test text/x-yaml without YAML support",
-        3 if ( 
-                not $res->is_success and 
-                $res->content =~ m#Content-Type text/x-yaml is not supported# 
+        3 if (
+                not $res->is_success and
+                $res->content =~ m#Content-Type text/x-yaml is not supported#
              );
-	    ok( $res->is_success, 'GET the serialized request succeeded' );
-	    is( $res->content, $data, "Request returned proper data");
-	    is( $res->header('Content-type'), 'text/x-yaml', '... with expected content-type')
+        ok( $res->is_success, 'GET the serialized request succeeded' );
+        is( $res->content, $output_YAML, "Request returned proper data");
+        is( $res->header('Content-type'), 'text/x-yaml', '... with expected content-type')
 
     };
 }
@@ -40,51 +41,51 @@ SKIP: {
     skip "can't test application/json without JSON support", 3 if $@;
     my $json = JSON->new;
     my $at = Test::Rest->new('content_type' => 'text/doesnt-exist');
-	my $req = $at->get(url => '/serialize/test');
-	$req->header('Accept', 'application/json');
-	my $res = request($req);
+    my $req = $at->get(url => '/serialize/test');
+    $req->header('Accept', 'application/json');
+    my $res = request($req);
     ok( $res->is_success, 'GET the serialized request succeeded' );
     my $ret = $json->decode($res->content);
     is( $ret->{lou}, 'is my cat', "Request returned proper data");
     is( $res->header('Content-type'), 'application/json', 'Accept header used if content-type mapping not found')
 };
 
-# Make sure we don't get a bogus content-type when using default
-# serializer (rt.cpan.org ticket 27949)
+# Make sure we don't get a bogus content-type when using the default
+# serializer (https://rt.cpan.org/Ticket/Display.html?id=27949)
 {
-	my $req = $t->get(url => '/serialize/test');
-	$req->remove_header('Content-Type');
-	$req->header('Accept', '*/*');
-	my $res = request($req);
-	ok( $res->is_success, 'GET the serialized request succeeded' );
-	is( $res->content, $data, "Request returned proper data");
-	is( $res->header('Content-type'), 'text/x-yaml', '... with expected content-type')
+    my $req = $t->get(url => '/serialize/test');
+    $req->remove_header('Content-Type');
+    $req->header('Accept', '*/*');
+    my $res = request($req);
+    ok( $res->is_success, 'GET the serialized request succeeded' );
+    is( $res->content, $output_YAML, "Request returned proper data");
+    is( $res->header('Content-type'), 'text/x-yaml', '... with expected content-type')
 }
 
-# Make that using content_type_stash_key, an invalid value in the stash gets ignored
+# Make sure that when using content_type_stash_key, an invalid value in the stash gets ignored
 {
-	my $req = $t->get(url => '/serialize/test_second?serialize_content_type=nonesuch');
-	$req->remove_header('Content-Type');
-	$req->header('Accept', '*/*');
-	my $res = request($req);
-	ok( $res->is_success, 'GET the serialized request succeeded' );
-	is( $res->content, $data, "Request returned proper data");
-	is( $res->header('Content-type'), 'text/x-yaml', '... with expected content-type')
+    my $req = $t->get(url => '/serialize/test_second?serialize_content_type=nonesuch');
+    $req->remove_header('Content-Type');
+    $req->header('Accept', '*/*');
+    my $res = request($req);
+    ok( $res->is_success, 'GET the serialized request succeeded' );
+    is( $res->content, $output_YAML, "Request returned proper data");
+    is( $res->header('Content-type'), 'text/x-yaml', '... with expected content-type')
 }
 
-# Make that using content_type_stash_key, a valid value in the stash gets priority
-# this also tests that application-level config is properly passed to
+# Make sure that when using content_type_stash_key, a valid value in the stash gets priority.
+# This also tests that application-level config is properly passed to
 # individual controllers; see t/lib/Test/Catalyst/Action/REST.pm
 {
-	my $req = $t->get(url =>
-	    '/serialize/test_second?serialize_content_type=text/x-data-dumper'
-	);
-	$req->remove_header('Content-Type');
-	$req->header('Accept', '*/*');
-	my $res = request($req);
-	ok( $res->is_success, 'GET the serialized request succeeded' );
-	is( $res->content, "{'lou' => 'is my cat'}", "Request returned proper data");
-	is( $res->header('Content-type'), 'text/x-data-dumper', '... with expected content-type')
+    my $req = $t->get(url =>
+        '/serialize/test_second?serialize_content_type=text/x-data-dumper'
+    );
+    $req->remove_header('Content-Type');
+    $req->header('Accept', '*/*');
+    my $res = request($req);
+    ok( $res->is_success, 'GET the serialized request succeeded' );
+    is( $res->content, "{'lou' => 'is my cat'}", "Request returned proper data");
+    is( $res->header('Content-type'), 'text/x-data-dumper', '... with expected content-type')
 }
 
 1;

t/catalyst-controller-rest.t

@@ -1,6 +1,6 @@
 use strict;
 use warnings;
-use Test::More tests => 2;
+use Test::More tests => 18;
 use YAML::Syck;
 use FindBin;
 
@@ -19,3 +19,32 @@ is_deeply(
   { test => 'worked', data => $data },
   'round trip (deserialize/serialize)',
 );
+
+
+ok my $res = request( $t->get( url => '/rest/test_status_created' ) );
+is $res->code, 201, "... status created";
+
+ok $res = request( $t->get( url => '/rest/test_status_accepted' ) );
+is $res->code, 202, "... status accepted";
+
+ok $res = request( $t->get( url => '/rest/test_status_no_content' ) );
+is $res->code, 204, "... status no content";
+is $res->content, '', '... no content';
+
+ok $res = request( $t->get( url => '/rest/test_status_bad_request' ) );
+is $res->code, 400, '... status bad request';
+is_deeply Load( $res->content ),
+    { error => "Cannot do what you have asked!" },
+    "...  status bad request message";
+
+ok $res = request( $t->get( url => '/rest/test_status_not_found' ) );
+is $res->code, 404, '... status not found';
+is_deeply Load( $res->content ),
+    { error => "Cannot find what you were looking for!" },
+    "...  status bad request message";
+
+ok $res = request( $t->get( url => '/rest/test_status_gone' ) );
+is $res->code, 410, '... status gone';
+is_deeply Load( $res->content ),
+    { error => "Document have been deleted by foo" },
+    "...  status gone message";

t/catalyst-request-rest.t

@@ -168,6 +168,8 @@ use HTTP::Headers;
 }
 
 {
+  local %ENV=%ENV;
+  $ENV{CATALYST_DEBUG} = 0;
   my $test = 'Test::Catalyst::Action::REST';
   use_ok $test;
   is($test->request_class, 'Catalyst::Request::REST',