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;
13 use base 'Catalyst::Request';
14 use HTTP::Headers::Util qw(split_header_words);
19 Catalyst::Request::REST - A REST-y subclass of Catalyst::Request
23 if ( $c->request->accepts('text/x-json') ) {
27 my $types = $c->request->accepted_content_types();
31 This is a subclass of C<Catalyst::Request> that adds a few methods to
32 the request object to faciliate writing REST-y code. Currently, these
33 methods are all related to the content types accepted by the client.
40 If the request went through the Deserializer action, this method will
41 returned the deserialized data structure.
45 __PACKAGE__->mk_accessors(qw(data accept_only));
47 =item accepted_content_types
49 Returns an array reference of content types accepted by the
52 The list of types is created by looking at the following sources:
56 =item * Content-type header
58 If this exists, this will always be the first type in the list.
60 =item * content-type parameter
62 If the request is a GET request and there is a "content-type"
63 parameter in the query string, this will come before any types in the
68 This will be parsed and the types found will be ordered by the
69 relative quality specified for each type.
73 If a type appears in more than one of these places, it is ordered based on
74 where it is first found.
78 sub accepted_content_types {
81 return $self->{content_types} if $self->{content_types};
85 # First, we use the content type in the HTTP Request. It wins all.
86 $types{ $self->content_type } = 3
87 if $self->content_type;
89 if ($self->method eq "GET" && $self->param('content-type')) {
90 $types{ $self->param('content-type') } = 2;
93 # Third, we parse the Accept header, and see if the client
94 # takes a format we understand.
96 # This is taken from chansen's Apache2::UploadProgress.
97 if ( $self->header('Accept') ) {
98 $self->accept_only(1) unless keys %types;
100 my $accept_header = $self->header('Accept');
103 foreach my $pair ( split_header_words($accept_header) ) {
104 my ( $type, $qvalue ) = @{$pair}[ 0, 3 ];
105 next if $types{$type};
107 unless ( defined $qvalue ) {
108 $qvalue = 1 - ( ++$counter / 1000 );
111 $types{$type} = sprintf( '%.3f', $qvalue );
115 return $self->{content_types} =
116 [ sort { $types{$b} <=> $types{$a} } keys %types ];
119 =item preferred_content_type
121 This returns the first content type found. It is shorthand for:
123 $request->accepted_content_types->[0]
127 sub preferred_content_type { $_[0]->accepted_content_types->[0] }
131 Given a content type, this returns true if the type is accepted.
133 Note that this does not do any wildcard expansion of types.
141 return grep { $_ eq $type } @{ $self->accepted_content_types };
146 Adam Jacob <adam@stalecoffee.org>, with lots of help from mst and jrockway
150 You may distribute this code under the same terms as Perl itself.