3 # Created by: Adam Jacob, Marchex, <adam@hjksolutions.com>
4 # Created on: 10/13/2006 03:54:33 PM PDT
8 package Catalyst::Request::REST;
12 use Scalar::Util qw/blessed/;
14 use base qw/Catalyst::Request Class::Accessor::Fast/;
17 use HTTP::Headers::Util qw(split_header_words);
19 sub _insert_self_into {
20 my ($class, $app_class ) = @_;
21 # the fallback to $app_class is for the (rare and deprecated) case when
22 # people are defining actions in MyApp.pm instead of in a controller.
23 my $app = (blessed($app_class) && $app_class->can('_application'))
24 ? $app_class->_application : Catalyst::Utils::class2appclass( $app_class ) || $app_class;
26 my $req_class = $app->request_class;
27 return if $req_class->isa($class);
28 if ($req_class eq 'Catalyst::Request') {
29 $app->request_class($class);
31 die "$app has a custom request class $req_class, "
32 . "which is not a $class; see Catalyst::Request::REST";
38 Catalyst::Request::REST - A REST-y subclass of Catalyst::Request
42 if ( $c->request->accepts('application/json') ) {
46 my $types = $c->request->accepted_content_types();
50 This is a subclass of C<Catalyst::Request> that adds a few methods to
51 the request object to faciliate writing REST-y code. Currently, these
52 methods are all related to the content types accepted by the client.
54 Note that if you have a custom request class in your application, and it does
55 not inherit from C<Catalyst::Request::REST>, your application will fail with an
56 error indicating a conflict the first time it tries to use
57 C<Catalyst::Request::REST>'s functionality. To fix this error, make sure your
58 custom request class inherits from C<Catalyst::Request::REST>.
62 If the request went through the Deserializer action, this method will
63 returned the deserialized data structure.
67 __PACKAGE__->mk_accessors(qw(data accept_only));
71 =item accepted_content_types
73 Returns an array reference of content types accepted by the
76 The list of types is created by looking at the following sources:
80 =item * Content-type header
82 If this exists, this will always be the first type in the list.
84 =item * content-type parameter
86 If the request is a GET request and there is a "content-type"
87 parameter in the query string, this will come before any types in the
92 This will be parsed and the types found will be ordered by the
93 relative quality specified for each type.
97 If a type appears in more than one of these places, it is ordered based on
98 where it is first found.
102 sub accepted_content_types {
105 return $self->{content_types} if $self->{content_types};
109 # First, we use the content type in the HTTP Request. It wins all.
110 $types{ $self->content_type } = 3
111 if $self->content_type;
113 if ($self->method eq "GET" && $self->param('content-type')) {
114 $types{ $self->param('content-type') } = 2;
117 # Third, we parse the Accept header, and see if the client
118 # takes a format we understand.
120 # This is taken from chansen's Apache2::UploadProgress.
121 if ( $self->header('Accept') ) {
122 $self->accept_only(1) unless keys %types;
124 my $accept_header = $self->header('Accept');
127 foreach my $pair ( split_header_words($accept_header) ) {
128 my ( $type, $qvalue ) = @{$pair}[ 0, 3 ];
129 next if $types{$type};
131 unless ( defined $qvalue ) {
132 $qvalue = 1 - ( ++$counter / 1000 );
135 $types{$type} = sprintf( '%.3f', $qvalue );
139 return $self->{content_types} =
140 [ sort { $types{$b} <=> $types{$a} } keys %types ];
143 =item preferred_content_type
145 This returns the first content type found. It is shorthand for:
147 $request->accepted_content_types->[0]
151 sub preferred_content_type { $_[0]->accepted_content_types->[0] }
155 Given a content type, this returns true if the type is accepted.
157 Note that this does not do any wildcard expansion of types.
165 return grep { $_ eq $type } @{ $self->accepted_content_types };
172 Adam Jacob <adam@stalecoffee.org>, with lots of help from mst and jrockway
176 J. Shirley <jshirley@cpan.org>
180 You may distribute this code under the same terms as Perl itself.