--- /dev/null
+# auto-generated shipit config file.
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist
+
+svk.tagpattern = //mirror/Catalyst-View-TT-XHTML/1.000/tags/%v
+
+# svn.tagpattern = MyProj-%v
+# svn.tagpattern = http://code.example.com/svn/tags/MyProj-%v
+
+CheckChangeLog.files = Changes
--- /dev/null
+1.100
+ - Refactor into a Moose Role for use with alternate views. (rafl)
+ - Additional documentation (t0m)
+1.004
+ - Nick the OSX fragment out of the Catalyst::Runtime Makefile.PL to
+ beat my Mac into generating a correct dist. (t0m)
+1.003
+ - 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. (t0m)
+1.001 2008-12-12
+ - Add tests for other Accept header cases where the current code
+ will get it wrong. (David Dorward)
+ - Fix all of these tests. (t0m)
+1.000 2008-12-12
+ - First working version of the module extracted from the quick hack
+ I have in every Catalyst application I've ever written. (t0m)
--- /dev/null
+.git/
+blib
+pm_to_blib
+MANIFEST.bak
+MANIFEST.SKIP~
+cover_db
+Makefile$
+Makefile.old$
+.shipit
--- /dev/null
+use inc::Module::Install;
+
+name 'Catalyst-View-ContentNegotiation-XHTML';
+all_from 'lib/Catalyst/View/ContentNegotiation/XHTML.pm';
+
+requires 'Catalyst::Runtime';
+requires 'Catalyst::View::TT';
+requires 'HTTP::Negotiate';
+requires 'MRO::Compat';
+
+test_requires 'Catalyst::Action::RenderView';
+test_requires 'Test::WWW::Mechanize::Catalyst';
+test_requires 'Test::More';
+
+resources repository => 'http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-View-TT-XHTML';
+
+if (-e 'inc/.author') {
+ build_requires 'Test::Pod' => 1.14;
+ build_requires 'Test::Pod::Coverage' => 1.04;
+
+ if ($^O eq 'darwin') {
+ my $osx_ver = `/usr/bin/sw_vers -productVersion`;
+ chomp $osx_ver;
+
+ # TAR on 10.4 wants COPY_EXTENDED_ATTRIBUTES_DISABLE
+ # On 10.5 (Leopard) it wants COPYFILE_DISABLE
+ my $attr = $osx_ver eq '10.5' ? 'COPYFILE_DISABLE' : 'COPY_EXTENDED_ATTRIBUTES_DISABLE';
+
+ makemaker_args(dist => { PREOP => qq{\@if [ "\$\$$attr" != "true" ]; then}.
+ qq{ echo "You must set the ENV variable $attr to true,"; }.
+ ' echo "to avoid getting resource forks in your dist."; exit 255; fi' });
+ }
+}
+
+WriteAll();
--- /dev/null
+NAME
+ Catalyst::View::ContentNegotiation::XHTML - A Moose Role to apply to
+ Catalyst views adjusts the response Content-Type header to
+ application/xhtml+xml content if the browser accepts it.
+
+SYNOPSIS
+ package Catalyst::View::TT;
+
+ use Moose;
+ use namespace::clean -except => 'meta';
+
+ extends qw/Catalyst::View::TT/;
+ with qw/Catalyst::View::ContentNegotiation::XHTML/;
+
+ 1;
+
+DESCRIPTION
+ This is a very simple Role which uses a method modifier to run after the
+ "process" method, and sets the response "Content-Type" to be
+ "application/xhtml+xml" if the users browser sends an "Accept" header
+ indicating that it is willing to process that MIME type.
+
+ Changing the "Content-Type" causes browsers to interpret the page as
+ 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 parsed as XML, so any errors caused by your
+ markup not being well-formed will show up at once.
+
+METHOD MODIFIERS
+ after process
+ Changes the response "Content-Type" if appropriate (from the requests
+ "Accept" header).
+
+METHODS
+ 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.
+
+ATTRIBUTES
+ variants
+ Returns an array ref of 3 part arrays, comprising name, priority, output
+ mime-type, which is used for the content negotiation algorithm.
+
+PRIVATE METHODS
+ _build_variants
+ Returns the default variant attribute contents.
+
+SEE ALSO
+ Catalyst::View::TT::XHTML - Trivial Catalyst TT view using this role.
+ <http://www.w3.org/Protocols/rfc2616/rfc2616-sec12.html> - Content
+ negotiation RFC.
+
+BUGS
+ Will only work with Views which implement a process method.
+
+ Should be split into a base ContentNegotiation role which is consumed by
+ ContentNegotiation::XHTML.
+
+AUTHOR
+ Tomas Doran (t0m) "<bobtfish@bobtfish.net>"
+
+CONTRIBUTORS
+ David Dorward - test patches and */* pragmatism.
+ Florian Ragwitz (rafl) "<rafl@debian.org>" - Conversion into a Moose
+ Role
+
+COPYRIGHT
+ This module itself is copyright (c) 2008 Tomas Doran and is licensed
+ under the same terms as Perl itself.
+
--- /dev/null
+package Catalyst::View::ContentNegotiation::XHTML;
+
+use Moose::Role;
+use MooseX::Types::Moose qw/Num Str ArrayRef/;
+use MooseX::Types::Structured qw/Tuple/;
+use HTTP::Negotiate qw/choose/;
+
+use namespace::clean -except => 'meta';
+
+# Remember to bump $VERSION in View::TT::XHTML also.
+our $VERSION = '1.100';
+
+requires 'process';
+
+has variants => (
+ is => 'ro',
+ isa => ArrayRef[Tuple[Str, Num, Str]],
+ lazy => 1,
+ builder => '_build_variants',
+);
+
+sub _build_variants {
+ return [
+ [qw| xhtml 1.000 application/xhtml+xml |],
+ [qw| html 0.900 text/html |],
+ ];
+}
+
+after process => sub {
+ my ($self, $c) = @_;
+ if ($c->request->header('Accept') && $c->response->headers->{'content-type'} =~ m|text/html|) {
+ $self->pragmatic_accept($c);
+ my $var = choose($self->variants, $c->request->headers);
+ if ($var eq 'xhtml') {
+ $c->response->headers->{'content-type'} =~ s|text/html|application/xhtml+xml|;
+ }
+ }
+};
+
+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__
+
+=head1 NAME
+
+Catalyst::View::ContentNegotiation::XHTML - A Moose Role to apply to
+Catalyst views adjusts the response Content-Type header to
+application/xhtml+xml content if the browser accepts it.
+
+=head1 SYNOPSIS
+
+ package Catalyst::View::TT;
+
+ use Moose;
+ use namespace::clean -except => 'meta';
+
+ extends qw/Catalyst::View::TT/;
+ with qw/Catalyst::View::ContentNegotiation::XHTML/;
+
+ 1;
+
+=head1 DESCRIPTION
+
+This is a very simple Role which uses a method modifier to run after the
+C<process> method, and sets the response C<Content-Type> to be
+C<application/xhtml+xml> if the users browser sends an C<Accept> header
+indicating that it is willing to process that MIME type.
+
+Changing the C<Content-Type> causes browsers to interpret the page as
+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 parsed as XML, so any errors caused by your markup
+not being well-formed will show up at once.
+
+=head1 METHOD MODIFIERS
+
+=head2 after process
+
+Changes the response C<Content-Type> if appropriate (from the requests C<Accept> header).
+
+=head1 METHODS
+
+=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 ATTRIBUTES
+
+=head2 variants
+
+Returns an array ref of 3 part arrays, comprising name, priority, output
+mime-type, which is used for the content negotiation algorithm.
+
+=head1 PRIVATE METHODS
+
+=head2 _build_variants
+
+Returns the default variant attribute contents.
+
+=head1 SEE ALSO
+
+=over
+
+=item L<Catalyst::View::TT::XHTML> - Trivial Catalyst TT view using this role.
+
+=item L<http://www.w3.org/Protocols/rfc2616/rfc2616-sec12.html> - Content negotiation RFC.
+
+=back
+
+=head1 BUGS
+
+Should be split into a base ContentNegotiation role which is consumed by ContentNegotiation::XHTML.
+
+=head1 AUTHOR
+
+Tomas Doran (t0m) C<< <bobtfish@bobtfish.net> >>
+
+=head1 CONTRIBUTORS
+
+=over
+
+=item David Dorward - test patches and */* pragmatism.
+
+=item Florian Ragwitz (rafl) C<< <rafl@debian.org> >> - Conversion into a Moose Role
+
+=back
+
+=head1 COPYRIGHT
+
+This module itself is copyright (c) 2008 Tomas Doran and is licensed under the same terms as Perl itself.
+
+=cut
--- /dev/null
+package Catalyst::View::TT::XHTML;
+
+use Moose;
+use namespace::clean -except => 'meta';
+
+extends qw/Catalyst::View::TT/;
+with qw/Catalyst::View::ContentNegotiation::XHTML/;
+
+our $VERSION = '1.100';
+
+1;
+
+__END__
+
+=head1 NAME
+
+Catalyst::View::TT::XHTML - A sub-class of the standard TT view which
+serves application/xhtml+xml content if the browser accepts it.
+
+=head1 SYNOPSIS
+
+ package MyApp::View::XHTML;
+ use strict;
+ use warnings;
+ use base qw/Catalyst::View::TT::XHTML/;
+
+ 1;
+
+=head1 DESCRIPTION
+
+This is a very simple sub-class of L<Catalyst::View::TT>, which sets
+the response C<Content-Type> to be C<application/xhtml+xml> if the
+user's browser sends an C<Accept> header indicating that it is willing
+to process that MIME type.
+
+Changing the C<Content-Type> causes browsers to interpret the page as
+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 parsed as XML, so any errors caused by your markup
+not being well-formed will show up at once.
+
+=head1 NOTE
+
+This module is a very simple demonstration of a consumer of the
+L<Catalyst::View::ContentNegotiation::XHTML> role.
+
+If your needs are not trivial, then it is recommended that you consume
+that role yourself.
+
+=head1 AUTHOR
+
+Tomas Doran (t0m) C<< <bobtfish@bobtfish.net> >>
+
+=head1 COPYRIGHT
+
+This module itself is copyright (c) 2008 Tomas Doran and is licensed under the same terms as Perl itself.
+
+=cut
--- /dev/null
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+use_ok 'Catalyst::View::TT::XHTML';
--- /dev/null
+package TestApp;
+use strict;
+use warnings;
+
+use Catalyst;
+
+__PACKAGE__->setup;
+
+1;
--- /dev/null
+package TestApp::Controller::Root;
+use strict;
+use warnings;
+
+__PACKAGE__->config(namespace => q{});
+
+use base 'Catalyst::Controller';
+
+sub main :Path { }
+
+sub nothtml :Local {
+ my ($self, $c) = @_;
+ $c->res->content_type('application/json');
+}
+
+sub end : ActionClass('RenderView') {}
+
+1;
--- /dev/null
+package TestApp::View::XHTML;
+use strict;
+use warnings;
+use base qw/Catalyst::View::TT::XHTML/;
+
+1;
--- /dev/null
+it works
\ No newline at end of file
--- /dev/null
+not html
\ No newline at end of file
--- /dev/null
+#!/usr/bin/env perl
+
+BEGIN {
+ $ENV{CATALYST_ENGINE} ||= 'HTTP';
+ $ENV{CATALYST_SCRIPT_GEN} = 31;
+ require Catalyst::Engine::HTTP;
+}
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use FindBin;
+use lib "$FindBin::Bin/..";
+
+my $debug = 0;
+my $fork = 0;
+my $help = 0;
+my $host = undef;
+my $port = 3000;
+my $keepalive = 0;
+my $restart = 0;
+my $restart_delay = 1;
+my $restart_regex = '\.yml$|\.yaml$|\.pm$';
+my $restart_directory = undef;
+my $background = 0;
+my $pidfile = "/tmp/testapp.pid";
+
+my @argv = @ARGV;
+
+GetOptions(
+ 'debug|d' => \$debug,
+ 'fork' => \$fork,
+ 'help|?' => \$help,
+ 'host=s' => \$host,
+ 'port=s' => \$port,
+ 'keepalive|k' => \$keepalive,
+ 'restart|r' => \$restart,
+ 'restartdelay|rd=s' => \$restart_delay,
+ 'restartregex|rr=s' => \$restart_regex,
+ 'restartdirectory=s' => \$restart_directory,
+ 'daemon' => \$background,
+ 'pidfile=s' => \$pidfile,
+);
+
+pod2usage(1) if $help;
+
+if ( $restart ) {
+ $ENV{CATALYST_ENGINE} = 'HTTP::Restarter';
+}
+if ( $debug ) {
+ $ENV{CATALYST_DEBUG} = 1;
+}
+
+# This is require instead of use so that the above environment
+# variables can be set at runtime.
+require TestApp;
+
+TestApp->run( $port, $host, {
+ argv => \@argv,
+ 'fork' => $fork,
+ keepalive => $keepalive,
+ restart => $restart,
+ restart_delay => $restart_delay,
+ restart_regex => qr/$restart_regex/,
+ restart_directory => $restart_directory,
+ background => $background,
+ pidfile => $pidfile,
+} );
+
+1;
+
+=head1 NAME
+
+testapp_server.pl - Catalyst Testserver
+
+=head1 SYNOPSIS
+
+testapp_server.pl [options]
+
+ Options:
+ -d -debug force debug mode
+ -f -fork handle each request in a new process
+ (defaults to false)
+ -? -help display this help and exits
+ -host host (defaults to all)
+ -p -port port (defaults to 3000)
+ -k -keepalive enable keep-alive connections
+ -r -restart restart when files get modified
+ (defaults to false)
+ -rd -restartdelay delay between file checks
+ -rr -restartregex regex match files that trigger
+ a restart when modified
+ (defaults to '\.yml$|\.yaml$|\.pm$')
+ -restartdirectory the directory to search for
+ modified files
+ (defaults to '../')
+
+ -daemon background the server
+ -pidfile=filename store the pid if the server in filename, if
+ daemonizing
+
+ See also:
+ perldoc Catalyst::Manual
+ perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Run a Catalyst Testserver for this application.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@oook.de>
+Maintained by the Catalyst Core Team.
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
--- /dev/null
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/..";
+use Catalyst::Test 'TestApp';
+
+print request($ARGV[0])->content . "\n";
+
+1;
--- /dev/null
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More tests => 28;
+
+# setup library path
+use FindBin qw($Bin);
+use lib "$Bin/lib";
+
+# 1 make sure testapp works
+use_ok 'TestApp';
+
+# a live test against TestApp, the test application
+use Test::WWW::Mechanize::Catalyst 'TestApp';
+my $mech = Test::WWW::Mechanize::Catalyst->new;
+
+# 2-4
+$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',
+ 'No Accept header = text/html';
+
+$mech->add_header( Accept => 'text/html' );
+
+# 5-7
+$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 header of text/html = text/html';
+
+$mech->add_header( Accept => 'application/xhtml+xml' );
+
+# 8-10
+$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 xhtml gives content type application/xhtml+xml';
+
+# 11-13
+$mech->get_ok('http://localhost/nothtml', 'get nothtml page');
+$mech->content_like(qr/not html/i, 'see if it has our text');
+is $mech->response->headers->{'content-type'}, 'application/json',
+ 'application/json is unmolested';
+
+# 14-16
+$mech->add_header( Accept => 'text/html, 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 xhtml AND html gives content type application/xhtml+xml';
+
+
+# 17-19
+$mech->add_header( Accept => 'text/html, application/xhtml+xml;q=0');
+$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 header of application/xhtml+xml with q value of 0 and text/html = text/html';
+
+# 20-22
+$mech->add_header( Accept => 'text/html;q=0, 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 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
--- /dev/null
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
--- /dev/null
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
--- /dev/null
+#!perl -w
+use strict;
+use warnings;
+use Test::More;
+
+eval 'use Test::Spelling 0.11';
+plan skip_all => 'Test::Spelling 0.11 not installed' if $@;
+plan skip_all => 'set TEST_SPELLING to enable this test' unless $ENV{TEST_SPELLING};
+
+set_spell_cmd('aspell list');
+
+add_stopwords( grep { defined $_ && length $_ } <DATA>);
+
+all_pod_files_spelling_ok();
+
+__DATA__
+XHTML
+TT
+Doran
+Dorward
+rafl
+ContentNegotiation
+Ragwitz
projects / catagits/Catalyst-View-ContentNegotiation-XHTML.git / commitdiff