lib/Catalyst/Action/SerializeBase.pm

   1 #
   2 # Catlyst::Action::SerializeBase.pm
   3 # Created by: Adam Jacob, Marchex, <adam@marchex.com>
   4 #
   5 # $Id$
   6
   7 package Catalyst::Action::SerializeBase;
   8
   9 use strict;
  10 use warnings;
  11
  12 use base 'Catalyst::Action';
  13 use Module::Pluggable::Object;
  14 use Data::Dump qw(dump);
  15 use Catalyst::Request::REST;
  16
  17 Catalyst->request_class('Catalyst::Request::REST')
  18     unless Catalyst->request_class->isa('Catalyst::Request::REST');
  19
  20 __PACKAGE__->mk_accessors(qw(_serialize_plugins _loaded_plugins));
  21
  22 sub _load_content_plugins {
  23     my $self = shift;
  24     my ( $search_path, $controller, $c ) = @_;
  25
  26     unless ( defined( $self->_loaded_plugins ) ) {
  27         $self->_loaded_plugins( {} );
  28     }
  29
  30     # Load the Serialize Classes
  31     unless ( defined( $self->_serialize_plugins ) ) {
  32         my @plugins;
  33         my $mpo =
  34           Module::Pluggable::Object->new( 'search_path' => [$search_path], );
  35         @plugins = $mpo->plugins;
  36         $self->_serialize_plugins( \@plugins );
  37     }
  38
  39     my $content_type = $c->request->preferred_content_type;
  40
  41     # Finally, we load the class.  If you have a default serializer,
  42     # and we still don't have a content-type that exists in the map,
  43     # we'll use it.
  44     my $sclass = $search_path . "::";
  45     my $sarg;
  46     my $map = $controller->config->{'serialize'}->{'map'};
  47     if ( exists( $map->{$content_type} ) ) {
  48         my $mc;
  49         if ( ref( $map->{$content_type} ) eq "ARRAY" ) {
  50             $mc   = $map->{$content_type}->[0];
  51             $sarg = $map->{$content_type}->[1];
  52         } else {
  53             $mc = $map->{$content_type};
  54         }
  55         # TODO: Handle custom serializers more elegantly.. this is a start,
  56         # but how do we determine which is Serialize and Deserialize?
  57         #if ($mc =~ /^+/) {
  58         #    $sclass = $mc;
  59         #    $sclass =~ s/^+//g;
  60         #} else {
  61         $sclass .= $mc;
  62         #}
  63         if ( !grep( /^$sclass$/, @{ $self->_serialize_plugins } ) ) {
  64             return $self->_unsupported_media_type($c, $content_type);
  65         }
  66     } else {
  67         if ( exists( $controller->config->{'serialize'}->{'default'} ) ) {
  68             $sclass .= $controller->config->{'serialize'}->{'default'};
  69         } else {
  70             return $self->_unsupported_media_type($c, $content_type);
  71         }
  72     }
  73     unless ( exists( $self->_loaded_plugins->{$sclass} ) ) {
  74         my $load_class = $sclass;
  75         $load_class =~ s/::/\//g;
  76         $load_class =~ s/$/.pm/g;
  77         eval { require $load_class; };
  78         if ($@) {
  79             $c->log->error(
  80                 "Error loading $sclass for " . $content_type . ": $!" )
  81               if $c->log->is_debug;
  82             return $self->_unsupported_media_type($c, $content_type);
  83         } else {
  84             $self->_loaded_plugins->{$sclass} = 1;
  85         }
  86     }
  87
  88     if ($search_path eq "Catalyst::Action::Serialize") {
  89         if ($content_type) {
  90             $c->response->header( 'Vary' => 'Content-Type' );
  91         } elsif ($c->request->accept_only) {
  92             $c->response->header( 'Vary' => 'Accept' );
  93         }
  94         $c->response->content_type($content_type);
  95     }
  96
  97     return $sclass, $sarg, $content_type;
  98 }
  99
 100 sub _unsupported_media_type {
 101     my ( $self, $c, $content_type ) = @_;
 102     $c->res->content_type('text/plain');
 103     $c->res->status(415);
 104     if (defined($content_type) && $content_type ne "") {
 105         $c->res->body(
 106             "Content-Type " . $content_type . " is not supported.\r\n" );
 107     } else {
 108         $c->res->body(
 109             "Cannot find a Content-Type supported by your client.\r\n" );
 110     }
 111     return undef;
 112 }
 113
 114 sub _serialize_bad_request {
 115     my ( $self, $c, $content_type, $error ) = @_;
 116     $c->res->content_type('text/plain');
 117     $c->res->status(400);
 118     $c->res->body(
 119         "Content-Type " . $content_type . " had a problem with your request.\r\n***ERROR***\r\n$error" );
 120     return undef;
 121 }
 122
 123 1;
 124
 125 =head1 NAME
 126
 127 B<Catalyst::Action::SerializeBase>
 128
 129 Base class for Catalyst::Action::Serialize and Catlayst::Action::Deserialize.
 130
 131 =head1 DESCRIPTION
 132
 133 This module implements the plugin loading and content-type negotiating
 134 code for L<Catalyst::Action::Serialize> and L<Catalyst::Action::Deserialize>.
 135
 136 =head1 SEE ALSO
 137
 138 L<Catalyst::Action::Serialize>, L<Catalyst::Action::Deserialize>,
 139 L<Catalyst::Controller::REST>,
 140
 141 =head1 AUTHOR
 142
 143 Adam Jacob <adam@stalecoffee.org>, with lots of help from mst and jrockway.
 144
 145 Marchex, Inc. paid me while I developed this module.  (http://www.marchex.com)
 146
 147 =head1 LICENSE
 148
 149 You may distribute this code under the same terms as Perl itself.
 150
 151 =cut
 152