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