--- /dev/null
+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
* 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
--- /dev/null
+#
+# 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;
--- /dev/null
+#
+# 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;
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!');
}
};
use warnings;
use base 'Catalyst::Action';
+use Class::Inspector;
sub dispatch {
my ( $self, $c ) = @_;
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;
--- /dev/null
+#
+# 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;
--- /dev/null
+#
+# 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;
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;
};
__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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+#
+# 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;
+
projects / catagits/Catalyst-Action-REST.git / commitdiff