lib/Catalyst/Action/SerializeBase.pm

   1 package Catalyst::Action::SerializeBase;
   2
   3 use Moose;
   4 use namespace::autoclean;
   5
   6 extends 'Catalyst::Action';
   7 use Module::Pluggable::Object;
   8 use Catalyst::Request::REST;
   9 use Catalyst::Utils ();
  10
  11 our $VERSION = '0.81';
  12 $VERSION = eval $VERSION;
  13
  14 sub new {
  15   my $class  = shift;
  16   my $config = shift;
  17   Catalyst::Request::REST->_insert_self_into( $config->{class} );
  18   return $class->SUPER::new($config, @_);
  19 }
  20
  21 __PACKAGE__->mk_accessors(qw(_serialize_plugins _loaded_plugins));
  22
  23 sub _load_content_plugins {
  24     my $self = shift;
  25     my ( $search_path, $controller, $c ) = @_;
  26
  27     unless ( defined( $self->_loaded_plugins ) ) {
  28         $self->_loaded_plugins( {} );
  29     }
  30
  31     # Load the Serialize Classes
  32     unless ( defined( $self->_serialize_plugins ) ) {
  33         my @plugins;
  34         my $mpo =
  35           Module::Pluggable::Object->new( 'search_path' => [$search_path], );
  36         @plugins = $mpo->plugins;
  37         $self->_serialize_plugins( \@plugins );
  38     }
  39
  40     # Finally, we load the class.  If you have a default serializer,
  41     # and we still don't have a content-type that exists in the map,
  42     # we'll use it.
  43     my $sclass = $search_path . "::";
  44     my $sarg;
  45     my $map;
  46
  47     my $config;
  48
  49     if ( exists $controller->{'serialize'} ) {
  50         $c->log->info("Catalyst::Action::REST - deprecated use of 'serialize' for configuration.");
  51         $c->log->info("Please see 'CONFIGURATION' in Catalyst::Controller::REST.");
  52         $config = $controller->{'serialize'};
  53         # if they're using the deprecated config, they may be expecting a
  54         # default mapping too.
  55         $config->{map} ||= $controller->{map};
  56     } else {
  57         $config = $controller;
  58     }
  59     $map = $config->{'map'};
  60
  61     # pick preferred content type
  62     my @accepted_types; # priority order, best first
  63     # give top priority to content type specified by stash, if any
  64     my $content_type_stash_key = $config->{content_type_stash_key};
  65     if ($content_type_stash_key
  66         and my $stashed = $c->stash->{$content_type_stash_key}
  67     ) {
  68         # convert to array if not already a ref
  69         $stashed = [ $stashed ] if not ref $stashed;
  70         push @accepted_types, @$stashed;
  71     }
  72     # then content types requested by caller
  73     push @accepted_types, @{ $c->request->accepted_content_types };
  74     # then the default
  75     push @accepted_types, $config->{'default'} if $config->{'default'};
  76     # pick the best match that we have a serializer mapping for
  77     my ($content_type) = grep { $map->{$_} } @accepted_types;
  78
  79     return $self->_unsupported_media_type($c, $content_type)
  80         if not $content_type;
  81
  82     # carp about old text/x-json
  83     if ($content_type eq 'text/x-json') {
  84         $c->log->info('Using deprecated text/x-json content-type.');
  85         $c->log->info('Use application/json instead!');
  86     }
  87
  88     if ( exists( $map->{$content_type} ) ) {
  89         my $mc;
  90         if ( ref( $map->{$content_type} ) eq "ARRAY" ) {
  91             $mc   = $map->{$content_type}->[0];
  92             $sarg = $map->{$content_type}->[1];
  93         } else {
  94             $mc = $map->{$content_type};
  95         }
  96         # TODO: Handle custom serializers more elegantly.. this is a start,
  97         # but how do we determine which is Serialize and Deserialize?
  98         #if ($mc =~ /^+/) {
  99         #    $sclass = $mc;
 100         #    $sclass =~ s/^+//g;
 101         #} else {
 102         $sclass .= $mc;
 103         #}
 104         if ( !grep( /^$sclass$/, @{ $self->_serialize_plugins } ) ) {
 105             return $self->_unsupported_media_type($c, $content_type);
 106         }
 107     } else {
 108         return $self->_unsupported_media_type($c, $content_type);
 109     }
 110     unless ( exists( $self->_loaded_plugins->{$sclass} ) ) {
 111         my $load_class = $sclass;
 112         $load_class =~ s/::/\//g;
 113         $load_class =~ s/$/.pm/g;
 114         eval { require $load_class; };
 115         if ($@) {
 116             $c->log->error(
 117                 "Error loading $sclass for " . $content_type . ": $!" );
 118             return $self->_unsupported_media_type($c, $content_type);
 119         } else {
 120             $self->_loaded_plugins->{$sclass} = 1;
 121         }
 122     }
 123
 124     if ($search_path eq "Catalyst::Action::Serialize") {
 125         if ($content_type) {
 126             $c->response->header( 'Vary' => 'Content-Type' );
 127         } elsif ($c->request->accept_only) {
 128             $c->response->header( 'Vary' => 'Accept' );
 129         }
 130         $c->response->content_type($content_type);
 131     }
 132
 133     return $sclass, $sarg, $content_type;
 134 }
 135
 136 sub _unsupported_media_type {
 137     my ( $self, $c, $content_type ) = @_;
 138     $c->res->content_type('text/plain');
 139     $c->res->status(415);
 140     if (defined($content_type) && $content_type ne "") {
 141         $c->res->body(
 142             "Content-Type " . $content_type . " is not supported.\r\n" );
 143     } else {
 144         $c->res->body(
 145             "Cannot find a Content-Type supported by your client.\r\n" );
 146     }
 147     return undef;
 148 }
 149
 150 sub _serialize_bad_request {
 151     my ( $self, $c, $content_type, $error ) = @_;
 152     $c->res->content_type('text/plain');
 153     $c->res->status(400);
 154     $c->res->body(
 155         "Content-Type " . $content_type . " had a problem with your request.\r\n***ERROR***\r\n$error" );
 156     return undef;
 157 }
 158
 159 1;
 160
 161 =head1 NAME
 162
 163 B<Catalyst::Action::SerializeBase>
 164
 165 Base class for Catalyst::Action::Serialize and Catlayst::Action::Deserialize.
 166
 167 =head1 DESCRIPTION
 168
 169 This module implements the plugin loading and content-type negotiating
 170 code for L<Catalyst::Action::Serialize> and L<Catalyst::Action::Deserialize>.
 171
 172 =head1 SEE ALSO
 173
 174 L<Catalyst::Action::Serialize>, L<Catalyst::Action::Deserialize>,
 175 L<Catalyst::Controller::REST>,
 176
 177 =head1 AUTHORS
 178
 179 See L<Catalyst::Action::REST> for authors.
 180
 181 =head1 LICENSE
 182
 183 You may distribute this code under the same terms as Perl itself.
 184
 185 =cut