+Fri Mar 9 14:13:29 PST 2007 (adam) - Release 0.40
+ Refactored the Content-Type negotiation to live in Catalyst::Request::REST.
+ (drolsky)
+ Added some useful debugging. (drolsky)
+ Added a View serializer/deserializer, which simply calls the correct
+ Catalyst view. ('text/html' => [ 'View', 'TT' ]) (claco, adam)
+
Wed Dec 6 00:45:02 PST 2006 (adam) - Release 0.31
Fixed a bug where we would report a blank content-type negotiation.
Added Data::Dump as a dependency.
use base 'Catalyst::Action::SerializeBase';
use Module::Pluggable::Object;
-use Catalyst::Request::REST;
__PACKAGE__->mk_accessors(qw(plugins));
my $self = shift;
my ( $controller, $c ) = @_;
- my $nreq = bless( $c->request, 'Catalyst::Request::REST' );
- $c->request($nreq);
-
my @demethods = qw(POST PUT OPTIONS);
my $method = $c->request->method;
if ( grep /^$method$/, @demethods ) {
- my ($sclass, $sarg, $content_type) = $self->_load_content_plugins('Catalyst::Action::Deserialize', $controller, $c);
- return 1 unless defined ($sclass);
+ my ( $sclass, $sarg, $content_type ) =
+ $self->_load_content_plugins( 'Catalyst::Action::Deserialize',
+ $controller, $c );
+ return 1 unless defined($sclass);
my $rc;
if ( defined($sarg) ) {
$rc = $sclass->execute( $controller, $c, $sarg );
} else {
$rc = $sclass->execute( $controller, $c );
}
- if ($rc eq "0") {
- return $self->_unsupported_media_type($c, $content_type);
- } elsif ($rc ne "1") {
- return $self->_serialize_bad_request($c, $content_type, $rc);
+ if ( $rc eq "0" ) {
+ return $self->_unsupported_media_type( $c, $content_type );
+ } elsif ( $rc ne "1" ) {
+ return $self->_serialize_bad_request( $c, $content_type, $rc );
}
- }
+ }
- $self->NEXT::execute( @_ );
+ $self->NEXT::execute(@_);
return 1;
}
Will work just fine.
+When you use this module, the request class will be changed to
+L<Catalyst::Request::REST>.
+
=head1 SEE ALSO
You likely want to look at L<Catalyst::Controller::REST>, which implements
--- /dev/null
+package Catalyst::Action::Deserialize::View;
+
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+
+sub execute {
+ return 1;
+}
+
+1;
\ No newline at end of file
use base 'Catalyst::Action';
use Class::Inspector;
+use Catalyst::Request::REST;
use 5.8.1;
our
-$VERSION = '0.31';
+ $VERSION = '0.40';
+
+# This is wrong in several ways. First, there's no guarantee that
+# Catalyst.pm has not been subclassed. Two, there's no guarantee that
+# the user isn't already using their request subclass.
+Catalyst->request_class('Catalyst::Request::REST')
+ unless Catalyst->request_class->isa('Catalyst::Request::REST');
=head1 NAME
which brings this class together with automatic Serialization of requests
and responses.
+When you use this module, the request class will be changed to
+L<Catalyst::Request::REST>.
+
=head1 METHODS
=over 4
my $self = shift;
my ( $controller, $c ) = @_;
- $self->NEXT::execute( @_ );
+ $self->NEXT::execute(@_);
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)$/;
- my ($sclass, $sarg, $content_type) = $self->_load_content_plugins("Catalyst::Action::Serialize", $controller, $c);
+ my ( $sclass, $sarg, $content_type ) =
+ $self->_load_content_plugins( "Catalyst::Action::Serialize",
+ $controller, $c );
unless ( defined($sclass) ) {
- $c->log->debug("Could not find a serializer for $content_type");
+ if ( defined($content_type) ) {
+ $c->log->debug("Could not find a serializer for $content_type");
+ } else {
+ $c->log->debug(
+ "Could not find a serializer for an empty content type");
+ }
return 1;
}
- $c->log->debug("Serializing with $sclass" . ($sarg ? " [$sarg]" : ''));
+ $c->log->debug(
+ "Serializing with $sclass" . ( $sarg ? " [$sarg]" : '' ) );
my $rc;
if ( defined($sarg) ) {
} else {
$rc = $sclass->execute( $controller, $c );
}
- if ($rc eq 0) {
- return $self->_unsupported_media_type($c, $content_type);
- } elsif ($rc ne 1) {
- return $self->_serialize_bad_request($c, $content_type, $rc);
- }
+ if ( $rc eq 0 ) {
+ return $self->_unsupported_media_type( $c, $content_type );
+ } elsif ( $rc ne 1 ) {
+ return $self->_serialize_bad_request( $c, $content_type, $rc );
+ }
return 1;
}
'default' => 'YAML',
'stash_key' => 'rest',
'map' => {
+ 'text/html' => [ 'View', 'TT', ],
'text/x-yaml' => 'YAML',
'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
},
.. populate stash with data ..
}
+When you use this module, the request class will be changed to
+L<Catalyst::Request::REST>.
+
=head1 CONFIGURATION
=over 4
You may distribute this code under the same terms as Perl itself.
=cut
+
--- /dev/null
+package Catalyst::Action::Serialize::View;
+use strict;
+use warnings;
+
+use base 'Catalyst::Action';
+
+sub execute {
+ my $self = shift;
+ my ( $controller, $c, $view ) = @_;
+ my $stash_key = $controller->config->{'serialize'}->{'stash_key'}
+ || 'rest';
+
+ if ( !$c->view($view) ) {
+ $c->log->error("Could not load $view, refusing to serialize");
+ return 0;
+ }
+
+ return $c->view($view)->process($c);
+}
+
+1;
#
-# Catlyst::Action::Serialize::YAML.pm
+# Catalyst::Action::Serialize::YAML.pm
# Created by: Adam Jacob, Marchex, <adam@marchex.com>
# Created on: 10/12/2006 03:00:32 PM PDT
#
use base 'Catalyst::Action';
use Module::Pluggable::Object;
use Data::Dump qw(dump);
-use HTTP::Headers::Util qw(split_header_words);
+use Catalyst::Request::REST;
+
+Catalyst->request_class('Catalyst::Request::REST')
+ unless Catalyst->request_class->isa('Catalyst::Request::REST');
__PACKAGE__->mk_accessors(qw(_serialize_plugins _loaded_plugins));
$self->_serialize_plugins( \@plugins );
}
- # First, we use the content type in the HTTP Request. It wins all.
- my $content_type = $c->request->content_type || '';
-
- # Second, we allow GET requests to tunnel the content-type as
- # a query param.
- if (!$content_type && $c->req->method eq "GET" && $c->req->param('content-type')) {
-
- $content_type = $c->req->param('content-type');
- }
-
- # Third, we parse the Accept header, and see if the client
- # takes a format we understand.
- #
- # This is taken from chansen's Apache2::UploadProgress.
- my $used_accept = 0;
- if ( !$content_type && $c->request->header('Accept') ) {
- my $accept_header = $c->request->header('Accept');
- my %accept = ();
- my $counter = 0;
-
- foreach my $pair ( split_header_words($accept_header) ) {
-
- my ( $type, $qvalue ) = @{$pair}[ 0, 3 ];
-
- unless ( defined $qvalue ) {
- $qvalue = 1 - ( ++$counter / 1000 );
- }
-
- $accept{$type} = sprintf( '%.3f', $qvalue );
- }
-
- foreach my $type ( sort { $accept{$b} <=> $accept{$a} } keys %accept )
- {
-
- if ( exists $controller->config->{'serialize'}->{'map'}->{$type} )
- {
- $content_type = $type;
- last;
- }
- }
- $used_accept = 1;
- }
+ my $content_type = $c->request->preferred_content_type;
# Finally, we load the class. If you have a default serializer,
# and we still don't have a content-type that exists in the map,
if ($search_path eq "Catalyst::Action::Serialize") {
if ($content_type) {
$c->response->header( 'Vary' => 'Content-Type' );
- } elsif ($used_accept) {
+ } elsif ($c->request->accept_only) {
$c->response->header( 'Vary' => 'Accept' );
}
$c->response->content_type($content_type);
{ data => $yourdata }
+=item L<View>
+
+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' ],
+
+Will do the trick nicely.
+
=back
By default, L<Catalyst::Controller::REST> will return a C<415 Unsupported Media Type> response if an attempt to use an unsupported content-type is made. You
],
'text/x-config-general' => [ 'Data::Serializer', 'Config::General' ]
,
- 'text/x-php-serialization' => [ 'Data::Serializer', 'PHP::Serializat
-ion' ],
+ 'text/x-php-serialization' => [ 'Data::Serializer', 'PHP::Serialization' ],
},
}
);
use warnings;
use base 'Catalyst::Request';
+use HTTP::Headers::Util qw(split_header_words);
-__PACKAGE__->mk_accessors(qw(data));
-1;
+=head1 NAME
+
+Catalyst::Request::REST - A REST-y subclass of Catalyst::Request
+
+=head1 SYNOPSIS
+
+ if ( $c->request->accepts('text/x-json') ) {
+ ...
+ }
+
+ my $types = $c->request->accepted_content_types();
+
+=head1 DESCRIPTION
+
+This is a subclass of C<Catalyst::Request> that adds a few methods to
+the request object to faciliate writing REST-y code. Currently, these
+methods are all related to the content types accepted by the client.
+
+
+=head1 METHODS
+
+=over 4 data
+
+If the request went through the Deserializer action, this method will
+returned the deserialized data structure.
+
+=cut
+
+__PACKAGE__->mk_accessors(qw(data accept_only));
+
+=item accepted_content_types
+
+Returns an array reference of content types accepted by the
+client.
+
+The list of types is created by looking at the following sources:
+
+=over 8
+
+=item * Content-type header
+
+If this exists, this will always be the first type in the list.
+
+=item * content-type parameter
+
+If the request is a GET request and there is a "content-type"
+parameter in the query string, this will come before any types in the
+Accept header.
+
+=item * Accept header
+
+This will be parsed and the types found will be ordered by the
+relative quality specified for each type.
+
+=back
+
+If a type appears in more than one of these places, it is ordered based on
+where it is first found.
+
+=cut
+
+sub accepted_content_types {
+ my $self = shift;
+
+ return $self->{content_types} if $self->{content_types};
+ my %types;
+
+ # First, we use the content type in the HTTP Request. It wins all.
+ $types{ $self->content_type } = 3
+ if $self->content_type;
+
+ if ($self->method eq "GET" && $self->param('content-type')) {
+
+ $types{ $self->param('content-type') } = 2;
+ }
+
+ # Third, we parse the Accept header, and see if the client
+ # takes a format we understand.
+ #
+ # This is taken from chansen's Apache2::UploadProgress.
+ if ( $self->header('Accept') ) {
+ $self->accept_only(1) unless keys %types;
+
+ my $accept_header = $self->header('Accept');
+ my $counter = 0;
+
+ foreach my $pair ( split_header_words($accept_header) ) {
+ my ( $type, $qvalue ) = @{$pair}[ 0, 3 ];
+ next if $types{$type};
+
+ unless ( defined $qvalue ) {
+ $qvalue = 1 - ( ++$counter / 1000 );
+ }
+
+ $types{$type} = sprintf( '%.3f', $qvalue );
+ }
+ }
+
+ return $self->{content_types} =
+ [ sort { $types{$b} <=> $types{$a} } keys %types ];
+}
+
+=item preferred_content_type
+
+This returns the first content type found. It is shorthand for:
+
+ $request->accepted_content_types->[0]
+
+=cut
+
+sub preferred_content_type { $_[0]->accepted_content_types->[0] }
+
+=item accepts($type)
+
+Given a content type, this returns true if the type is accepted.
+
+Note that this does not do any wildcard expansion of types.
+
+=cut
+
+sub accepts {
+ my $self = shift;
+ my $type = shift;
+
+ return grep { $_ eq $type } @{ $self->accepted_content_types };
+}
+
+=head1 AUTHOR
+
+Adam Jacob <adam@stalecoffee.org>, with lots of help from mst and jrockway
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
use FindBin;
-use lib ("$FindBin::Bin/../lib");
+use lib ("$FindBin::Bin/../lib", "$FindBin::Bin/lib" );
use strict;
use warnings;
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 21;
+use FindBin;
+use lib ( "$FindBin::Bin/../lib" );
+
+use Catalyst::Request::REST;
+use HTTP::Headers;
+
+{
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( {} );
+ $request->method('GET');
+ $request->content_type('text/foobar');
+
+ is_deeply( $request->accepted_content_types, [ 'text/foobar' ],
+ 'content-type set in request headers is found' );
+ is( $request->preferred_content_type, 'text/foobar',
+ 'preferred content type is text/foobar' );
+ ok( ! $request->accept_only, 'accept_only is false' );
+ ok( $request->accepts('text/foobar'), 'accepts text/foobar' );
+ ok( ! $request->accepts('text/html'), 'does not accept text/html' );
+}
+
+{
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( { 'content-type' => 'text/fudge' } );
+ $request->method('GET');
+ $request->content_type('text/foobar');
+
+ is_deeply( $request->accepted_content_types, [ 'text/foobar', 'text/fudge' ],
+ 'content-type set in request headers and type in parameters is found' );
+ is( $request->preferred_content_type, 'text/foobar',
+ 'preferred content type is text/foobar' );
+ ok( ! $request->accept_only, 'accept_only is false' );
+ ok( $request->accepts('text/foobar'), 'accepts text/foobar' );
+ ok( $request->accepts('text/fudge'), 'accepts text/fudge' );
+ ok( ! $request->accepts('text/html'), 'does not accept text/html' );
+}
+
+{
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( { 'content-type' => 'text/fudge' } );
+ $request->method('POST');
+ $request->content_type('text/foobar');
+
+ ok( ! $request->accepts('text/fudge'), 'content type in parameters is ignored for POST' );
+}
+
+{
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( {} );
+ $request->method('GET');
+ $request->headers->header(
+ 'Accept' =>
+ # From Firefox 2.0 when it requests an html page
+ 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
+ );
+
+ is_deeply( $request->accepted_content_types,
+ [ qw( text/xml application/xml application/xhtml+xml
+ image/png
+ text/html
+ text/plain
+ */*
+ ) ],
+ 'accept header is parsed properly' );
+ is( $request->preferred_content_type, 'text/xml',
+ 'preferred content type is text/xml' );
+ ok( $request->accept_only, 'accept_only is true' );
+ ok( $request->accepts('text/html'), 'accepts text/html' );
+ ok( $request->accepts('image/png'), 'accepts image/png' );
+ ok( ! $request->accepts('image/svg'), 'does not accept image/svg' );
+}
+
+{
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( {} );
+ $request->method('GET');
+ $request->content_type('text/x-json');
+ $request->headers->header(
+ 'Accept' =>
+ # From Firefox 2.0 when it requests an html page
+ 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
+ );
+
+ is_deeply( $request->accepted_content_types,
+ [ qw( text/x-json
+ text/xml application/xml application/xhtml+xml
+ image/png
+ text/html
+ text/plain
+ */*
+ ) ],
+ 'accept header is parsed properly, and content-type header has precedence over accept' );
+ ok( ! $request->accept_only, 'accept_only is false' );
+}
+
+{
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( {} );
+ $request->method('GET');
+ $request->content_type('text/x-json');
+ $request->headers->header(
+ 'Accept' => 'text/plain,text/x-json',
+ );
+
+ is_deeply( $request->accepted_content_types,
+ [ qw( text/x-json
+ text/plain
+ ) ],
+ 'each type appears only once' );
+}
+
+
+package MockContext;
+
+sub prepare_body { }
+
package Test::Serialize;
use FindBin;
use Catalyst;
__PACKAGE__->config(
- name => 'Test::Serialize',
+ name => 'Test::Serialize',
serialize => {
'stash_key' => 'rest',
'map' => {
'text/x-json' => 'JSON',
'text/x-data-dumper' => [ 'Data::Serializer', 'Data::Dumper' ],
'text/x-data-denter' => [ 'Data::Serializer', 'Data::Denter' ],
- 'text/x-data-taxi' => [ 'Data::Serializer', 'Data::Taxi' ],
- 'application/x-storable' => [ 'Data::Serializer', 'Storable' ],
- 'application/x-freezethaw' => [ 'Data::Serializer', 'FreezeThaw' ],
- 'text/x-config-general' => [ 'Data::Serializer', 'Config::General' ],
- 'text/x-php-serialization' => [ 'Data::Serializer', 'PHP::Serialization' ],
- 'text/broken' => 'Broken',
+ 'text/x-data-taxi' => [ 'Data::Serializer', 'Data::Taxi' ],
+ 'application/x-storable' => [ 'Data::Serializer', 'Storable' ],
+ 'application/x-freezethaw' =>
+ [ 'Data::Serializer', 'FreezeThaw' ],
+ 'text/x-config-general' =>
+ [ 'Data::Serializer', 'Config::General' ],
+ 'text/x-php-serialization' =>
+ [ 'Data::Serializer', 'PHP::Serialization' ],
+ 'text/view' => [ 'View', 'Simple' ],
+ 'text/broken' => 'Broken',
},
}
);
__PACKAGE__->setup;
+__PACKAGE__->setup_component("Test::Serialize::View::Simple");
-sub monkey_put :Local :ActionClass('Deserialize') {
+sub monkey_put : Local : ActionClass('Deserialize') {
my ( $self, $c ) = @_;
- $c->res->output($c->req->data->{'sushi'});
+
+ if ( ref($c->req->data) eq "HASH" ) {
+ $c->res->output( $c->req->data->{'sushi'} );
+ } else {
+ $c->res->output(1)
+ }
}
-sub monkey_get :Local :ActionClass('Serialize') {
+sub monkey_get : Local : ActionClass('Serialize') {
my ( $self, $c ) = @_;
$c->stash->{'rest'} = { monkey => 'likes chicken!', };
}
--- /dev/null
+package Test::Serialize::View::Simple;
+
+use base qw/Catalyst::View/;
+
+sub process {
+ my ($self, $c) = @_;
+
+ $c->res->body("I am a simple view");
+ return 1;
+}
+
+1;
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 4;
+use FindBin;
+
+use lib ( "$FindBin::Bin/lib", "$FindBin::Bin/../lib" );
+use Test::Rest;
+
+use_ok 'Catalyst::Test', 'Test::Serialize';
+
+my $t = Test::Rest->new( 'content_type' => 'text/view' );
+
+my $monkey_template = "I am a simple view";
+my $mres = request( $t->get( url => '/monkey_get' ) );
+ok( $mres->is_success, 'GET the monkey succeeded' );
+is( $mres->content, $monkey_template, "GET returned the right data" );
+
+my $mres_post = request( $t->post( url => '/monkey_put', data => 1 ) );
+ok( $mres_post->is_success, "POST to the monkey passed." );
+
+1;
projects / catagits/Catalyst-Action-REST.git / commitdiff