which brings this class together with automatic Serialization of requests
and responses.
-When you use this module, the request class will be changed to
-L<Catalyst::Request::REST>.
+When you use this module, it adds the L<Catalyst::TraitFor::Request::REST>
+role to your request class.
=head1 METHODS
=head1 SEE ALSO
-You likely want to look at L<Catalyst::Controller::REST>, which implements
-a sensible set of defaults for a controller doing REST.
+You likely want to look at L<Catalyst::Controller::REST>, which implements a
+sensible set of defaults for a controller doing REST.
+
+This class automatically adds the L<Catalyst::TraitFor::Request::REST> role to
+your request class. If you're writing a webapp which provides RESTful
+responses and still needs to accomodate web browsers, you may prefer to use
+L<Catalyst::TraitFor::Request::REST::ForBrowsers> instead.
L<Catalyst::Action::Serialize>, L<Catalyst::Action::Deserialize>
=head1 DESCRIPTION
This is a subclass of C<Catalyst::Request> that applies the
-L<Catalyst::TraitFor::Request::REST> which adds a few methods to
-the request object to faciliate writing REST-y code.
+L<Catalyst::TraitFor::Request::REST> role to your request class. That trait
+adds a few methods to the request object to faciliate writing REST-y code.
-This class is only here for backwards compatibility with applications
-already subclassing this class.
+This class is only here for backwards compatibility with applications already
+subclassing this class. New code should use
+L<Catalyst::TraitFor::Request::REST> directly.
L<Catalyst::Action::REST> and L<Catalyst::Controller::REST> will arrange
for the request trait to be applied if needed.
--- /dev/null
+package Catalyst::Request::REST::ForBrowsers;
+use Moose;
+
+use namespace::autoclean;
+
+our $VERSION = '0.80';
+$VERSION = eval $VERSION;
+
+extends 'Catalyst::Request::REST';
+with 'Catalyst::TraitFor::Request::REST::ForBrowsers';
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Request::REST::ForBrowsers - A Catalyst::Request::REST subclass for dealing with browsers
+
+=head1 SYNOPSIS
+
+ package MyApp;
+
+ use Catalyst::Request::REST::ForBrowsers;
+
+ MyApp->request_class( 'Catalyst::Request::REST::ForBrowsers' );
+
+=head1 DESCRIPTION
+
+This class has been deprecated in favor of
+L<Catalyst::TraitFor::Request::REST::ForBrowsers>. Please see that class for
+details on methods and attributes.
+
+=head1 AUTHOR
+
+Dave Rolsky, C<< <autarch@urth.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-catalyst-request-rest-forbrowsers@rt.cpan.org>, or through the
+web interface at L<http://rt.cpan.org>. I will be notified, and then
+you'll automatically be notified of progress on your bug as I make
+changes.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008-2009 Dave Rolsky, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
has [qw/ data accept_only /] => ( is => 'rw' );
-sub accepted_content_types {
+has accepted_content_types => (
+ is => 'ro',
+ isa => 'ArrayRef',
+ lazy => 1,
+ builder => '_build_accepted_content_types',
+ init_arg => undef,
+);
+
+has preferred_content_type => (
+ is => 'ro',
+ isa => 'Str',
+ lazy => 1,
+ builder => '_build_preferred_content_type',
+ init_arg => undef,
+);
+
+sub _build_accepted_content_types {
my $self = shift;
- return $self->{content_types} if $self->{content_types};
-
my %types;
# First, we use the content type in the HTTP Request. It wins all.
}
}
- return $self->{content_types} =
- [ sort { $types{$b} <=> $types{$a} } keys %types ];
+ [ sort { $types{$b} <=> $types{$a} } keys %types ];
}
-sub preferred_content_type { $_[0]->accepted_content_types->[0] }
+sub _build_preferred_content_type { $_[0]->accepted_content_types->[0] }
sub accepts {
my $self = shift;
--- /dev/null
+package Catalyst::TraitFor::Request::REST::ForBrowsers;
+use Moose::Role;
+use namespace::autoclean;
+
+with 'Catalyst::TraitFor::Request::REST';
+
+has _determined_real_method => (
+ is => 'rw',
+ isa => 'Bool',
+);
+
+has looks_like_browser => (
+ is => 'rw',
+ isa => 'Bool',
+ lazy => 1,
+ builder => '_build_looks_like_browser',
+ init_arg => undef,
+);
+
+# All this would be much less gross if Catalyst::Request used a builder to
+# determine the method. Then we could just wrap the builder.
+around method => sub {
+ my $orig = shift;
+ my $self = shift;
+
+ return $self->$orig(@_)
+ if @_ || $self->_determined_real_method;
+
+ my $method = $self->$orig();
+
+ my $tunneled;
+ if ( defined $method && uc $method eq 'POST' ) {
+ $tunneled = $self->param('x-tunneled-method')
+ || $self->header('x-http-method-override');
+ }
+
+ $self->$orig( defined $tunneled ? uc $tunneled : $method );
+
+ $self->_determined_real_method(1);
+
+ return $self->$orig();
+};
+
+{
+ my %HTMLTypes = map { $_ => 1 } qw(
+ text/html
+ application/xhtml+xml
+ );
+
+ sub _build_looks_like_browser {
+ my $self = shift;
+
+ my $with = $self->header('x-requested-with');
+ return 0
+ if $with && grep { $with eq $_ }
+ qw( HTTP.Request XMLHttpRequest );
+
+ if ( uc $self->method eq 'GET' ) {
+ my $forced_type = $self->param('content-type');
+ return 0
+ if $forced_type && !$HTMLTypes{$forced_type};
+ }
+
+ # IE7 does not say it accepts any form of html, but _does_
+ # accept */* (helpful ;)
+ return 1
+ if $self->accepts('*/*');
+
+ return 1
+ if grep { $self->accepts($_) } keys %HTMLTypes;
+
+ return 0
+ if @{ $self->accepted_content_types() };
+
+ # If the client did not specify any content types at all,
+ # assume they are a browser.
+ return 1;
+ }
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::TraitFor::Request::REST::ForBrowsers - A request trait for REST and browsers
+
+=head1 SYNOPSIS
+
+ package MyApp;
+
+ use Catalyst::TraitFor::Request::REST::ForBrowsers;
+
+
+
+=head1 DESCRIPTION
+
+Writing REST-y apps is a good thing, but if you're also trying to support web
+browsers, you're probably going to need some hackish workarounds. This module
+provides those workarounds for you.
+
+Specifically, it lets you do two things. First, it lets you "tunnel" PUT and
+DELETE requests across a POST, since most browsers do not support PUT or
+DELETE actions (as of early 2009, at least).
+
+Second, it provides a heuristic to check if the client is a web browser,
+regardless of what content types it claims to accept. The reason for this is
+that while a browser might claim to accept the "application/xml" content type,
+it's really not going to do anything useful with it, and you're best off
+giving it HTML.
+
+=head1 METHODS
+
+This class provides the following methods:
+
+=head2 $request->method
+
+This method works just like C<< Catalyst::Request->method() >> except it
+allows for tunneling of PUT and DELETE requests via a POST.
+
+Specifically, you can provide a form element named "x-tunneled-method" which
+can override the request method for a POST. This I<only> works for a POST, not
+a GET.
+
+You can also use a header named "x-http-method-override" instead (Google uses
+this header for its APIs).
+
+=head2 $request->looks_like_browser
+
+This attribute provides a heuristic to determine whether or not the request
+I<appears> to come from a browser. You can use this however you want. I
+usually use it to determine whether or not to give the client a full HTML page
+or some sort of serialized data.
+
+This is a heuristic, and like any heuristic, it is probably wrong
+sometimes. Here is how it works:
+
+=over 4
+
+=item *
+
+If the request includes a header "X-Request-With" set to either "HTTP.Request"
+or "XMLHttpRequest", this returns false. The assumption is that if you're
+doing XHR, you don't want the request treated as if it comes from a browser.
+
+=item *
+
+If the client makes a GET request with a query string parameter
+"content-type", and that type is I<not> an HTML type, it is I<not> a browser.
+
+=item *
+
+If the client provides an Accept header which includes "*/*" as an accepted
+content type, the client is a browser. Specifically, it is IE7, which submits
+an Accept header of "*/*". IE7's Accept header does not include any html types
+like "text/html".
+
+=item *
+
+If the client provides an Accept header and accepts either "text/html" or
+"application/xhtml+xml" it is a browser.
+
+=item *
+
+If it provides an Accept header of any sort, it is I<not> a browser.
+
+=item *
+
+The default is that the client is a browser.
+
+=back
+
+This all works well for my apps, but read it carefully to make sure it meets
+your expectations before using it.
+
+=head1 AUTHOR
+
+Dave Rolsky, C<< <autarch@urth.org> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-catalyst-action-rest@rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org>. We will be notified, and then you'll automatically be
+notified of progress on your bug as I make changes.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008-2010 Dave Rolsky, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+++ /dev/null
-use strict;
-use warnings;
-use Test::More;
-use FindBin;
-use lib ( "$FindBin::Bin/../lib", "$FindBin::Bin/../t/lib" );
-
-use Catalyst::Request::REST;
-use HTTP::Headers;
-
-{
- my $request = Catalyst::Request::REST->new;
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->content_type('text/foobar');
-
- is_deeply( $request->accepted_content_types, [ 'text/foobar' ],
- 'content-type set in request headers is found' );
- is( $request->preferred_content_type, 'text/foobar',
- 'preferred content type is text/foobar' );
- ok( ! $request->accept_only, 'accept_only is false' );
- ok( $request->accepts('text/foobar'), 'accepts text/foobar' );
- ok( ! $request->accepts('text/html'), 'does not accept text/html' );
-}
-
-{
- my $request = Catalyst::Request::REST->new;
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( { 'content-type' => 'text/fudge' } );
- $request->method('GET');
- $request->content_type('text/foobar');
-
- is_deeply( $request->accepted_content_types, [ 'text/foobar', 'text/fudge' ],
- 'content-type set in request headers and type in parameters is found' );
- is( $request->preferred_content_type, 'text/foobar',
- 'preferred content type is text/foobar' );
- ok( ! $request->accept_only, 'accept_only is false' );
- ok( $request->accepts('text/foobar'), 'accepts text/foobar' );
- ok( $request->accepts('text/fudge'), 'accepts text/fudge' );
- ok( ! $request->accepts('text/html'), 'does not accept text/html' );
-}
-
-{
- my $request = Catalyst::Request::REST->new;
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( { 'content-type' => 'text/fudge' } );
- $request->method('POST');
- $request->content_type('text/foobar');
-
- ok( ! $request->accepts('text/fudge'), 'content type in parameters is ignored for POST' );
-}
-
-{
- my $request = Catalyst::Request::REST->new;
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->headers->header(
- 'Accept' =>
- # From Firefox 2.0 when it requests an html page
- 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
- );
-
- is_deeply( $request->accepted_content_types,
- [ qw( text/xml application/xml application/xhtml+xml
- image/png
- text/html
- text/plain
- */*
- ) ],
- 'accept header is parsed properly' );
- is( $request->preferred_content_type, 'text/xml',
- 'preferred content type is text/xml' );
- ok( $request->accept_only, 'accept_only is true' );
- ok( $request->accepts('text/html'), 'accepts text/html' );
- ok( $request->accepts('image/png'), 'accepts image/png' );
- ok( ! $request->accepts('image/svg'), 'does not accept image/svg' );
-}
-
-{
- my $request = Catalyst::Request::REST->new;
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->content_type('application/json');
- $request->headers->header(
- 'Accept' =>
- # From Firefox 2.0 when it requests an html page
- 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
- );
-
- is_deeply( $request->accepted_content_types,
- [ qw( application/json
- text/xml application/xml application/xhtml+xml
- image/png
- text/html
- text/plain
- */*
- ) ],
- 'accept header is parsed properly, and content-type header has precedence over accept' );
- ok( ! $request->accept_only, 'accept_only is false' );
-}
-
-{
- my $request = Catalyst::Request::REST->new;
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->content_type('application/json');
- $request->headers->header(
- 'Accept' =>
- # From Firefox 2.0 when it requests an html page
- 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
- );
-
- is_deeply( $request->accepted_content_types,
- [ qw( application/json
- text/xml application/xml application/xhtml+xml
- image/png
- text/html
- text/plain
- */*
- ) ],
- 'accept header is parsed properly, and content-type header has precedence over accept' );
- ok( ! $request->accept_only, 'accept_only is false' );
-}
-
-{
- my $request = Catalyst::Request::REST->new;
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->content_type('text/x-json');
- $request->headers->header(
- 'Accept' => 'text/plain,text/x-json',
- );
-
- is_deeply( $request->accepted_content_types,
- [ qw( text/x-json
- text/plain
- ) ],
- 'each type appears only once' );
-}
-
-{
- my $request = Catalyst::Request::REST->new;
- $request->{_context} = 'MockContext';
- $request->headers( HTTP::Headers->new );
- $request->parameters( {} );
- $request->method('GET');
- $request->content_type('application/json');
- $request->headers->header(
- 'Accept' => 'text/plain,application/json',
- );
-
- is_deeply( $request->accepted_content_types,
- [ qw( application/json
- text/plain
- ) ],
- 'each type appears only once' );
-}
-
-{
- local %ENV=%ENV;
- $ENV{CATALYST_DEBUG} = 0;
- my $test = 'Test::Catalyst::Action::REST';
- use_ok $test;
- is($test->request_class, 'Catalyst::Request::REST',
- 'Request::REST took over for Request');
-
- my $meta = Moose::Meta::Class->create_anon_class(
- superclasses => ['Catalyst::Request'],
- );
- $meta->add_method('__random_method' => sub { 42 });
-
- $test->request_class($meta->name);
- # FIXME - setup_finished(0) is evil!
- eval { $test->setup_finished(0); $test->setup };
- ok !$@, 'Can setup again';
- isnt $test->request_class, $meta->name, 'Different request class';
- ok $test->request_class->can('__random_method'), 'Is right class';
- ok $test->request_class->can('data'), 'Also smells like REST subclass';
-
- {
- package My::Request;
- use base 'Catalyst::Request::REST';
- }
- $test->request_class('My::Request');
- eval { $test->setup_finished(0); $test->setup };
- is $@, '', 'no error from Request::REST subclass';
-}
-
-done_testing;
-
-package MockContext;
-
-sub prepare_body { }
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+
+use Catalyst::Request;
+use Catalyst::Request::REST::ForBrowsers;
+use Catalyst::TraitFor::Request::REST::ForBrowsers;
+use Moose::Meta::Class;
+use HTTP::Headers;
+
+my $anon_class = Moose::Meta::Class->create_anon_class(
+ superclasses => ['Catalyst::Request'],
+ roles => ['Catalyst::TraitFor::Request::REST::ForBrowsers'],
+ cache => 1,
+)->name;
+
+# We run the tests twice to make sure Catalyst::Request::REST::ForBrowsers is
+# 100% back-compatible.
+for my $class ( $anon_class, 'Catalyst::Request::REST::ForBrowsers' ) {
+ {
+ for my $method (qw( GET POST PUT DELETE )) {
+ my $req = $class->new();
+ $req->method($method);
+ $req->{_context} = 'MockContext';
+ $req->parameters( {} );
+
+ is(
+ $req->method(), $method,
+ "$method - not tunneled"
+ );
+ }
+ }
+
+ {
+ for my $method (qw( PUT DELETE )) {
+ my $req = $class->new();
+ $req->method('POST');
+ $req->{_context} = 'MockContext';
+ $req->parameters( { 'x-tunneled-method' => $method } );
+
+ is(
+ $req->method(), $method,
+ "$method - tunneled with x-tunneled-method param"
+ );
+ }
+ }
+
+ {
+ for my $method (qw( PUT DELETE )) {
+ my $req = $class->new();
+ $req->method('POST');
+ $req->{_context} = 'MockContext';
+ $req->header( 'x-http-method-override' => $method );
+
+ is(
+ $req->method(), $method,
+ "$method - tunneled with x-http-method-override header"
+ );
+ }
+ }
+
+ {
+ for my $method (qw( PUT DELETE )) {
+ my $req = $class->new();
+ $req->method('GET');
+ $req->{_context} = 'MockContext';
+ $req->parameters( { 'x-tunneled-method' => $method } );
+
+ is(
+ $req->method(), 'GET',
+ 'x-tunneled-method is ignore with a GET'
+ );
+ }
+ }
+
+ {
+ my $req = $class->new();
+ $req->{_context} = 'MockContext';
+ $req->method('GET');
+ $req->parameters( {} );
+ $req->headers( HTTP::Headers->new() );
+
+ ok(
+ $req->looks_like_browser(),
+ 'default is a browser'
+ );
+ }
+
+ {
+ for my $with (qw( HTTP.Request XMLHttpRequest )) {
+ my $req = $class->new();
+ $req->{_context} = 'MockContext';
+ $req->headers(
+ HTTP::Headers->new( 'X-Requested-With' => $with ) );
+
+ ok(
+ !$req->looks_like_browser(),
+ "not a browser - X-Request-With = $with"
+ );
+ }
+ }
+
+ {
+ my $req = $class->new();
+ $req->{_context} = 'MockContext';
+ $req->method('GET');
+ $req->parameters( { 'content-type' => 'text/json' } );
+ $req->headers( HTTP::Headers->new() );
+
+ ok(
+ !$req->looks_like_browser(),
+ 'forced non-HTML content-type is not a browser'
+ );
+ }
+
+ {
+ my $req = $class->new();
+ $req->{_context} = 'MockContext';
+ $req->method('GET');
+ $req->parameters( { 'content-type' => 'text/html' } );
+ $req->headers( HTTP::Headers->new() );
+
+ ok(
+ $req->looks_like_browser(),
+ 'forced HTML content-type is not a browser'
+ );
+ }
+
+ {
+ my $req = $class->new();
+ $req->{_context} = 'MockContext';
+ $req->method('GET');
+ $req->parameters( {} );
+ $req->headers(
+ HTTP::Headers->new( 'Accept' => 'text/xml; q=0.4, */*; q=0.2' ) );
+
+ ok(
+ $req->looks_like_browser(),
+ 'if it accepts */* it is a browser'
+ );
+ }
+
+ {
+ my $req = $class->new();
+ $req->{_context} = 'MockContext';
+ $req->method('GET');
+ $req->parameters( {} );
+ $req->headers(
+ HTTP::Headers->new(
+ 'Accept' => 'text/html; q=0.4, text/xml; q=0.2'
+ )
+ );
+
+ ok(
+ $req->looks_like_browser(),
+ 'if it accepts text/html it is a browser'
+ );
+ }
+
+ {
+ my $req = $class->new();
+ $req->{_context} = 'MockContext';
+ $req->method('GET');
+ $req->parameters( {} );
+ $req->headers(
+ HTTP::Headers->new(
+ 'Accept' => 'application/xhtml+xml; q=0.4, text/xml; q=0.2'
+ )
+ );
+
+ ok(
+ $req->looks_like_browser(),
+ 'if it accepts application/xhtml+xml it is a browser'
+ );
+ }
+
+ {
+ my $req = $class->new();
+ $req->{_context} = 'MockContext';
+ $req->method('GET');
+ $req->parameters( {} );
+ $req->headers(
+ HTTP::Headers->new(
+ 'Accept' => 'text/json; q=0.4, text/xml; q=0.2'
+ )
+ );
+
+ ok(
+ !$req->looks_like_browser(),
+ 'provided an Accept header but does not accept html, is not a browser'
+ );
+ }
+}
+
+done_testing;
+
+package MockContext;
+
+sub prepare_body { }
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+use FindBin;
+use lib ( "$FindBin::Bin/../lib", "$FindBin::Bin/../t/lib" );
+
+use Catalyst::Request::REST;
+use Catalyst::TraitFor::Request::REST;
+use Moose::Meta::Class;
+use HTTP::Headers;
+
+my $anon_class = Moose::Meta::Class->create_anon_class(
+ superclasses => ['Catalyst::Request'],
+ roles => ['Catalyst::TraitFor::Request::REST::ForBrowsers'],
+ cache => 1,
+)->name;
+
+for my $class ( $anon_class, 'Catalyst::Request::REST' ) {
+ {
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( {} );
+ $request->method('GET');
+ $request->content_type('text/foobar');
+
+ is_deeply( $request->accepted_content_types, [ 'text/foobar' ],
+ 'content-type set in request headers is found' );
+ is( $request->preferred_content_type, 'text/foobar',
+ 'preferred content type is text/foobar' );
+ ok( ! $request->accept_only, 'accept_only is false' );
+ ok( $request->accepts('text/foobar'), 'accepts text/foobar' );
+ ok( ! $request->accepts('text/html'), 'does not accept text/html' );
+ }
+
+ {
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( { 'content-type' => 'text/fudge' } );
+ $request->method('GET');
+ $request->content_type('text/foobar');
+
+ is_deeply( $request->accepted_content_types, [ 'text/foobar', 'text/fudge' ],
+ 'content-type set in request headers and type in parameters is found' );
+ is( $request->preferred_content_type, 'text/foobar',
+ 'preferred content type is text/foobar' );
+ ok( ! $request->accept_only, 'accept_only is false' );
+ ok( $request->accepts('text/foobar'), 'accepts text/foobar' );
+ ok( $request->accepts('text/fudge'), 'accepts text/fudge' );
+ ok( ! $request->accepts('text/html'), 'does not accept text/html' );
+ }
+
+ {
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( { 'content-type' => 'text/fudge' } );
+ $request->method('POST');
+ $request->content_type('text/foobar');
+
+ ok( ! $request->accepts('text/fudge'), 'content type in parameters is ignored for POST' );
+ }
+
+ {
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( {} );
+ $request->method('GET');
+ $request->headers->header(
+ 'Accept' =>
+ # From Firefox 2.0 when it requests an html page
+ 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
+ );
+
+ is_deeply( $request->accepted_content_types,
+ [ qw( text/xml application/xml application/xhtml+xml
+ image/png
+ text/html
+ text/plain
+ */*
+ ) ],
+ 'accept header is parsed properly' );
+ is( $request->preferred_content_type, 'text/xml',
+ 'preferred content type is text/xml' );
+ ok( $request->accept_only, 'accept_only is true' );
+ ok( $request->accepts('text/html'), 'accepts text/html' );
+ ok( $request->accepts('image/png'), 'accepts image/png' );
+ ok( ! $request->accepts('image/svg'), 'does not accept image/svg' );
+ }
+
+ {
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( {} );
+ $request->method('GET');
+ $request->content_type('application/json');
+ $request->headers->header(
+ 'Accept' =>
+ # From Firefox 2.0 when it requests an html page
+ 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
+ );
+
+ is_deeply( $request->accepted_content_types,
+ [ qw( application/json
+ text/xml application/xml application/xhtml+xml
+ image/png
+ text/html
+ text/plain
+ */*
+ ) ],
+ 'accept header is parsed properly, and content-type header has precedence over accept' );
+ ok( ! $request->accept_only, 'accept_only is false' );
+ }
+
+ {
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( {} );
+ $request->method('GET');
+ $request->content_type('application/json');
+ $request->headers->header(
+ 'Accept' =>
+ # From Firefox 2.0 when it requests an html page
+ 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
+ );
+
+ is_deeply( $request->accepted_content_types,
+ [ qw( application/json
+ text/xml application/xml application/xhtml+xml
+ image/png
+ text/html
+ text/plain
+ */*
+ ) ],
+ 'accept header is parsed properly, and content-type header has precedence over accept' );
+ ok( ! $request->accept_only, 'accept_only is false' );
+ }
+
+ {
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( {} );
+ $request->method('GET');
+ $request->content_type('text/x-json');
+ $request->headers->header(
+ 'Accept' => 'text/plain,text/x-json',
+ );
+
+ is_deeply( $request->accepted_content_types,
+ [ qw( text/x-json
+ text/plain
+ ) ],
+ 'each type appears only once' );
+ }
+
+ {
+ my $request = Catalyst::Request::REST->new;
+ $request->{_context} = 'MockContext';
+ $request->headers( HTTP::Headers->new );
+ $request->parameters( {} );
+ $request->method('GET');
+ $request->content_type('application/json');
+ $request->headers->header(
+ 'Accept' => 'text/plain,application/json',
+ );
+
+ is_deeply( $request->accepted_content_types,
+ [ qw( application/json
+ text/plain
+ ) ],
+ 'each type appears only once' );
+ }
+}
+
+{
+ local %ENV=%ENV;
+ $ENV{CATALYST_DEBUG} = 0;
+ my $test = 'Test::Catalyst::Action::REST';
+ use_ok $test;
+ is($test->request_class, 'Catalyst::Request::REST',
+ 'Request::REST took over for Request');
+
+ my $meta = Moose::Meta::Class->create_anon_class(
+ superclasses => ['Catalyst::Request'],
+ );
+ $meta->add_method('__random_method' => sub { 42 });
+
+ $test->request_class($meta->name);
+ # FIXME - setup_finished(0) is evil!
+ eval { $test->setup_finished(0); $test->setup };
+ ok !$@, 'Can setup again';
+ isnt $test->request_class, $meta->name, 'Different request class';
+ ok $test->request_class->can('__random_method'), 'Is right class';
+ ok $test->request_class->can('data'), 'Also smells like REST subclass';
+
+ {
+ package My::Request;
+ use base 'Catalyst::Request::REST';
+ }
+ $test->request_class('My::Request');
+ eval { $test->setup_finished(0); $test->setup };
+ is $@, '', 'no error from Request::REST subclass';
+}
+
+done_testing;
+
+package MockContext;
+
+sub prepare_body { }
projects / catagits/Catalyst-Action-REST.git / commitdiff