[Catalyst-commits] r7599 - in trunk/Catalyst-Action-REST: . lib/Catalyst/Request t

[jrockway at dev.catalyst.perl.org]

Author: jrockway
Date: 2008-04-08 20:40:21 +0100 (Tue, 08 Apr 2008)
New Revision: 7599

Added:
   trunk/Catalyst-Action-REST/t/catalyst-request-rest-bad-accept.t
Modified:
   trunk/Catalyst-Action-REST/Makefile.PL
   trunk/Catalyst-Action-REST/lib/Catalyst/Request/REST.pm
Log:
Apparently a number of web client authors are unable to construct a proper
Accept header, especially mobile client authors. The usual effect seems to be
that something non-numeric ends up as the qvalue for a given content type,
something like "handheld" or "0-8-8".

The attached patch shuts up warnings that occur because of this.

Author: Dave Rolsky <autarch at urth.org>


Modified: trunk/Catalyst-Action-REST/Makefile.PL
===================================================================
--- trunk/Catalyst-Action-REST/Makefile.PL	2008-04-07 19:53:39 UTC (rev 7598)
+++ trunk/Catalyst-Action-REST/Makefile.PL	2008-04-08 19:40:21 UTC (rev 7599)
@@ -14,6 +14,7 @@
 requires('Class::Inspector'          => '1.13');
 requires('URI::Find'                 => undef);
 requires('Data::Dump'                => undef);
+requires('Scalar::Util'              => undef);
 
 feature 'Data::Denter (text/x-data-denter) support',
     -default => 0,

Modified: trunk/Catalyst-Action-REST/lib/Catalyst/Request/REST.pm
===================================================================
--- trunk/Catalyst-Action-REST/lib/Catalyst/Request/REST.pm	2008-04-07 19:53:39 UTC (rev 7598)
+++ trunk/Catalyst-Action-REST/lib/Catalyst/Request/REST.pm	2008-04-08 19:40:21 UTC (rev 7599)
@@ -12,6 +12,7 @@
 
 use base 'Catalyst::Request';
 use HTTP::Headers::Util qw(split_header_words);
+use Scalar::Util qw( looks_like_number );
 
 
 =head1 NAME
@@ -105,7 +106,7 @@
             my ( $type, $qvalue ) = @{$pair}[ 0, 3 ];
             next if $types{$type};
 
-            unless ( defined $qvalue ) {
+            unless ( defined $qvalue && looks_like_number($qvalue) ) {
                 $qvalue = 1 - ( ++$counter / 1000 );
             }
 

Added: trunk/Catalyst-Action-REST/t/catalyst-request-rest-bad-accept.t
===================================================================
--- trunk/Catalyst-Action-REST/t/catalyst-request-rest-bad-accept.t	                        (rev 0)
+++ trunk/Catalyst-Action-REST/t/catalyst-request-rest-bad-accept.t	2008-04-08 19:40:21 UTC (rev 7599)
@@ -0,0 +1,58 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+    unless ( eval "use Test::Warn; 1" ) {
+        plan skip_all => 'These tests require Test::Warn';
+    }
+}
+
+plan tests => 4;
+
+use FindBin;
+use lib ( "$FindBin::Bin/../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->headers->header(
+        'Accept' =>
+        'text/html,text/xml; q=handheld',
+    );
+
+    warning_is {
+        is_deeply( $request->accepted_content_types, [ 'text/html', 'text/xml' ],
+                   'bad qvalue does not cause misparsing of Accept header' );
+    } '',
+    'no warnings from non-numeric qvalue';
+}
+
+{
+    my $request = Catalyst::Request::REST->new;
+    $request->{_context} = 'MockContext';
+    $request->headers( HTTP::Headers->new );
+    $request->parameters( {} );
+    $request->method('GET');
+    $request->headers->header(
+        'Accept' =>
+        'text/xml;q=0-8-8,*/*;q=0.5',
+    );
+
+    warning_is {
+        is_deeply( $request->accepted_content_types, [ 'text/xml', '*/*' ],
+                   'bad qvalue does not cause misparsing of Accept header' );
+    } '',
+    'no warnings from non-numeric qvalue';
+}
+
+package MockContext;
+
+sub prepare_body { }