lib/Catalyst/View/ContentNegotiation/XHTML.pm

   1 package Catalyst::View::ContentNegotiation::XHTML;
   2
   3 use Moose::Role;
   4 use MooseX::Types::Moose qw/Num Str ArrayRef/;
   5 use MooseX::Types::Structured qw/Tuple/;
   6 use HTTP::Negotiate qw/choose/;
   7
   8 use namespace::clean -except => 'meta';
   9
  10 # Remember to bump $VERSION in View::TT::XHTML also.
  11 our $VERSION = '1.102';
  12
  13 requires 'process';
  14
  15 has variants => (
  16     is      => 'ro',
  17     isa     => ArrayRef[Tuple[Str, Num, Str]],
  18     lazy    => 1,
  19     builder => '_build_variants',
  20 );
  21
  22 sub _build_variants {
  23     return [
  24         [qw| xhtml 1.000 application/xhtml+xml |],
  25         [qw| html  0.900 text/html             |],
  26     ];
  27 }
  28
  29 after process => sub {
  30     my ($self, $c) = @_;
  31     if ( my $accept = $self->pragmatic_accept($c) and $c->response->headers->{'content-type'} =~ m|text/html|) {
  32         my $headers = $c->request->headers->clone;
  33         $headers->header('Accept' => $accept);
  34         if ( choose($self->variants, $headers) eq 'xhtml') {
  35             $c->response->headers->{'content-type'} =~ s|text/html|application/xhtml+xml|;
  36         }
  37     }
  38     $c->response->headers->push_header(Vary => 'Accept');
  39 };
  40
  41 sub pragmatic_accept {
  42     my ($self, $c) = @_;
  43     my $accept = $c->request->header('Accept') or return;
  44     if ($accept =~ m|text/html|) {
  45         $accept =~ s!\*/\*\s*([,]+|$)!*/*;q=0.5$1!;
  46     }
  47     else {
  48         $accept =~ s!\*/\*\s*([,]+|$)!text/html,*/*;q=0.5$1!;
  49     }
  50     return $accept;
  51 }
  52
  53 1;
  54
  55 __END__
  56
  57 =head1 NAME
  58
  59 Catalyst::View::ContentNegotiation::XHTML - Adjusts the response Content-Type
  60 header to application/xhtml+xml if the browser accepts it.
  61
  62 =head1 SYNOPSIS
  63
  64     package Catalyst::View::TT;
  65
  66     use Moose;
  67     use namespace::clean -except => 'meta';
  68
  69     extends qw/Catalyst::View::TT/;
  70     with qw/Catalyst::View::ContentNegotiation::XHTML/;
  71
  72     1;
  73
  74 =head1 DESCRIPTION
  75
  76 This is a simple Role which sets the response C<Content-Type> to be
  77 C<application/xhtml+xml> if the users browser sends an C<Accept> header
  78 indicating that it is willing to process that MIME type.
  79
  80 Changing the C<Content-Type> to C<application/xhtml+xml> causes browsers to
  81 interpret the page as XML, meaning that your markup must be well formed.
  82
  83 =head1 CAVEATS
  84
  85 This is useful when you're developing your application, as you know that all
  86 pages you view are parsed as XML, so any errors caused by your markup not
  87 being well-formed will show up at once.
  88
  89 Whilst this module is has been tested against most popular browsers including
  90 Internet Explorer, it may cause unexpected results on browsers which do not
  91 properly support the C<application/xhtml+xml> MIME type.
  92
  93 =head1 METHOD MODIFIERS
  94
  95 =head2 after process
  96
  97 Changes the response C<Content-Type> if appropriate (from the requests
  98 C<Accept> header).
  99
 100 =head1 METHODS
 101
 102 =head2 pragmatic_accept
 103
 104 Some browsers (such as Internet Explorer) have a nasty way of sending Accept
 105 */* and this claiming to support XHTML just as well as HTML. Saving to a file
 106 on disk or opening with another application does count as accepting, but it
 107 really should have a lower q value then text/html. This sub takes a pragmatic
 108 approach and corrects this mistake by modifying the Accept header before
 109 passing it to content negotiation.
 110
 111 =head1 ATTRIBUTES
 112
 113 =head2 variants
 114
 115 Returns an array ref of 3 part arrays, comprising name, priority, output
 116 mime-type, which is used for the content negotiation algorithm.
 117
 118 =head1 PRIVATE METHODS
 119
 120 =head2 _build_variants
 121
 122 Returns the default variant attribute contents.
 123
 124 =head1 SEE ALSO
 125
 126 =over
 127
 128 =item L<Catalyst::View::TT::XHTML> - Trivial Catalyst TT view using this role.
 129
 130 =item L<http://www.w3.org/Protocols/rfc2616/rfc2616-sec12.html> - Content
 131 negotiation RFC.
 132
 133 =back
 134
 135 =head1 BUGS
 136
 137 Should be split into a base ContentNegotiation role which is consumed by
 138 ContentNegotiation::XHTML.
 139
 140 =head1 AUTHOR
 141
 142 =over
 143
 144 =item Maintainer and contributor of various features - David Dorward (dorward) C<< <david@dorward.me.uk> >>
 145
 146 =item Original author and maintainer - Tomas Doran (t0m) C<< <bobtfish@bobtfish.net> >>
 147
 148 =back
 149
 150 =head1 CONTRIBUTORS
 151
 152 =over
 153
 154 =item Florian Ragwitz (rafl) C<< <rafl@debian.org> >> - Conversion into a
 155 Moose Role, which is what the module should have been originally.
 156
 157 =back
 158
 159 =head1 COPYRIGHT
 160
 161 This module itself is copyright (c) 2008 Tomas Doran and is licensed under the
 162 same terms as Perl itself.
 163
 164 =cut