Making the default serializer be specified by content-type, not module.
[catagits/Catalyst-Action-REST.git] / 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
48     # If we don't have a handler for our preferred content type, try
49     # the default
50     if ( ! exists $map->{$content_type} ) {
51         if( exists $controller->config->{'serialize'}->{'default'} ) {
52             $content_type = $controller->config->{'serialize'}->{'default'} ;
53         } else {
54             return $self->_unsupported_media_type($c, $content_type);
55         }
56     }
57
58     if ( exists( $map->{$content_type} ) ) {
59         my $mc;
60         if ( ref( $map->{$content_type} ) eq "ARRAY" ) {
61             $mc   = $map->{$content_type}->[0];
62             $sarg = $map->{$content_type}->[1];
63         } else {
64             $mc = $map->{$content_type};
65         }
66         # TODO: Handle custom serializers more elegantly.. this is a start,
67         # but how do we determine which is Serialize and Deserialize?
68         #if ($mc =~ /^+/) {
69         #    $sclass = $mc;
70         #    $sclass =~ s/^+//g;
71         #} else {
72         $sclass .= $mc;
73         #}
74         if ( !grep( /^$sclass$/, @{ $self->_serialize_plugins } ) ) {
75             return $self->_unsupported_media_type($c, $content_type);
76         }
77     } else {
78         return $self->_unsupported_media_type($c, $content_type);
79     }
80     unless ( exists( $self->_loaded_plugins->{$sclass} ) ) {
81         my $load_class = $sclass;
82         $load_class =~ s/::/\//g;
83         $load_class =~ s/$/.pm/g;
84         eval { require $load_class; };
85         if ($@) {
86             $c->log->error(
87                 "Error loading $sclass for " . $content_type . ": $!" )
88               if $c->log->is_debug;
89             return $self->_unsupported_media_type($c, $content_type);
90         } else {
91             $self->_loaded_plugins->{$sclass} = 1;
92         }
93     }
94
95     if ($search_path eq "Catalyst::Action::Serialize") {
96         if ($content_type) {
97             $c->response->header( 'Vary' => 'Content-Type' );
98         } elsif ($c->request->accept_only) {
99             $c->response->header( 'Vary' => 'Accept' );
100         }
101         $c->response->content_type($content_type);
102     }
103
104     return $sclass, $sarg, $content_type;
105 }
106
107 sub _unsupported_media_type {
108     my ( $self, $c, $content_type ) = @_;
109     $c->res->content_type('text/plain');
110     $c->res->status(415);
111     if (defined($content_type) && $content_type ne "") {
112         $c->res->body(
113             "Content-Type " . $content_type . " is not supported.\r\n" );
114     } else {
115         $c->res->body(
116             "Cannot find a Content-Type supported by your client.\r\n" );
117     }
118     return undef;
119 }
120
121 sub _serialize_bad_request {
122     my ( $self, $c, $content_type, $error ) = @_;
123     $c->res->content_type('text/plain');
124     $c->res->status(400);
125     $c->res->body(
126         "Content-Type " . $content_type . " had a problem with your request.\r\n***ERROR***\r\n$error" );
127     return undef;
128 }
129
130 1;
131
132 =head1 NAME
133
134 B<Catalyst::Action::SerializeBase>
135
136 Base class for Catalyst::Action::Serialize and Catlayst::Action::Deserialize.
137
138 =head1 DESCRIPTION
139
140 This module implements the plugin loading and content-type negotiating
141 code for L<Catalyst::Action::Serialize> and L<Catalyst::Action::Deserialize>.
142
143 =head1 SEE ALSO
144
145 L<Catalyst::Action::Serialize>, L<Catalyst::Action::Deserialize>,
146 L<Catalyst::Controller::REST>,
147
148 =head1 AUTHOR
149
150 Adam Jacob <adam@stalecoffee.org>, with lots of help from mst and jrockway.
151
152 Marchex, Inc. paid me while I developed this module.  (http://www.marchex.com)
153
154 =head1 LICENSE
155
156 You may distribute this code under the same terms as Perl itself.
157
158 =cut
159