From: adam <adam@4ad37cd2-5fec-0310-835f-b3785c72a374>
Date: Mon, 16 Oct 2006 21:45:18 +0000 (+0000)
Subject: Added Test Suite
X-Git-Tag: 0.67_01~73
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Action-REST.git;a=commitdiff_plain;h=7ad87df957f65463dba321ebe616e2581b7ff58f

Added Test Suite
Added Generic content-type aware Serialize/Deserialize actions
Added Data::Serializer actions, opening up a whole world of serializing goodness
---

diff --git a/Changelog b/Changelog
new file mode 100644
index 0000000..58d83fd
--- /dev/null
+++ b/Changelog
@@ -0,0 +1,4 @@
+Mon Oct 16 14:48:54 PDT 2006 (adam)
+	Added in Test Suite
+	Created Catalyst::Action::Serialize and Catalyst::Action::Deserialize
+	Added Data::Serializer actions
diff --git a/TODO b/TODO
index 572dd3d..606a21a 100644
--- a/TODO
+++ b/TODO
@@ -1,9 +1,6 @@
 * Override setup_classes from Catalyst::Base, so things that use 
   C::Controller:REST don't need to have ActionClass('REST') on them
 
-* Create generalized serializer/deserializer, that uses content_type to
-  choose
-
 * Document everything
 
 * More tests
diff --git a/lib/Catalyst/Action/Deserialize.pm b/lib/Catalyst/Action/Deserialize.pm
new file mode 100644
index 0000000..2d778b4
--- /dev/null
+++ b/lib/Catalyst/Action/Deserialize.pm
@@ -0,0 +1,71 @@
+#
+# Catlyst::Action::Deserialize
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+#
+# $Id$
+
+package Catalyst::Action::Deserialize;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+use Module::Pluggable::Object;
+use Catalyst::Request::REST;
+
+__PACKAGE__->mk_accessors(qw(plugins));
+
+sub execute {
+    my $self = shift;
+    my ( $controller, $c, $test ) = @_;
+
+    my $nreq = bless($c->request, 'Catalyst::Request::REST');
+    $c->request($nreq);
+
+    unless(defined($self->plugins)) {
+        my $mpo = Module::Pluggable::Object->new(
+            'require' => 1,
+            'search_path' => [ 'Catalyst::Action::Deserialize' ],
+        );
+        my @plugins = $mpo->plugins;
+        $self->plugins(\@plugins);
+    }
+    my $content_type = $c->request->content_type;
+    my $sclass = 'Catalyst::Action::Deserialize::';
+    my $sarg;
+    my $map = $controller->serialize->{'map'};
+    if (exists($map->{$content_type})) {
+        my $mc;
+        if (ref($map->{$content_type}) eq "ARRAY") {
+            $mc = $map->{$content_type}->[0];
+            $sarg = $map->{$content_type}->[1];
+        } else {
+            $mc = $map->{$content_type};
+        }
+        $sclass .= $mc;
+        if (! grep(/^$sclass$/, @{$self->plugins})) {
+            die "Cannot find plugin $sclass for $content_type!";
+        }
+    } else {
+        if (exists($controller->serialize->{'default'})) {
+            $sclass .= $controller->serialize->{'default'};
+        } else {
+            die "I cannot find a default serializer!";
+        }
+    }
+
+    my @demethods = qw(POST PUT OPTIONS);
+    my $method = $c->request->method;
+    if (grep /^$method$/, @demethods) {
+        if (defined($sarg)) {
+            $sclass->execute($controller, $c, $sarg);
+        } else {
+            $sclass->execute($controller, $c);
+        }
+        $self->NEXT::execute( @_, );
+    } else {
+        $self->NEXT::execute( @_ );
+    }
+};
+
+1;
diff --git a/lib/Catalyst/Action/Deserialize/Data/Serializer.pm b/lib/Catalyst/Action/Deserialize/Data/Serializer.pm
new file mode 100644
index 0000000..35917ec
--- /dev/null
+++ b/lib/Catalyst/Action/Deserialize/Data/Serializer.pm
@@ -0,0 +1,38 @@
+#
+# Catalyst::Action::Deserialize::Data::Serializer.pm
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+# Created on: 10/12/2006 03:00:32 PM PDT
+#
+# $Id$
+
+package Catalyst::Action::Deserialize::Data::Serializer;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+use Data::Serializer;
+
+sub execute {
+    my $self = shift;
+    my ( $controller, $c, $serializer ) = @_;
+ 
+    my $body = $c->request->body;
+    if ($body) {
+        my $rbody;
+        if (-f $c->request->body) {
+            open(BODY, "<", $c->request->body);
+            while (my $line = <BODY>) {
+                $rbody .= $line;
+            }
+            close(BODY);
+        }
+        my $dso = Data::Serializer->new(serializer => $serializer);
+        my $rdata = $dso->raw_deserialize($rbody);  
+        $c->request->data($rdata);
+    } else {
+        $c->log->debug('I would have deserialized, but there was nothing in the body!');
+    }
+};
+
+1;
diff --git a/lib/Catalyst/Action/Deserialize/YAML.pm b/lib/Catalyst/Action/Deserialize/YAML.pm
index 56ecb52..aa6c411 100644
--- a/lib/Catalyst/Action/Deserialize/YAML.pm
+++ b/lib/Catalyst/Action/Deserialize/YAML.pm
@@ -12,20 +12,17 @@ use warnings;
 
 use base 'Catalyst::Action';
 use YAML::Syck;
-use Catalyst::Request::REST;
 
 sub execute {
     my $self = shift;
     my ( $controller, $c, $test ) = @_;
-   
-    my $nreq = bless($c->request, 'Catalyst::Request::REST');
-    $c->request($nreq);
-    if ($c->request->method eq "POST" || $c->request->method eq "PUT") {
+ 
+    my $body = $c->request->body;
+    if ($body) {
         my $rdata = LoadFile($c->request->body);
         $c->request->data($rdata);
-        $self->NEXT::execute( @_, );
     } else {
-        $self->NEXT::execute( @_ );
+        $c->log->debug('I would have deserialized, but there was nothing in the body!');
     }
 };
 
diff --git a/lib/Catalyst/Action/REST.pm b/lib/Catalyst/Action/REST.pm
index a2f3f41..f071d8f 100644
--- a/lib/Catalyst/Action/REST.pm
+++ b/lib/Catalyst/Action/REST.pm
@@ -11,6 +11,7 @@ use strict;
 use warnings;
 
 use base 'Catalyst::Action';
+use Class::Inspector;
 
 sub dispatch {
     my ( $self, $c ) = @_;
@@ -18,12 +19,29 @@ sub dispatch {
     my $controller = $self->class;
     my $method = $self->name . "_" . uc($c->request->method);
     if ($controller->can($method)) {
-        $c->log->debug("REST ActionClass is calling $method");
         return $controller->$method($c);
     } else {
-        $c->log->debug("REST ActionClass is calling " . $self->name);
+        $self->_return_405($c);
         return $c->execute( $self->class, $self );
     }
 }
 
+sub _return_405 {
+    my ( $self, $c ) = @_;
+
+    my $controller = $self->class;
+    my $methods = Class::Inspector->methods($controller);
+    my @allowed;
+    foreach my $method (@{$methods}) {
+        my $name = $self->name;
+        if ($method =~ /^$name\_(.+)$/) {
+            push(@allowed, $1);
+        }
+    }
+    $c->response->content_type('text/plain');
+    $c->response->status(405);
+    $c->response->header('Allow' => \@allowed);
+    $c->response->body("Method " . $c->request->method . " not implemented for " . $c->uri_for($self->reverse));
+}
+
 1;
diff --git a/lib/Catalyst/Action/Serialize.pm b/lib/Catalyst/Action/Serialize.pm
new file mode 100644
index 0000000..d747576
--- /dev/null
+++ b/lib/Catalyst/Action/Serialize.pm
@@ -0,0 +1,77 @@
+#
+# Catlyst::Action::Serialize.pm
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+#
+# $Id$
+
+package Catalyst::Action::Serialize;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+use Module::Pluggable::Object;
+
+__PACKAGE__->mk_accessors(qw(plugins));
+
+sub execute {
+    my $self = shift;
+    my ( $controller, $c ) = @_;
+
+    return 1 if $c->req->method eq 'HEAD';
+    return 1 if length( $c->response->body );
+    return 1 if scalar @{ $c->error };
+    return 1 if $c->response->status =~ /^(?:204|3\d\d)$/;
+
+    # Load the Serialize Classes
+    unless(defined($self->plugins)) {
+        my $mpo = Module::Pluggable::Object->new(
+            'require' => 1,
+            'search_path' => [ 'Catalyst::Action::Serialize' ],
+        );
+        my @plugins = $mpo->plugins;
+        $self->plugins(\@plugins);
+    }
+
+    # Look up what serializer to use from content_type map
+    # 
+    # If we don't find one, we use the default
+    my $content_type = $c->request->content_type;
+    my $sclass = 'Catalyst::Action::Serialize::';
+    my $sarg;
+    my $map = $controller->serialize->{'map'};
+    if (exists($map->{$content_type})) {
+        my $mc;
+        if (ref($map->{$content_type}) eq "ARRAY") {
+            $mc = $map->{$content_type}->[0];
+            $sarg = $map->{$content_type}->[1];
+        } else {
+            $mc = $map->{$content_type};
+        }
+        $sclass .= $mc;
+        if (! grep(/^$sclass$/, @{$self->plugins})) {
+            die "Cannot find plugin $sclass for $content_type!";
+        }
+    } else {
+        if (exists($controller->serialize->{'default'})) {
+            $sclass .= $controller->serialize->{'default'};
+        } else {
+            die "I cannot find a default serializer!";
+        }
+    }
+
+    # Go ahead and serialize ourselves
+    if (defined($sarg)) {
+        $sclass->execute($controller, $c, $sarg);
+    } else {
+        $sclass->execute($controller, $c);
+    }
+
+    if (! $c->response->content_type ) {
+        $c->response->content_type($c->request->content_type);
+    }
+
+    return 1;
+};
+
+1;
diff --git a/lib/Catalyst/Action/Serialize/Data/Serializer.pm b/lib/Catalyst/Action/Serialize/Data/Serializer.pm
new file mode 100644
index 0000000..0b0fb4b
--- /dev/null
+++ b/lib/Catalyst/Action/Serialize/Data/Serializer.pm
@@ -0,0 +1,25 @@
+#
+# Catalyst::Action::Serialize::Data::Serializer
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+#
+# $Id$
+
+package Catalyst::Action::Serialize::Data::Serializer;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+use Data::Serializer;
+
+sub execute {
+    my $self = shift;
+    my ( $controller, $c, $serializer ) = @_;
+
+    my $stash_key = $controller->serialize->{'stash_key'} || 'rest';
+    my $dso = Data::Serializer->new(serializer => $serializer);
+    $c->response->output( $dso->raw_serialize( $c->stash->{$stash_key} ) );
+    return 1;
+};
+
+1;
diff --git a/lib/Catalyst/Action/Serialize/YAML.pm b/lib/Catalyst/Action/Serialize/YAML.pm
index fbcb4f8..5488cc4 100644
--- a/lib/Catalyst/Action/Serialize/YAML.pm
+++ b/lib/Catalyst/Action/Serialize/YAML.pm
@@ -18,15 +18,6 @@ sub execute {
     my ( $controller, $c, $test ) = @_;
 
     my $stash_key = $controller->serialize->{'stash_key'} || 'rest';
-  
-    if (! $c->response->content_type ) {
-        $c->response->content_type($c->req->content_type);
-    }
-    return 1 if $c->req->method eq 'HEAD';
-    return 1 if length( $c->response->body );
-    return 1 if scalar @{ $c->error };
-    return 1 if $c->response->status =~ /^(?:204|3\d\d)$/;
-
     $c->response->output( Dump( $c->stash->{$stash_key} ) );
     return 1;
 };
diff --git a/lib/Catalyst/Controller/REST.pm b/lib/Catalyst/Controller/REST.pm
index 22535e4..8b3a064 100644
--- a/lib/Catalyst/Controller/REST.pm
+++ b/lib/Catalyst/Controller/REST.pm
@@ -8,12 +8,17 @@ __PACKAGE__->mk_accessors(qw(serialize));
 
 __PACKAGE__->config(
     serialize => {
+        'default' => 'YAML',
         'stash_key' => 'rest',
+        'map' => {
+            'text/x-yaml' => 'YAML',
+            'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
+        },
     }
 );
 
-sub begin :ActionClass('Deserialize::YAML') {}
+sub begin :ActionClass('Deserialize') {}
 
-sub end :ActionClass('Serialize::YAML') {}
+sub end :ActionClass('Serialize') {}
 
 1;
diff --git a/t/01-yaml.t b/t/01-yaml.t
new file mode 100644
index 0000000..0f2c1e3
--- /dev/null
+++ b/t/01-yaml.t
@@ -0,0 +1,46 @@
+use strict;
+use warnings;
+use Test::More qw(no_plan);
+use YAML::Syck;
+use FindBin;
+
+use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib");
+use Test::Rest;
+
+# Should use the default serializer, YAML
+my $t = Test::Rest->new('content_type' => 'text/plain');
+
+BEGIN { use_ok 'Catalyst::Test', 'SampleREST' }
+
+my $mres = request($t->get(url => '/monkey'));
+# We should find the monkey
+ok( $mres->is_success, 'GET the monkey succeeded' );
+
+# We should use the default serializer, YAML
+my $monkey_template = {
+    monkey => 'likes chicken!',
+};
+my $monkey_data = Load($mres->content); 
+is_deeply($monkey_data, $monkey_template, "GET returned the right data");
+
+$t->{'content_type'} = 'text/x-yaml'; # Try again, with x-yaml
+my $mres_yaml = request($t->get(url => '/monkey'));
+ok( $mres_yaml->is_success, 'GET the monkey x-yaml succeeded' );
+is_deeply(Load($mres_yaml->content), $monkey_template, "GET x-yaml returned the right data");
+
+$t->{'content_type'} = 'text/plain'; # Try again, with text/plain 
+my $post_data = {
+    'sushi' => 'is good for monkey',
+};
+my $mres_post = request($t->post(url => '/monkey', data => Dump($post_data)));
+ok( $mres_post->is_success, "POST to the monkey succeeded");
+is_deeply($mres_post->content, Dump($post_data), "POST data matches");
+
+my $mdel = request($t->delete(url => '/monkey'));
+ok(! $mdel->is_success, "DELETE-ing the monkey failed; long live monkey!");
+ok($mdel->code eq "405", "DELETE-ing the monkey returned 405");
+my @allowed = $mdel->header('allow');
+my @rallowed = qw(GET POST);
+ok(@allowed eq @rallowed, "Default 405 handler returned proper methods in Allow header");
+
+1;
diff --git a/t/02-data-serializer.t b/t/02-data-serializer.t
new file mode 100644
index 0000000..ffb8cdd
--- /dev/null
+++ b/t/02-data-serializer.t
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+use Test::More qw(no_plan);
+use Data::Serializer;
+use FindBin;
+
+use lib ("$FindBin::Bin/lib", "$FindBin::Bin/../lib");
+use Test::Rest;
+
+my $dso = Data::Serializer->new(serializer => 'Data::Dumper');
+
+# Should use Data::Dumper, via Data::Serializer 
+my $t = Test::Rest->new('content_type' => 'text/x-data-dumper');
+
+BEGIN { use_ok 'Catalyst::Test', 'SampleREST' }
+
+my $mres = request($t->get(url => '/monkey'));
+# We should find the monkey
+ok( $mres->is_success, 'GET the monkey succeeded' );
+
+my $monkey_template = {
+    monkey => 'likes chicken!',
+};
+my $monkey_data = $dso->raw_deserialize($mres->content); 
+is_deeply($monkey_data, $monkey_template, "GET returned the right data");
+
+my $post_data = {
+    'sushi' => 'is good for monkey',
+};
+my $mres_post = request($t->post(url => '/monkey', data => $dso->raw_serialize($post_data)));
+ok( $mres_post->is_success, "POST to the monkey succeeded");
+is_deeply($mres_post->content, $dso->raw_serialize($post_data), "POST data matches");
+
+1;
diff --git a/t/lib/SampleREST.pm b/t/lib/SampleREST.pm
new file mode 100644
index 0000000..0a9dcee
--- /dev/null
+++ b/t/lib/SampleREST.pm
@@ -0,0 +1,62 @@
+package SampleREST;
+
+use strict;
+use warnings;
+
+use Catalyst::Runtime '5.70';
+
+# Set flags and add plugins for the application
+#
+#         -Debug: activates the debug mode for very useful log messages
+#   ConfigLoader: will load the configuration from a YAML file in the
+#                 application's home directory
+# Static::Simple: will serve static files from the application's root 
+#                 directory
+
+use Catalyst qw/ConfigLoader/;
+
+our $VERSION = '0.01';
+
+# Configure the application. 
+#
+# Note that settings in SampleREST.yml (or other external
+# configuration file that you set up manually) take precedence
+# over this when using ConfigLoader. Thus configuration
+# details given here can function as a default configuration,
+# with a external configuration file acting as an override for
+# local deployment.
+
+__PACKAGE__->config( name => 'SampleREST' );
+
+# Start the application
+__PACKAGE__->setup;
+
+
+=head1 NAME
+
+SampleREST - Catalyst based application
+
+=head1 SYNOPSIS
+
+    script/samplerest_server.pl
+
+=head1 DESCRIPTION
+
+[enter your description here]
+
+=head1 SEE ALSO
+
+L<SampleREST::Controller::Root>, L<Catalyst>
+
+=head1 AUTHOR
+
+Adam Jacob
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/t/lib/SampleREST/Controller/Monkey.pm b/t/lib/SampleREST/Controller/Monkey.pm
new file mode 100644
index 0000000..9adc994
--- /dev/null
+++ b/t/lib/SampleREST/Controller/Monkey.pm
@@ -0,0 +1,23 @@
+package SampleREST::Controller::Monkey;
+
+use strict;
+use warnings;
+use base 'Catalyst::Controller::REST';
+
+sub myindex :Path :Args(0) :ActionClass('REST') {}
+
+sub myindex_GET {
+    my ( $self, $c, $rdata ) = @_;
+
+    $c->stash->{'rest'} = {
+        'monkey' => 'likes chicken!',
+    };
+}
+
+sub myindex_POST {
+    my ( $self, $c, $rdata ) = @_;
+
+    $c->stash->{'rest'} = $c->request->data;
+}
+
+1;
diff --git a/t/lib/SampleREST/Controller/Root.pm b/t/lib/SampleREST/Controller/Root.pm
new file mode 100644
index 0000000..72a9ce9
--- /dev/null
+++ b/t/lib/SampleREST/Controller/Root.pm
@@ -0,0 +1,55 @@
+package SampleREST::Controller::Root;
+
+use strict;
+use warnings;
+use base 'Catalyst::Controller';
+
+#
+# Sets the actions in this controller to be registered with no prefix
+# so they function identically to actions created in MyApp.pm
+#
+__PACKAGE__->config->{namespace} = '';
+
+=head1 NAME
+
+SampleREST::Controller::Root - Root Controller for SampleREST
+
+=head1 DESCRIPTION
+
+[enter your description here]
+
+=head1 METHODS
+
+=cut
+
+=head2 default
+
+=cut
+
+sub default : Private {
+    my ( $self, $c ) = @_;
+
+    # Hello World
+    $c->response->body( $c->welcome_message );
+}
+
+=head2 end
+
+Attempt to render a view, if needed.
+
+=cut 
+
+sub end : ActionClass('RenderView') {}
+
+=head1 AUTHOR
+
+Adam Jacob
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/t/lib/Test/Rest.pm b/t/lib/Test/Rest.pm
new file mode 100644
index 0000000..5814093
--- /dev/null
+++ b/t/lib/Test/Rest.pm
@@ -0,0 +1,86 @@
+#
+# Rest.pm
+# Created by: Adam Jacob, Marchex, <adam@marchex.com>
+# Created on: 10/16/2006 11:11:25 AM PDT
+#
+# $Id: $
+
+package Test::Rest;
+
+use strict;
+use warnings;
+
+use LWP::UserAgent;
+use Params::Validate qw(:all);
+
+sub new {
+    my $self = shift;
+    my %p = validate(@_,
+        {
+            content_type => { type => SCALAR },
+        },
+    );
+    my $ref = { 
+        'ua' => LWP::UserAgent->new,
+        'content_type' => $p{'content_type'},
+    };
+    bless $ref, $self;
+}
+
+sub get {
+    my $self = shift;
+    my %p = validate(@_,
+        {
+            url => { type => SCALAR },
+        },
+    );
+    my $req = HTTP::Request->new('GET' => $p{'url'});
+    $req->content_type($self->{'content_type'});
+    return $req;
+}
+
+sub delete {
+    my $self = shift;
+    my %p = validate(@_,
+        {
+            url => { type => SCALAR },
+        },
+    );
+    my $req = HTTP::Request->new('DELETE' => $p{'url'});
+    $req->content_type($self->{'content_type'});
+    return $req;
+}
+
+sub put {
+    my $self = shift;
+    my %p = validate(@_,
+        {
+            url => { type => SCALAR },
+            data => 1,
+        },
+    );
+    my $req = HTTP::Request->new('PUT' => $p{'url'});
+    $req->content_type($self->{'content_type'});
+    $req->content_length(do { use bytes; length($p{'data'}) });
+    $req->content($p{'data'});
+    return $req;
+}
+
+sub post {
+    my $self = shift;
+    my %p = validate(@_,
+        {
+            url => { type => SCALAR },
+            data => { required => 1 },
+        },
+    );
+    my $req = HTTP::Request->new('POST' => $p{'url'});
+    $req->content_type($self->{'content_type'});
+    $req->content_length(do { use bytes; length($p{'data'}) });
+    $req->content($p{'data'});
+    return $req;
+}
+
+
+1;
+