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.100';
  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 };
  39
  40 sub pragmatic_accept {
  41     my ($self, $c) = @_;
  42     my $accept = $c->request->header('Accept') or return;
  43     if ($accept =~ m|text/html|) {
  44         $accept =~ s!\*/\*\s*([,]+|$)!*/*;q=0.5$1!;
  45     }
  46     else {
  47         $accept =~ s!\*/\*\s*([,]+|$)!text/html,*/*;q=0.5$1!;
  48     }
  49     return $accept;
  50 }
  51
  52 1;
  53
  54 __END__
  55
  56 =head1 NAME
  57
  58 Catalyst::View::ContentNegotiation::XHTML - Adjusts the
  59 response Content-Type header to application/xhtml+xml
  60 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
  81 browsers to interpret the page as XML, meaning that your markup must
  82 be well formed.
  83
  84 =head1 CAVEATS
  85
  86 This is useful when you're developing your application, as you know that
  87 all pages you view are parsed as XML, so any errors caused by your markup
  88 not being well-formed will show up at once.
  89
  90 Whilst this module is has been tested against most popular browsers including
  91 Internet Explorer, it may cause unexpected results on browsers which do not
  92 properly support the C<application/xhtml+xml> MIME type.
  93
  94 =head1 METHOD MODIFIERS
  95
  96 =head2 after process
  97
  98 Changes the response C<Content-Type> if appropriate (from the requests 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
 105 Accept */* and this claiming to support XHTML just as well as HTML.
 106 Saving to a file on disk or opening with another application does
 107 count as accepting, but it really should have a lower q value then
 108 text/html. This sub takes a pragmatic approach and corrects this mistake
 109 by modifying the Accept header before 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 negotiation RFC.
 131
 132 =back
 133
 134 =head1 BUGS
 135
 136 Should be split into a base ContentNegotiation role which is consumed by ContentNegotiation::XHTML.
 137
 138 =head1 AUTHOR
 139
 140 Tomas Doran (t0m) C<< <bobtfish@bobtfish.net> >>
 141
 142 =head1 CONTRIBUTORS
 143
 144 =over
 145
 146 =item David Dorward - test patches and */* pragmatism.
 147
 148 =item Florian Ragwitz (rafl) C<< <rafl@debian.org> >> - Conversion into a Moose Role
 149
 150 =back
 151
 152 =head1 COPYRIGHT
 153
 154 This module itself is copyright (c) 2008 Tomas Doran and is licensed under the same terms as Perl itself.
 155
 156 =cut