X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FAction%2FSerializeBase.pm;h=ba0cdf4e6313e34957974c928eaca50d976d4cdc;hb=370367cb80b925e50a4ea1bc759b06d1466f2627;hp=93108bbc09dea04aa30f159efe0f8b1090ca8213;hpb=797c0e93f27335d2d51f2ad515318aa269dcde12;p=catagits%2FCatalyst-Action-REST.git diff --git a/lib/Catalyst/Action/SerializeBase.pm b/lib/Catalyst/Action/SerializeBase.pm index 93108bb..ba0cdf4 100644 --- a/lib/Catalyst/Action/SerializeBase.pm +++ b/lib/Catalyst/Action/SerializeBase.pm @@ -1,27 +1,20 @@ -# -# Catlyst::Action::SerializeBase.pm -# Created by: Adam Jacob, Marchex, -# -# $Id$ - package Catalyst::Action::SerializeBase; -use strict; -use warnings; +use Moose; +use namespace::autoclean; -use base 'Catalyst::Action'; +extends 'Catalyst::Action'; use Module::Pluggable::Object; use Catalyst::Request::REST; use Catalyst::Utils (); -sub new { - my $class = shift; - my $config = shift; - Catalyst::Request::REST->_insert_self_into( $config->{class} ); - return $class->SUPER::new($config, @_); -} +after BUILDARGS => sub { + my $class = shift; + my $config = shift; + Catalyst::Request::REST->_insert_self_into( $config->{class} ); +}; -__PACKAGE__->mk_accessors(qw(_serialize_plugins _loaded_plugins)); +has [qw(_serialize_plugins _loaded_plugins)] => ( is => 'rw' ); sub _load_content_plugins { my $self = shift; @@ -46,12 +39,14 @@ sub _load_content_plugins { my $sclass = $search_path . "::"; my $sarg; my $map; + my $compliance_mode; + my $default; my $config; if ( exists $controller->{'serialize'} ) { - $c->log->info("Using deprecated configuration for Catalyst::Action::REST!"); - $c->log->info("Please see perldoc Catalyst::Action::REST for the update guide"); + $c->log->info("Catalyst::Action::REST - deprecated use of 'serialize' for configuration."); + $c->log->info("Please see 'CONFIGURATION' in Catalyst::Controller::REST."); $config = $controller->{'serialize'}; # if they're using the deprecated config, they may be expecting a # default mapping too. @@ -60,6 +55,28 @@ sub _load_content_plugins { $config = $controller; } $map = $config->{'map'}; + $default = $config->{'default'} if $config->{'default'}; + + # If we're in RFC 7231 compliance mode we need to determine if we're + # serializing or deserializing, then set the request object to + # look at the appropriate set of supported content types. + $compliance_mode = $config->{'compliance_mode'}; + if($compliance_mode) { + my $serialize_mode = (split '::', $search_path)[-1]; + if($serialize_mode eq 'Deserialize') { + # Tell the request object to only look at the Content-Type header + $c->request->set_content_type_only(); + + # If we're in compliance mode and doing deserializing we want + # to use the allowed content types for deserializing, not the + # serializer map + $map = $config->{'deserialize_map'}; + $default = $config->{'deserialize_default'} if $config->{'deserialize_default'}; + } elsif($serialize_mode eq 'Serialize') { + # Tell the request object to only look at the Accept header + $c->request->set_accept_only(); + } + } # pick preferred content type my @accepted_types; # priority order, best first @@ -75,11 +92,11 @@ sub _load_content_plugins { # then content types requested by caller push @accepted_types, @{ $c->request->accepted_content_types }; # then the default - push @accepted_types, $config->{'default'} if $config->{'default'}; + push @accepted_types, $default if $default; # pick the best match that we have a serializer mapping for my ($content_type) = grep { $map->{$_} } @accepted_types; - return $self->_unsupported_media_type($c, $content_type) + return $self->unsupported_media_type($c, $content_type) if not $content_type; # carp about old text/x-json @@ -105,10 +122,10 @@ sub _load_content_plugins { $sclass .= $mc; #} if ( !grep( /^$sclass$/, @{ $self->_serialize_plugins } ) ) { - return $self->_unsupported_media_type($c, $content_type); + return $self->unsupported_media_type($c, $content_type); } } else { - return $self->_unsupported_media_type($c, $content_type); + return $self->unsupported_media_type($c, $content_type); } unless ( exists( $self->_loaded_plugins->{$sclass} ) ) { my $load_class = $sclass; @@ -118,17 +135,19 @@ sub _load_content_plugins { if ($@) { $c->log->error( "Error loading $sclass for " . $content_type . ": $!" ); - return $self->_unsupported_media_type($c, $content_type); + return $self->unsupported_media_type($c, $content_type); } else { $self->_loaded_plugins->{$sclass} = 1; } } if ($search_path eq "Catalyst::Action::Serialize") { - if ($content_type) { - $c->response->header( 'Vary' => 'Content-Type' ); - } elsif ($c->request->accept_only) { - $c->response->header( 'Vary' => 'Accept' ); + unless( $c->response->header( 'Vary' ) ) { + if ($content_type) { + $c->response->header( 'Vary' => 'Content-Type' ); + } elsif ($c->request->accept_only) { + $c->response->header( 'Vary' => 'Accept' ); + } } $c->response->content_type($content_type); } @@ -136,7 +155,7 @@ sub _load_content_plugins { return $sclass, $sarg, $content_type; } -sub _unsupported_media_type { +sub unsupported_media_type { my ( $self, $c, $content_type ) = @_; $c->res->content_type('text/plain'); $c->res->status(415); @@ -150,7 +169,7 @@ sub _unsupported_media_type { return undef; } -sub _serialize_bad_request { +sub serialize_bad_request { my ( $self, $c, $content_type, $error ) = @_; $c->res->content_type('text/plain'); $c->res->status(400); @@ -159,13 +178,13 @@ sub _serialize_bad_request { return undef; } +__PACKAGE__->meta->make_immutable; + 1; =head1 NAME -B - -Base class for Catalyst::Action::Serialize and Catlayst::Action::Deserialize. +Catalyst::Action::SerializeBase - Base class for Catalyst::Action::Serialize and Catlayst::Action::Deserialize. =head1 DESCRIPTION @@ -177,15 +196,12 @@ code for L and L. L, L, L, -=head1 AUTHOR - -Adam Jacob , with lots of help from mst and jrockway. +=head1 AUTHORS -Marchex, Inc. paid me while I developed this module. (http://www.marchex.com) +See L for authors. =head1 LICENSE You may distribute this code under the same terms as Perl itself. =cut -