perltidy
[catagits/Catalyst-Action-REST.git] / lib / Catalyst / Action / SerializeBase.pm
CommitLineData
e601adda 1#
2# Catlyst::Action::SerializeBase.pm
3# Created by: Adam Jacob, Marchex, <adam@marchex.com>
4#
5# $Id$
6
7package Catalyst::Action::SerializeBase;
8
9use strict;
10use warnings;
11
12use base 'Catalyst::Action';
13use Module::Pluggable::Object;
14use Data::Dump qw(dump);
9a76221e 15use Catalyst::Request::REST;
16
17Catalyst->request_class('Catalyst::Request::REST')
18 unless Catalyst->request_class->isa('Catalyst::Request::REST');
e601adda 19
20__PACKAGE__->mk_accessors(qw(_serialize_plugins _loaded_plugins));
21
22sub _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
9a76221e 39 my $content_type = $c->request->preferred_content_type;
e601adda 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' );
9a76221e 91 } elsif ($c->request->accept_only) {
e601adda 92 $c->response->header( 'Vary' => 'Accept' );
93 }
94 $c->response->content_type($content_type);
95 }
96
97 return $sclass, $sarg, $content_type;
98}
99
100sub _unsupported_media_type {
101 my ( $self, $c, $content_type ) = @_;
102 $c->res->content_type('text/plain');
103 $c->res->status(415);
2224bad1 104 if (defined($content_type) && $content_type ne "") {
e601adda 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
114sub _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
1231;
124
125=head1 NAME
126
127B<Catalyst::Action::SerializeBase>
128
129Base class for Catalyst::Action::Serialize and Catlayst::Action::Deserialize.
130
131=head1 DESCRIPTION
132
133This module implements the plugin loading and content-type negotiating
134code for L<Catalyst::Action::Serialize> and L<Catalyst::Action::Deserialize>.
135
136=head1 SEE ALSO
137
138L<Catalyst::Action::Serialize>, L<Catalyst::Action::Deserialize>,
139L<Catalyst::Controller::REST>,
140
141=head1 AUTHOR
142
143Adam Jacob <adam@stalecoffee.org>, with lots of help from mst and jrockway.
144
145Marchex, Inc. paid me while I developed this module. (http://www.marchex.com)
146
147=head1 LICENSE
148
149You may distribute this code under the same terms as Perl itself.
150
151=cut
152