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 - A Moose Role to apply to
  59 Catalyst views adjusts the response Content-Type header to
  60 application/xhtml+xml content 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 very simple Role which uses a method modifier to run after the
  77 C<process> method, and sets the response C<Content-Type> to be
  78 C<application/xhtml+xml> if the users browser sends an C<Accept> header
  79 indicating that it is willing to process that MIME type.
  80
  81 Changing the C<Content-Type> causes browsers to interpret the page as
  82 XML, meaning that the markup must be well formed.
  83
  84 This is useful when you're developing your application, as you know that
  85 all pages you view are parsed as XML, so any errors caused by your markup
  86 not being well-formed will show up at once.
  87
  88 =head1 METHOD MODIFIERS
  89
  90 =head2 after process
  91
  92 Changes the response C<Content-Type> if appropriate (from the requests C<Accept> header).
  93
  94 =head1 METHODS
  95
  96 =head2 pragmatic_accept
  97
  98 Some browsers (such as Internet Explorer) have a nasty way of sending
  99 Accept */* and this claiming to support XHTML just as well as HTML.
 100 Saving to a file on disk or opening with another application does
 101 count as accepting, but it really should have a lower q value then
 102 text/html. This sub takes a pragmatic approach and corrects this mistake
 103 by modifying the Accept header before passing it to content negotiation.
 104
 105 =head1 ATTRIBUTES
 106
 107 =head2 variants
 108
 109 Returns an array ref of 3 part arrays, comprising name, priority, output
 110 mime-type, which is used for the content negotiation algorithm.
 111
 112 =head1 PRIVATE METHODS
 113
 114 =head2 _build_variants
 115
 116 Returns the default variant attribute contents.
 117
 118 =head1 SEE ALSO
 119
 120 =over
 121
 122 =item L<Catalyst::View::TT::XHTML> - Trivial Catalyst TT view using this role.
 123
 124 =item L<http://www.w3.org/Protocols/rfc2616/rfc2616-sec12.html> - Content negotiation RFC.
 125
 126 =back
 127
 128 =head1 BUGS
 129
 130 Should be split into a base ContentNegotiation role which is consumed by ContentNegotiation::XHTML.
 131
 132 =head1 AUTHOR
 133
 134 Tomas Doran (t0m) C<< <bobtfish@bobtfish.net> >>
 135
 136 =head1 CONTRIBUTORS
 137
 138 =over
 139
 140 =item David Dorward - test patches and */* pragmatism.
 141
 142 =item Florian Ragwitz (rafl) C<< <rafl@debian.org> >> - Conversion into a Moose Role
 143
 144 =back
 145
 146 =head1 COPYRIGHT
 147
 148 This module itself is copyright (c) 2008 Tomas Doran and is licensed under the same terms as Perl itself.
 149
 150 =cut