Integrate REST::ForBrowsers. Update docs to point at traits. Update t…

…ests to test trait and class both.

lib/Catalyst/Action/REST.pm

@@ -67,8 +67,8 @@ It is likely that you really want to look at L<Catalyst::Controller::REST>,
 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
 
@@ -156,8 +156,13 @@ sub _return_not_implemented {
 
 =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>
 

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<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.

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<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

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;

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<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