[Catalyst-commits] r8873 - in Catalyst-View-TT-XHTML/1.000/trunk: . lib/Catalyst/View/TT t

[t0m at dev.catalyst.perl.org]

Author: t0m
Date: 2008-12-14 10:54:20 +0000 (Sun, 14 Dec 2008)
New Revision: 8873

Modified:
   Catalyst-View-TT-XHTML/1.000/trunk/Changes
   Catalyst-View-TT-XHTML/1.000/trunk/lib/Catalyst/View/TT/XHTML.pm
   Catalyst-View-TT-XHTML/1.000/trunk/t/live-test.t
Log:
Checking in changes prior to tagging of version 1.003.  Changelog diff is:

=== Changes
==================================================================
--- Changes	(revision 9990)
+++ Changes	(local)
@@ -1,5 +1,6 @@
 1.003
-  - Change to MRO::Compat for perl 5.10.
+  - Fixes an tests to be fully Internet Explorer compatible (David Dorward)
+  - Change to MRO::Compat for perl 5.10 (t0m)
 1.002 2008-12-13
   - Add 'use Class::C3' so that the module works on the currently 
     released Catalyst version.


Modified: Catalyst-View-TT-XHTML/1.000/trunk/Changes
===================================================================
--- Catalyst-View-TT-XHTML/1.000/trunk/Changes	2008-12-14 09:04:57 UTC (rev 8872)
+++ Catalyst-View-TT-XHTML/1.000/trunk/Changes	2008-12-14 10:54:20 UTC (rev 8873)
@@ -1,5 +1,6 @@
 1.003
-  - Change to MRO::Compat for perl 5.10.
+  - Fixes an tests to be fully Internet Explorer compatible (David Dorward)
+  - Change to MRO::Compat for perl 5.10 (t0m)
 1.002 2008-12-13
   - Add 'use Class::C3' so that the module works on the currently 
     released Catalyst version.

Modified: Catalyst-View-TT-XHTML/1.000/trunk/lib/Catalyst/View/TT/XHTML.pm
===================================================================
--- Catalyst-View-TT-XHTML/1.000/trunk/lib/Catalyst/View/TT/XHTML.pm	2008-12-14 09:04:57 UTC (rev 8872)
+++ Catalyst-View-TT-XHTML/1.000/trunk/lib/Catalyst/View/TT/XHTML.pm	2008-12-14 10:54:20 UTC (rev 8873)
@@ -9,15 +9,15 @@
 
 our $variants = [
     [qw| xhtml 1.000 application/xhtml+xml |],
-    [qw| html  0.001 text/html             |],
+    [qw| html  0.900 text/html             |],
 ];
 
 sub process {
     my $self = shift;
     my ($c) = @_;
     my $return = $self->next::method(@_);
-   
     if ($c->request->header('Accept') && $c->response->headers->{'content-type'} =~ m|text/html|) {
+        $self->pragmatic_accept($c);
         my $var = choose($variants, $c->request->headers);
         if ($var eq 'xhtml') {
             $c->response->headers->{'content-type'} =~ s|text/html|application/xhtml+xml|;
@@ -26,6 +26,17 @@
     return $return;
 }
 
+sub pragmatic_accept {
+    my ($self, $c) = @_;
+    my $accept = $c->request->header('Accept');
+    if ($accept =~ m|text/html|) {
+        $accept =~ s!\*/\*\s*([,]+|$)!*/*;q=0.5$1!;
+    } else {
+        $accept =~ s!\*/\*\s*([,]+|$)!text/html,*/*;q=0.5$1!;
+    }
+    $c->request->header('Accept' => $accept);
+}
+
 1;
 
 __END__
@@ -41,9 +52,9 @@
     use strict;
     use warnings;
     use base qw/Catalyst::View::TT::XHTML MyApp::View::TT/;
-    
+
     1;
-    
+
 =head1 DESCRIPTION
 
 This is a very simple sub-class of L<Catalyst::View::TT>, which sets
@@ -52,11 +63,11 @@
 to process that MIME type.
 
 Changing the C<Content-Type> causes browsers to interpret the page as
-strict XHTML, meaning that the markup must be well formed.
+XML, meaning that the markup must be well formed.
 
 This is useful when you're developing your application, as you know that
-all pages you view are rendered strictly, so any markup errors will show
-up at once.
+all pages you view are parsed as XML, so any errors caused by your markup
+not being well-formed will show up at once.
 
 =head1 METHODS
 
@@ -66,6 +77,15 @@
 to render the template, and then changing the response C<Content-Type> if
 appropriate (from the requests C<Accept> header).
 
+=head2 pragmatic_accept
+
+Some browsers (such as Internet Explorer) have a nasty way of sending
+Accept */* and this claiming to support XHTML just as well as HTML.
+Saving to a file on disk or opening with another application does
+count as accepting, but it really should have a lower q value then
+text/html. This sub takes a pragmatic approach and corrects this mistake
+by modifying the Accept header before passing it to content negotiation.
+
 =head1 BUGS
 
 There should be a more elegant way to inherit the config of your normal 
@@ -85,7 +105,7 @@
 
 =over
 
-=item David Dorward - test patches
+=item David Dorward - test patches and */* pragmatism. 
 
 =back
 

Modified: Catalyst-View-TT-XHTML/1.000/trunk/t/live-test.t
===================================================================
--- Catalyst-View-TT-XHTML/1.000/trunk/t/live-test.t	2008-12-14 09:04:57 UTC (rev 8872)
+++ Catalyst-View-TT-XHTML/1.000/trunk/t/live-test.t	2008-12-14 10:54:20 UTC (rev 8873)
@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-use Test::More tests => 22;
+use Test::More tests => 28;
 
 # setup library path
 use FindBin qw($Bin);
@@ -20,7 +20,7 @@
 $mech->content_like(qr/it works/i, 'see if it has our text');
 is $mech->response->headers->{'content-type'}, 'text/html; charset=utf-8',
   'No Accept header = text/html';
-  
+
 $mech->add_header( Accept => 'text/html' );
 
 # 5-7
@@ -65,4 +65,17 @@
 is $mech->response->headers->{'content-type'}, 'application/xhtml+xml; charset=utf-8',
   'Accept html with a q value of 0 gives content type application/xhtml+xml';
 
+# 23-25
+$mech->add_header( Accept => '*/*');
+$mech->get_ok('http://localhost/', 'get main page');
+$mech->content_like(qr/it works/i, 'see if it has our text');
+is $mech->response->headers->{'content-type'}, 'text/html; charset=utf-8',
+  'Accept */* content type text/html';
 
+# 26-28
+$mech->add_header( Accept => '*/*, application/xhtml+xml');
+$mech->get_ok('http://localhost/', 'get main page');
+$mech->content_like(qr/it works/i, 'see if it has our text');
+is $mech->response->headers->{'content-type'}, 'application/xhtml+xml; charset=utf-8',
+  'Accept */* and application/xhtml+xml gives content type application/xhtml+xml';
+ 
\ No newline at end of file