From: Dave Rolsky Date: Sun, 17 Jan 2010 22:08:26 +0000 (-0600) Subject: Integrate REST::ForBrowsers. Update docs to point at traits. Update tests to test... X-Git-Tag: 0.82~22 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Action-REST.git;a=commitdiff_plain;h=85aa4e18592a1c81b7c2cdd0217b05da74dbea21 Integrate REST::ForBrowsers. Update docs to point at traits. Update tests to test trait and class both. --- diff --git a/lib/Catalyst/Action/REST.pm b/lib/Catalyst/Action/REST.pm index 536a94a..d9bb35d 100644 --- a/lib/Catalyst/Action/REST.pm +++ b/lib/Catalyst/Action/REST.pm @@ -67,8 +67,8 @@ It is likely that you really want to look at L, 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. +When you use this module, it adds the L +role to your request class. =head1 METHODS @@ -156,8 +156,13 @@ sub _return_not_implemented { =head1 SEE ALSO -You likely want to look at L, which implements -a sensible set of defaults for a controller doing REST. +You likely want to look at L, which implements a +sensible set of defaults for a controller doing REST. + +This class automatically adds the L 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 instead. L, L diff --git a/lib/Catalyst/Request/REST.pm b/lib/Catalyst/Request/REST.pm index a646e7c..275be01 100644 --- a/lib/Catalyst/Request/REST.pm +++ b/lib/Catalyst/Request/REST.pm @@ -53,11 +53,12 @@ Catalyst::Request::REST - A REST-y subclass of Catalyst::Request =head1 DESCRIPTION This is a subclass of C that applies the -L which adds a few methods to -the request object to faciliate writing REST-y code. +L 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 directly. L and L will arrange for the request trait to be applied if needed. diff --git a/lib/Catalyst/Request/REST/ForBrowsers.pm b/lib/Catalyst/Request/REST/ForBrowsers.pm new file mode 100644 index 0000000..36c671e --- /dev/null +++ b/lib/Catalyst/Request/REST/ForBrowsers.pm @@ -0,0 +1,57 @@ +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. Please see that class for +details on methods and attributes. + +=head1 AUTHOR + +Dave Rolsky, C<< >> + +=head1 BUGS + +Please report any bugs or feature requests to +C, or through the +web interface at L. 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 diff --git a/lib/Catalyst/TraitFor/Request/REST.pm b/lib/Catalyst/TraitFor/Request/REST.pm index 36be057..e210226 100644 --- a/lib/Catalyst/TraitFor/Request/REST.pm +++ b/lib/Catalyst/TraitFor/Request/REST.pm @@ -5,11 +5,25 @@ use namespace::autoclean; 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. @@ -49,11 +63,10 @@ sub accepted_content_types { } } - 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; diff --git a/lib/Catalyst/TraitFor/Request/REST/ForBrowsers.pm b/lib/Catalyst/TraitFor/Request/REST/ForBrowsers.pm new file mode 100644 index 0000000..ef98c19 --- /dev/null +++ b/lib/Catalyst/TraitFor/Request/REST/ForBrowsers.pm @@ -0,0 +1,197 @@ +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 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 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 an HTML type, it is I 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 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<< >> + +=head1 BUGS + +Please report any bugs or feature requests to +C, or through the web interface at +L. 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 diff --git a/t/catalyst-request-rest.t b/t/catalyst-request-rest.t deleted file mode 100644 index ebb7b7d..0000000 --- a/t/catalyst-request-rest.t +++ /dev/null @@ -1,204 +0,0 @@ -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 { } diff --git a/t/catalyst-traitfor-request-rest-forbrowsers.t b/t/catalyst-traitfor-request-rest-forbrowsers.t new file mode 100644 index 0000000..e6ba204 --- /dev/null +++ b/t/catalyst-traitfor-request-rest-forbrowsers.t @@ -0,0 +1,200 @@ +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 { } diff --git a/t/catalyst-traitfor-request-rest.t b/t/catalyst-traitfor-request-rest.t new file mode 100644 index 0000000..99f4ffb --- /dev/null +++ b/t/catalyst-traitfor-request-rest.t @@ -0,0 +1,214 @@ +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 { }