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