# This file documents the revision history for Perl extension Catalyst.
+5.90021 - TBA
+ - documentation updates around forwarding to chained actions
+ - Fixed bug when a PSGI engine need to use psgix logger
+ - Added cpanfile as a way to notice we are a dev checkout
+ - Added 'x-tunneled-method' HTTP Header method override to match features in
+ Catalyst::Action::REST and in other similar systems on CPAN
+
+5.90020 - 2013-02-22
+ ! Catalyst::Action now defines 'match_captures' so it is no long considered
+ an optional method. This might break you code if you have made custom
+ action roles/classes where you define 'match_captures'. You must change
+ your code to use a method modifier (such as 'around').
+ - New match method "Method($HTTP_METHOD)" where $HTTP_METHOD in (GET, POST,
+ PUT, HEAD, DELETE, OPTION) and shortcuts in controllers called "GET, POST
+ PUT, HEAD, DELETE, OPTION"). Tests and documentation. Please note if you
+ are currently using Catalyst::ActionRole::MatchRequestMethods there may
+ be compatibility issues. You should remove that actionrole since the built
+ in behavior is compatible on its own.
+ - Initial debug screen now shows HTTP Method Match info
+ - security fixes in the way we handle redirects
+ - Make Catalyst::Engine and Catalyst::Base immutable
+ - Some test and documentation improvements
+
+5.90019 - 2012-12-04 21:31:00
+ - Fix for perl 5.17.6 (commit g7dc8663). RT#81601
+ - Fix for perl 5.8. RT#61122
+ - Remove use of MooseX::Types as MooseX::Types is broken on perl5.8
+ RT#77100 & RT#81121
+
+5.90018 - 2012-10-23 20:55:00
+ - Changed code in test suite so it no longer trips up on recent changes to
+ HTTP::Message.
+
+5.90017 - 2012-10-19 22:33:00
+ - Change Catalyst _parse_attrs so that when sub attr handlers:
+
+ 1) Can return multiple pairs of new attributes.
+ 2) Get their returned attributes passed through the correct attribute handler.
+
+ e.g sub _parse_Whatever_attr { return Chained => 'foo', PathPart => 'bar' }
+
+ Will now work because both new attributes are respected, and the Chained
+ attribute is passed to _parse_Chained_attr and fixed up correctly by that.
+
+ - In Catalyst::Test, don't mangle headers of non-HTML responses. RT#79043
+
+ - Refactor request and response class construction to add methods
+ that roles can hook to feed extra parameters into the constructor
+ of request or response classes.
+
+5.90016 - 2012-08-16 15:35:00
+ - prepare_parameters is no longer an attribute builder. It is now a method
+ that calls the correct underlying functionality (Bill Moseley++)
+ - Updated Makefile.PL to handle MacOXS tar
+ - Fix uri_for to handle a stringifiable object
+ - Fix model/view/controller methods to handle stringifiable objects
+ - Fix RT#78377 - IIS7 ignores response body for 3xx requests, which
+ causes (a different) response to be broken when using keepalive.
+ Fixed by applying Middleware which removes the response body and
+ content length that Catalyst supplies with redirects.
+
+5.90015 - 2012-06-30 16:57:00
+ - Fix $c->finalize_headers getting called twice. RT#78090
+ - Fix test fails in Catalyst-Plugin-Session-State-Cookie. RT#76179
+ - Fix test fails in Catalyst-Plugin-StackTrace
+ - Fix test fails in Test-WWW-Mechanize-Catalyst
+
+5.90014 - 2012-06-26 10:00:00
+
+ - Fix calling finalize_headers before writing body when using $c->write /
+ $c->res->write (fixes RT#76179).
+
+5.90013 - 2012-06-21 10:40:00
+
+ - Release previous TRIAL as stable.
+ - We failed to note in the previous changelog that the Makefile.PL has been
+ improved to make it easier for authors to bootstrap a developer install
+ of Catalyst.
+
+5.90013 - TRIAL 2012-06-07 20:21:00
+
+ New features:
+ - Merge Catalyst::Controller::ActionRole into Catalyst::Controller.
+
+ Bug fixes:
+ - Fix warnings in some matching cases for Action methods with
+ Args(), when using Catalyst::DispatchType::Chained
+
+ - Fix request body parameters to not be undef if no parameters
+ are supplied.
+
+ - Fix action_args config so that it can be specified in the
+ top level config.
+
+ - Fix t/author/http-server.t on Win32
+
+ - Fix use of Test::Aggregate to make tests faster.
+
+5.90012 - 2012-05-16 09:59:00
+
+ Distribution META.yml changes:
+ - author key is now correct, rather than what Module::Install
+ mis-parses from the documentation.
+ - x_authority key added.
+
+ Bug fixes:
+ - Fix request body parameters being multiply rebuilt. Fixes both
+ RT#75607 and CatalystX::DebugFilter
+
+ - Make plugin de-duplication work as intended originally, as whilst
+ duplicate plugins are totally unwise, the C3 error given to the user
+ is less than helpful.
+
+ - Remove dependence on obscure behaviour in B::Hooks::EndOfScope
+ for backward compatibility. This fixes issues with behaviour changes
+ in bleadperl. RT#76437
+
+ - Work around Moose bug RT#75367 which breaks
+ Catalyst::Controller::DBIC::API.
+
+ Documentation:
+ - Fix documentation in Catalyst::Component to show attributes and
+ calling readers, rather than accessing elements in the $self->{} hash
+ directly.
+ - Add note in Catalyst::Component to strongly disrecommend $self->config
+ - Fix vague 'checkout' wording in Catalyst::Utils. RT#77000
+ - Fix documentation for the 'secure' method in Catalyst:Request. RT#76710
+
+5.90011 - 2012-03-08 16:43:00
+
+ Bug fixes:
+ - Simplification of the previous changes to Catalyst::ScriptRunner
+ We now just push $FindBin::Bin/../lib to the @INC path again, but
+ only if one of the dist indicator files (Makefile.PL Build.PL or
+ dist.ini) can be found in $FindBin::Bin/../$_
+ This avoids heuristics when the app is unloaded and therefore
+ works better for extensions which have entire applications in
+ their test suites.
+ - Bug fix to again correctly detect checkouts in dist zilla using
+ applications.
+ - --background option for the server script now only closes
+ STDIN, STDOUT and STDERR. This fixes issues with Log::Dispatch
+ and other loggers which open a file handle when
+ - Change incorrect use of File::Spec->catdir to File::Spec->catfile
+ so that we work on platforms which care about this (VMS?)
+ - Make it more obvious if our PSGI server doesn't pass in a response
+ callback.
+
+5.90010 - 2012-02-18 00:01:00
+
+ Bug fixes:
+ - Fix the previous fix to Catalyst::ScriptRunner which was resulting
+ in the lib directory not being pushed onto @INC.
+ This meant perl ./script/myapp_server.pl failed, however
+ perl -Ilib ./script/myapp_server.pl would succeed.
+
+5.90009 - 2012-02-16 09:06:00
+
+ Bug fixes:
+ - Fix the debug page so that it works as expected with the latest
+ refactoring.
+
+ - The Catalyst::Utils::home function is used to find if the application
+ is a checkout in Catalyst::ScriptRunner. This means that a non-existant
+ lib directory that is relative to the script install location is not
+ included when not running from a checkout.
+
+ - Fix dead links to cpansearch.perl.org to point to metacpan.org.
+
+ - Require the latest version of B::Hooks::EndOfScope (0.10) to avoid an
+ issue with new versions of Module::Runtime (0.012) on perl 5.10
+ which stopped Catalyst::Controller from compiling.
+
+ - In Catalyst::Test, don't mangle headers of non-HTML responses. RT#79043
+
+5.90008 - TRIAL 2012-02-06 20:49:00
+
+ New features and refactoring:
+ - Much of the Catalyst::Engine code has been moved into Catalyst::Request
+ and Catalyst::Response, to be able to better support asynchronous web
+ servers such as Twiggy, by making the application engine more reenterant.
+
+ This change is as a prequel to full asynchronous support inside Catalyst
+ for AnyEvent and IO::Async backends, which allow highly scaleable streaming
+ (for applications such as multi-part XML HTTPRequests, and Websockets).
+
+ Deprecations:
+ - This means that the $c->engine->env method to access the PSGI environment
+ is now deprecated. The accessor for the PSGI env is now on Catalyst::Request
+ as per applications which were using Catalyst::Engine::PSGI
+
+ Catalyst::Engine::PSGI is now considered fully deprecated.
+
+ - The private _dump method in Catalyst::Log is now deprecated. The dumper is
+ not pluggable and which dumper to use should be a user choice. Using
+ an imported Dump() or Dumper() function is less typing than $c->log->_dump
+ and as this method is unused anywhere else in Catalyst, it has been scheduled
+ for removal as a cleanup. Calling this method will now emit a stack trace
+ on first call (but not on subsequent calls).
+
+ Back compatibility fixes:
+ - Applications still using Catalyst::Engine::PSGI as they rely on
+ $c->request->env - this is now the provided (and recommended) way of
+ accessing the raw PSGI environment.
+
+ Tests:
+ - Spurious warnings have been removed from the test suite
+
+ Documentation:
+ - Fix the display of PROJECT FOUNDER and CONTRIBUTORS sections in the
+ documentation. These were erroneously being emitted when the Pod
+ was converted to HTML for search.cpan.org
+
+ - Fix documentation for the build_psgi_app app method. Previously the
+ documentation advised that it provided the psgi app already wrapped
+ in default middleware. This is not the case - it is the raw app psgi
+
+5.90007 - 2011-11-22 20:35:00
+
+ New features:
+ - Implement a match_captures hook which, if it exists on an action,
+ is called with the $ctx and \@captures and is expected to return
+ true to continue the chain matching and false to stop matching.
+ This can be used to implement action classes or roles which match
+ conditionally (for example only matching captures which are integers).
+
Bug fixes:
- Lighttpd script name fix is only applied for lighttpd versions
- < 1.4.23
+ < 1.4.23. This should fix non-root installs of lighttpd in versions
+ over that.
- Prepare_action is now inside a try {} block, so that requests containing
bad unicode can be appropriately trapped by
Catalyst::Plugin::Unicode::Encoding
# Ensure that these get used - yes, M::I loads them for us, but if you're
# in author mode and don't have them installed, then the error is tres
# cryptic.
-use Module::Install::AuthorRequires;
-use Module::Install::CheckConflicts;
-use Module::Install::AuthorTests;
+if ($Module::Install::AUTHOR) { # We could just use them, but telling
+ my @fail; # people the set of things they need nicer
+ foreach my $module (qw/
+ Module::Install::AuthorRequires
+ Module::Install::CheckConflicts
+ Module::Install::AuthorTests
+ Module::Install::Authority
+ /) {
+ push(@fail, $module)
+ unless eval qq{require $module; 1;};
+ }
+ die("Module::Install extensions failed, not installed? \n"
+ . join("\n", map { " $_" } @fail) . "\n") if @fail;
+}
-perl_version '5.008004';
+perl_version '5.008003';
name 'Catalyst-Runtime';
+author 'Sebastian Riedel <sri@cpan.org>';
+authority('MSTROUT');
all_from 'lib/Catalyst/Runtime.pm';
requires 'List::MoreUtils';
requires 'namespace::autoclean' => '0.09';
-requires 'namespace::clean' => '0.13';
-requires 'B::Hooks::EndOfScope' => '0.08';
+requires 'namespace::clean' => '0.23';
requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903';
requires 'Class::Load' => '0.12';
requires 'Class::MOP' => '0.95';
requires 'Moose' => '1.03';
requires 'MooseX::MethodAttributes::Inheritable' => '0.24';
requires 'MooseX::Role::WithOverloading' => '0.09';
-requires 'MooseX::Types::LoadableClass' => '0.003';
requires 'Carp';
requires 'Class::C3::Adopt::NEXT' => '0.07';
requires 'CGI::Simple::Cookie' => '1.109';
requires 'Tree::Simple' => '1.15';
requires 'Tree::Simple::Visitor::FindByPath';
requires 'Try::Tiny';
+requires 'Safe::Isa';
requires 'URI' => '1.35';
requires 'Task::Weaken';
requires 'Text::Balanced'; # core in 5.8.x but mentioned for completeness
requires 'MRO::Compat';
-requires 'MooseX::Getopt' => '0.30';
-requires 'MooseX::Types';
-requires 'MooseX::Types::Common::Numeric';
+requires 'MooseX::Getopt' => '0.48';
requires 'String::RewritePrefix' => '0.004'; # Catalyst::Utils::resolve_namespace
-requires 'Plack' => '0.9974'; # IIS6 fix middleware
+requires 'Plack' => '0.9991'; # IIS6+7 fix middleware
requires 'Plack::Middleware::ReverseProxy' => '0.04';
requires 'Plack::Test::ExternalServer';
test_requires 'HTTP::Request::Common';
# aggregate tests if AGGREGATE_TESTS is set and a recent Test::Aggregate and a Test::Simple it works with is available
+my @author_requires;
if ($ENV{AGGREGATE_TESTS} && can_use('Test::Simple', '0.88') && can_use('Test::Aggregate', '0.364')) {
- author_requires('Test::Aggregate', '0.364');
- author_requires('Test::Simple', '0.88');
+ push(@author_requires, 'Test::Aggregate', '0.364');
+ push(@author_requires, 'Test::Simple', '0.88');
open my $fh, '>', '.aggregating';
}
else {
tests 't/*.t t/aggregate/*.t';
}
-author_requires 'CatalystX::LeakChecker', '0.05';
-author_requires 'File::Copy::Recursive'; # For http server test
-author_requires 'Catalyst::Devel', '1.0'; # For http server test
-author_requires 'Catalyst::Engine::PSGI';
-author_requires 'Test::Without::Module';
-author_requires 'Starman';
-author_requires 'MooseX::Daemonize';
-
-author_tests 't/author';
-author_requires(map {; $_ => 0 } qw(
+push(@author_requires, 'CatalystX::LeakChecker', '0.05');
+push(@author_requires, 'Catalyst::Devel', '1.0'); # For http server test
+
+author_tests('t/author');
+author_requires(
+ @author_requires,
+ map {; $_ => 0 } qw(
+ File::Copy::Recursive
+ Catalyst::Engine::PSGI
+ Test::Without::Module
+ Starman
+ MooseX::Daemonize
Test::NoTabs
Test::Pod
Test::Pod::Coverage
# TAR on 10.4 wants COPY_EXTENDED_ATTRIBUTES_DISABLE
# On 10.5 (Leopard) it wants COPYFILE_DISABLE
- die("Oh, you got Ceiling Cat, snazzy. Please read the man page for tar or Google to find out if Apple renamed COPYFILE_DISABLE (it was COPY_EXTENDED_ATTRIBUTES_DISABLE originally) again and fix this Makefile.PL please?\n") if $osx_ver =~ /^10.8/;
- my $attr = $osx_ver =~ /^10.(5|6|7)/ ? 'COPYFILE_DISABLE' : 'COPY_EXTENDED_ATTRIBUTES_DISABLE';
+ my $attr = $osx_ver =~ /^10.(5|6|7|8)/ ? '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',"; }.
+++ /dev/null
-Catalyst-Runtime
-================
-This is the Runtime distribution for the Catalyst MVC framework.
-For more information about Catalyst, write
-
-$ perldoc Catalyst
-
-at the command line, or visit http://www.catalystframework.org/.
-You can also install Catalyst::Manual from CPAN for more
-comprehensive information.
-
-If you are going to write your own Catalyst application, you will
-need to install Catalyst::Devel. Afterwards run catalyst.pl
-for more information about creating your first app.
--- /dev/null
+=head1 Welcome to Catalyst
+
+This is the Runtime distribution for the L<Catalyst MVC framework|http://www.catalystframework.org/>.
+
+For more information about Catalyst, write
+
+ perldoc Catalyst
+
+at the command line, or visit http://www.catalystframework.org/.
+
+=head2 Getting Started
+
+1. Install Catalyst if you haven't yet:
+
+ cpanm Catalyst
+
+2. Create a new catalyst application:
+
+ catalyst.pl DemoApp
+
+3. Change the directory to the newly created directory and start the built-in developer server
+
+ cd DemoApp; plackup -Ilib demoapp.psgi
+
+4. Go to http://localhost:5000 and you'll see the default welcome page.
+
+=head2 Resources
+
+You can also install L<Catalyst::Manual|https://metacpan.org/module/Catalyst::Manual>
+from CPAN for more comprehensive information.
+
+If you are going to write your own Catalyst application, you will need to
+install L<Catalyst::Devel|https://metacpan.org/module/Catalyst::Devel>.
+Afterwards run I<catalyst.pl> for more information about creating your first
+app.
+
+=head2 Contributing
+
+If you would like to contribute to Catalyst, please
+L<join us|http://chat.mibbit.com/#catalyst@irc.perl.org> on IRC,
+or visit the L<maillist|http://lists.scsys.co.uk/mailman/listinfo/catalyst>.
use Moose::Meta::Class ();
extends 'Catalyst::Component';
use Moose::Util qw/find_meta/;
-use B::Hooks::EndOfScope ();
+use namespace::clean -except => 'meta';
use Catalyst::Exception;
use Catalyst::Exception::Detach;
use Catalyst::Exception::Go;
use URI ();
use URI::http;
use URI::https;
+use HTML::Entities;
use Tree::Simple qw/use_weak_refs/;
use Tree::Simple::Visitor::FindByUID;
use Class::C3::Adopt::NEXT;
use utf8;
use Carp qw/croak carp shortmess/;
use Try::Tiny;
+use Safe::Isa;
use Plack::Middleware::Conditional;
use Plack::Middleware::ReverseProxy;
use Plack::Middleware::IIS6ScriptNameFix;
+use Plack::Middleware::IIS7KeepAliveFix;
use Plack::Middleware::LighttpdScriptNameFix;
-BEGIN { require 5.008004; }
+BEGIN { require 5.008003; }
has stack => (is => 'ro', default => sub { [] });
has stash => (is => 'rw', default => sub { {} });
has stats => (is => 'rw');
has action => (is => 'rw');
has counter => (is => 'rw', default => sub { {} });
-has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
-has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
+has request => (
+ is => 'rw',
+ default => sub {
+ my $self = shift;
+ $self->request_class->new($self->_build_request_constructor_args);
+ },
+ lazy => 1,
+);
+sub _build_request_constructor_args {
+ my $self = shift;
+ my %p = ( _log => $self->log );
+ $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
+ \%p;
+}
+
+has response => (
+ is => 'rw',
+ default => sub {
+ my $self = shift;
+ $self->response_class->new($self->_build_response_constructor_args);
+ },
+ lazy => 1,
+);
+sub _build_response_constructor_args {
+ my $self = shift;
+ { _log => $self->log };
+}
+
has namespace => (is => 'rw');
sub depth { scalar @{ shift->stack || [] }; }
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90006';
+our $VERSION = '5.90020';
sub import {
my ( $class, @arguments ) = @_;
sub _application { $_[0] }
+=encoding UTF-8
+
=head1 NAME
Catalyst - The Elegant MVC Web Application Framework
sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
+=head2 $c->visit( $action [, \@arguments ] )
+
=head2 $c->visit( $action [, \@captures, \@arguments ] )
+=head2 $c->visit( $class, $method, [, \@arguments ] )
+
=head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
+=head2 $c->go( $action [, \@arguments ] )
+
=head2 $c->go( $action [, \@captures, \@arguments ] )
+=head2 $c->go( $class, $method, [, \@arguments ] )
+
=head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
The relationship between C<go> and
# undef for a name will return all
return keys %eligible if !defined $name;
- my $query = ref $name ? $name : qr/^$name$/i;
+ my $query = $name->$_isa('Regexp') ? $name : qr/^$name$/i;
my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
return @result if @result;
# if we were given a regexp to search against, we're done.
- return if ref $name;
+ return if $name->$_isa('Regexp');
# skip regexp fallback if configured
return
my $appclass = ref($c) || $c;
if( $name ) {
- unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
+ unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
my $comps = $c->components;
my $check = $appclass."::Controller::".$name;
return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
my ( $c, $name, @args ) = @_;
my $appclass = ref($c) || $c;
if( $name ) {
- unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
+ unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
my $comps = $c->components;
my $check = $appclass."::Model::".$name;
return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
my $appclass = ref($c) || $c;
if( $name ) {
- unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
+ unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
my $comps = $c->components;
my $check = $appclass."::View::".$name;
if( exists $comps->{$check} ) {
$class->log->info("$name powered by Catalyst $Catalyst::VERSION");
}
- # Make sure that the application class becomes immutable at this point,
- B::Hooks::EndOfScope::on_scope_end {
- return if $@;
- my $meta = Class::MOP::get_metaclass_by_name($class);
- if (
- $meta->is_immutable
- && ! { $meta->immutable_options }->{replace_constructor}
- && (
- $class->isa('Class::Accessor::Fast')
- || $class->isa('Class::Accessor')
- )
- ) {
- warn "You made your application class ($class) immutable, "
- . "but did not inline the\nconstructor. "
- . "This will break catalyst, as your app \@ISA "
- . "Class::Accessor(::Fast)?\nPlease pass "
- . "(replace_constructor => 1)\nwhen making your class immutable.\n";
- }
- $meta->make_immutable(
- replace_constructor => 1,
- ) unless $meta->is_immutable;
- };
-
if ($class->config->{case_sensitive}) {
$class->log->warn($class . "->config->{case_sensitive} is set.");
$class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
sub uri_for {
my ( $c, $path, @args ) = @_;
- if (blessed($path) && $path->isa('Catalyst::Controller')) {
+ if ( $path->$_isa('Catalyst::Controller') ) {
$path = $path->path_prefix;
$path =~ s{/+\z}{};
$path .= '/';
$arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
}
- if ( blessed($path) ) { # action object
+ if ( $path->$_isa('Catalyst::Action') ) { # action object
s|/|%2F|g for @args;
my $captures = [ map { s|/|%2F|g; $_; }
( scalar @args && ref $args[0] eq 'ARRAY'
We do, however, provide you with a few starting points.</p>
<p>If you want to jump right into web development with Catalyst
you might want to start with a tutorial.</p>
-<pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
+<pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code>
</pre>
<p>Afterwards you can go on to check out a more complete look at our features.</p>
<pre>
-<code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
+<code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a>
<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
</code></pre>
<h2>What to do next?</h2>
<p>Next it's time to write an actual application. Use the
- helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
- <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a>, and
- <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>;
+ helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>,
+ <a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and
+ <a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>;
they can save you a lot of work.</p>
<pre><code>script/${prefix}_create.pl --help</code></pre>
<p>Also, be sure to check out the vast and growing
$c->finalize_error;
}
- $c->finalize_headers;
+ $c->finalize_headers unless $c->response->finalized_headers;
# HEAD request
if ( $c->request->method eq 'HEAD' ) {
if ( !$response->has_body ) {
# Add a default body if none is already present
+ my $encoded_location = encode_entities($location);
$response->body(<<"EOF");
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<title>Moved</title>
</head>
<body>
- <p>This item has moved <a href="$location">here</a>.</p>
+ <p>This item has moved <a href="$encoded_location">here</a>.</p>
</body>
</html>
EOF
$c->finalize_cookies;
- $c->engine->finalize_headers( $c, @_ );
+ $c->response->finalize_headers();
# Done
$response->finalized_headers(1);
=cut
+has _uploadtmp => (
+ is => 'ro',
+ predicate => '_has_uploadtmp',
+);
+
sub prepare {
my ( $class, @arguments ) = @_;
# into the application.
$class->context_class( ref $class || $class ) unless $class->context_class;
- my $c = $class->context_class->new({});
+ my $uploadtmp = $class->config->{uploadtmp};
+ my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
- # For on-demand data
- $c->request->_context($c);
$c->response->_context($c);
#surely this is not the most efficient way to do things...
$c->prepare_request(@arguments);
$c->prepare_connection;
$c->prepare_query_parameters;
- $c->prepare_headers;
- $c->prepare_cookies;
+ $c->prepare_headers; # Just hooks, no longer needed - they just
+ $c->prepare_cookies; # cause the lazy attribute on req to build
$c->prepare_path;
# Prepare the body for reading, either by prepare_body
sub prepare_connection {
my $c = shift;
- $c->engine->prepare_connection( $c, @_ );
+ # XXX - This is called on the engine (not the request) to maintain
+ # Engine::PSGI back compat.
+ $c->engine->prepare_connection($c);
}
=head2 $c->prepare_cookies
-Prepares cookies.
+Prepares cookies by ensuring that the attribute on the request
+object has been built.
=cut
-sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
+sub prepare_cookies { my $c = shift; $c->request->cookies }
=head2 $c->prepare_headers
-Prepares headers.
+Prepares request headers by ensuring that the attribute on the request
+object has been built.
=cut
-sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
+sub prepare_headers { my $c = shift; $c->request->headers }
=head2 $c->prepare_parameters
=cut
-sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
+sub read { my $c = shift; return $c->request->read( @_ ) }
=head2 $c->run
sub run {
my $app = shift;
+ $app->_make_immutable_if_needed;
$app->engine_loader->needs_psgi_engine_compat_hack ?
$app->engine->run($app, @_) :
$app->engine->run( $app, $app->_finalized_psgi_app, @_ );
}
+sub _make_immutable_if_needed {
+ my $class = shift;
+ my $meta = Class::MOP::get_metaclass_by_name($class);
+ my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
+ if (
+ $meta->is_immutable
+ && ! { $meta->immutable_options }->{replace_constructor}
+ && $isa_ca
+ ) {
+ warn("You made your application class ($class) immutable, "
+ . "but did not inline the\nconstructor. "
+ . "This will break catalyst, as your app \@ISA "
+ . "Class::Accessor(::Fast)?\nPlease pass "
+ . "(replace_constructor => 1)\nwhen making your class immutable.\n");
+ }
+ unless ($meta->is_immutable) {
+ # XXX - FIXME warning here as you should make your app immutable yourself.
+ $meta->make_immutable(
+ replace_constructor => 1,
+ );
+ }
+}
+
=head2 $c->set_action( $action, $code, $namespace, $attrs )
Sets an action in a given namespace.
condition => sub {
my ($env) = @_;
return unless $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!lighttpd[-/]1\.(\d+\.\d+)!;
- return unless $env < 4.23;
+ return unless $1 < 4.23;
1;
},
);
# IIS versions
$psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app);
+ # And another IIS issue, this time with IIS7.
+ $psgi_app = Plack::Middleware::Conditional->wrap(
+ $psgi_app,
+ builder => sub { Plack::Middleware::IIS7KeepAliveFix->wrap($_[0]) },
+ condition => sub {
+ my ($env) = @_;
+ return $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!IIS/7\.[0-9]!;
+ },
+ );
+
return $psgi_app;
}
Class::MOP::load_class( $plugin );
$class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
if $plugin->isa( 'Catalyst::Component' );
- $proto->_plugins->{$plugin} = 1;
- unless ($instant) {
+ my $plugin_meta = Moose::Meta::Class->create($plugin);
+ if (!$plugin_meta->has_method('new')
+ && ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) {
+ $plugin_meta->add_method('new', Moose::Object->meta->get_method('new'))
+ }
+ if (!$instant && !$proto->_plugins->{$plugin}) {
my $meta = Class::MOP::get_metaclass_by_name($class);
$meta->superclasses($plugin, $meta->superclasses);
}
+ $proto->_plugins->{$plugin} = 1;
return $class;
}
sub write {
my $c = shift;
- # Finalize headers if someone manually writes output
+ # Finalize headers if someone manually writes output (for compat)
$c->finalize_headers;
- return $c->engine->write( $c, @_ );
+ return $c->response->write( @_ );
}
=head2 version
=head2 L<Catalyst::Test> - The test suite.
-=begin stopwords
-
=head1 PROJECT FOUNDER
sri: Sebastian Riedel <sri@cpan.org>
dd070: Dhaval Dhanani <dhaval070@gmail.com>
-=end stopwords
-
=head1 COPYRIGHT
Copyright (c) 2005, the above named PROJECT FOUNDER and CONTRIBUTORS.
return scalar( @{ $c->req->args } ) == $args;
}
+sub match_captures { 1 }
+
sub compare {
my ($a1, $a2) = @_;
return $self->attributes->{CaptureArgs}[0] || 0;
}
+sub list_extra_info {
+ my $self = shift;
+ return {
+ Args => $self->attributes->{Args}[0],
+ CaptureArgs => $self->number_of_captures,
+ }
+}
+
__PACKAGE__->meta->make_immutable;
1;
Check Args attribute, and makes sure number of args matches the setting.
Always returns true if Args is omitted.
+=head2 match_captures ($c, $captures)
+
+Can be implemented by action class and action role authors. If the method
+exists, then it will be called with the request context and an array reference
+of the captures for this action.
+
+Returning true from this method causes the chain match to continue, returning
+makes the chain not match (and alternate, less preferred chains will be attempted).
+
+
=head2 compare
Compares 2 actions based on the value of the C<Args> attribute, with no C<Args>
Returns the number of captures this action expects for L<Chained|Catalyst::DispatchType::Chained> actions.
+=head2 list_extra_info
+
+A HashRef of key-values that an action can provide to a debugging screen
+
=head2 meta
Provided by Moose.
--- /dev/null
+package Catalyst::ActionRole::HTTPMethods;
+
+use Moose::Role;
+
+requires 'match', 'match_captures', 'list_extra_info';
+
+around ['match','match_captures'] => sub {
+ my ($orig, $self, $ctx, @args) = @_;
+ my $expected = $self->_normalize_expected_http_method($ctx->req);
+ return $self->_has_expected_http_method($expected) ?
+ $self->$orig($ctx, @args) :
+ 0;
+};
+
+sub _normalize_expected_http_method {
+ my ($self, $req) = @_;
+ return $req->header('X-HTTP-Method') ||
+ $req->header('X-HTTP-Method-Override') ||
+ $req->header('X-METHOD-OVERRIDE') ||
+ $req->header('x-tunneled-method') ||
+ $req->method;
+}
+
+sub _has_expected_http_method {
+ my ($self, $expected) = @_;
+ return 1 unless scalar(my @allowed = $self->allowed_http_methods);
+ return scalar(grep { lc($_) eq lc($expected) } @allowed) ?
+ 1 : 0;
+}
+
+sub allowed_http_methods { @{shift->attributes->{Method}||[]} }
+
+around 'list_extra_info' => sub {
+ my ($orig, $self, @args) = @_;
+ return {
+ %{ $self->$orig(@args) },
+ HTTP_METHODS => [sort $self->allowed_http_methods],
+ };
+};
+
+1;
+
+=head1 NAME
+
+Catalyst::ActionRole::HTTPMethods - Match on HTTP Methods
+
+=head1 SYNOPSIS
+
+ package MyApp::Web::Controller::MyController;
+
+ use Moose;
+ use MooseX::MethodAttributes;
+
+ extends 'Catalyst::Controller';
+
+ sub user_base : Chained('/') CaptureArg(0) { ... }
+
+ sub get_user : Chained('user_base') Args(1) GET { ... }
+ sub post_user : Chained('user_base') Args(1) POST { ... }
+ sub put_user : Chained('user_base') Args(1) PUT { ... }
+ sub delete_user : Chained('user_base') Args(1) DELETE { ... }
+ sub head_user : Chained('user_base') Args(1) HEAD { ... }
+ sub option_user : Chained('user_base') Args(1) OPTION { ... }
+ sub option_user : Chained('user_base') Args(1) PATCH { ... }
+
+
+ sub post_and_put : Chained('user_base') POST PUT Args(1) { ... }
+ sub method_attr : Chained('user_base') Method('DELETE') Args(0) { ... }
+
+ __PACKAGE__->meta->make_immutable;
+
+=head1 DESCRIPTION
+
+This is an action role that lets your L<Catalyst::Action> match on standard
+HTTP methods, such as GET, POST, etc.
+
+Since most web browsers have limited support for rich HTTP Method vocabularies
+we also support setting the expected match method via the follow non standard
+but widely used http extensions. Our support for these should not be taken as
+an endorsement of the technique. Rt is merely a reflection of our desire to
+work well with existing systems and common client side tools.
+
+=over 4
+
+=item X-HTTP-Method (Microsoft)
+
+=item X-HTTP-Method-Override (Google/GData)
+
+=item X-METHOD-OVERRIDE (IBM)
+
+=item x-tunneled-method (used in many other similar systems on CPAN
+
+=back
+
+Please note the insanity of overriding a GET request with a DELETE override...
+Rational practices suggest that using POST with overrides to emulate PUT and
+DELETE can be an acceptable way to deal with client limitations and security
+rules on your proxy server. I recommend going no further.
+
+=head1 REQUIRES
+
+This role requires the following methods in the consuming class.
+
+=head2 match
+
+=head2 match_captures
+
+Returns 1 if the action matches the existing request and zero if not.
+
+=head1 METHODS
+
+This role defines the following methods
+
+=head2 match
+
+=head2 match_captures
+
+Around method modifier that return 1 if the request method matches one of the
+allowed methods (see L</http_methods>) and zero otherwise.
+
+=head2 allowed_http_methods
+
+An array of strings that are the allowed http methods for matching this action
+normalized as noted above (using X-Method* overrides).
+
+=head2 list_extra_info
+
+Adds a key => [@values] "HTTP_METHODS" whose value is an ArrayRef of sorted
+allowed methods to the ->list_extra_info HashRef. This is used primarily for
+debugging output.
+
+=head2 _has_expected_http_method ($expected)
+
+Private method which returns 1 if C<$expected> matches one of the allowed
+in L</http_methods> and zero otherwise.
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
no Moose;
+__PACKAGE__->meta->make_immutable;
+
1;
__END__
__PACKAGE__->config( foo => 'bar' );
+ has foo => (
+ is => 'ro',
+ );
+
sub test {
my $self = shift;
- return $self->{foo};
+ return $self->foo;
}
sub forward_to_me {
my ( $self, $c ) = @_;
- $c->response->output( $self->{foo} );
+ $c->response->output( $self->foo );
}
1;
# Or just methods
print $c->comp('MyApp::Model::Something')->test;
- print $c->comp('MyApp::Model::Something')->{foo};
+ print $c->comp('MyApp::Model::Something')->foo;
=head1 DESCRIPTION
It provides you with a generic new() for component construction through Catalyst's
component loader with config() support and a process() method placeholder.
+B<Note> that calling C<< $self->config >> inside a component is strongly
+not recommended - the correctly merged config should have already been
+passed to the constructor and stored in attributes - accessing
+the config accessor directly from an instance is likely to get the
+wrong values (as it only holds the class wide config, not things loaded
+from the config file!)
+
=cut
__PACKAGE__->mk_classdata('_plugins');
The component's config hash is merged with any config entry on the
application for this component and passed to C<new()> (as mentioned
-above at L</COMPONENT>). The common practice to access the merged
+above at L</COMPONENT>). The recommended practice to access the merged
config is to use a Moose attribute for each config entry on the
receiving component.
package Catalyst::Controller;
use Moose;
+use Class::MOP;
+use Class::Load ':all';
+use String::RewritePrefix;
use Moose::Util qw/find_meta/;
+use List::Util qw/first/;
use List::MoreUtils qw/uniq/;
use namespace::clean -except => 'meta';
with 'Catalyst::Component::ApplicationAttribute';
-has path_prefix =>
- (
- is => 'rw',
- isa => 'Str',
- init_arg => 'path',
- predicate => 'has_path_prefix',
- );
+has path_prefix => (
+ is => 'rw',
+ isa => 'Str',
+ init_arg => 'path',
+ predicate => 'has_path_prefix',
+);
-has action_namespace =>
- (
- is => 'rw',
- isa => 'Str',
- init_arg => 'namespace',
- predicate => 'has_action_namespace',
- );
+has action_namespace => (
+ is => 'rw',
+ isa => 'Str',
+ init_arg => 'namespace',
+ predicate => 'has_action_namespace',
+);
-has actions =>
- (
- accessor => '_controller_actions',
- isa => 'HashRef',
- init_arg => undef,
- );
+has actions => (
+ accessor => '_controller_actions',
+ isa => 'HashRef',
+ init_arg => undef,
+);
+
+has _action_role_args => (
+ traits => [qw(Array)],
+ isa => 'ArrayRef[Str]',
+ init_arg => 'action_roles',
+ default => sub { [] },
+ handles => {
+ _action_role_args => 'elements',
+ },
+);
+
+has _action_roles => (
+ traits => [qw(Array)],
+ isa => 'ArrayRef[RoleName]',
+ init_arg => undef,
+ lazy => 1,
+ builder => '_build__action_roles',
+ handles => {
+ _action_roles => 'elements',
+ },
+);
+
+has action_args => (is => 'ro');
# ->config(actions => { '*' => ...
has _all_actions_attributes => (
# trigger lazy builder
$self->_all_actions_attributes;
+ $self->_action_roles;
+}
+
+sub _build__action_roles {
+ my $self = shift;
+ my @roles = $self->_expand_role_shortname($self->_action_role_args);
+ load_class($_) for @roles;
+ return \@roles;
}
sub _build__all_actions_attributes {
#I think both of these could be attributes. doesn't really seem like they need
#to ble class data. i think that attributes +default would work just fine
-__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
+__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class _action_role_prefix/;
__PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
__PACKAGE__->_action_class('Catalyst::Action');
+__PACKAGE__->_action_role_prefix([ 'Catalyst::ActionRole::' ]);
sub _DISPATCH : Private {
my $attributes = $method->can('attributes') ? $method->attributes : [];
my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } );
if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) {
- $c->log->debug( 'Bad action definition "'
+ $c->log->warn( 'Bad action definition "'
. join( ' ', @{ $attributes } )
. qq/" for "$class->$name"/ )
if $c->debug;
}
}
+sub _apply_action_class_roles {
+ my ($self, $class, @roles) = @_;
+
+ load_class($_) for @roles;
+ my $meta = Moose::Meta::Class->initialize($class)->create_anon_class(
+ superclasses => [$class],
+ roles => \@roles,
+ cache => 1,
+ );
+ $meta->add_method(meta => sub { $meta });
+
+ return $meta->name;
+}
+
sub action_class {
my $self = shift;
my %args = @_;
my %args = @_;
my $class = $self->action_class(%args);
- my $action_args = $self->config->{action_args};
+
+ load_class($class);
+ Moose->init_meta(for_class => $class)
+ unless Class::MOP::does_metaclass_exist($class);
+
+ unless ($args{name} =~ /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/) {
+ my @roles = $self->gather_action_roles(%args);
+ push @roles, $self->gather_default_action_roles(%args);
+
+ $class = $self->_apply_action_class_roles($class, @roles) if @roles;
+ }
+
+ my $action_args = (
+ ref($self)
+ ? $self->action_args
+ : $self->config->{action_args}
+ );
my %extra_args = (
%{ $action_args->{'*'} || {} },
return $class->new({ %extra_args, %args });
}
+sub gather_action_roles {
+ my ($self, %args) = @_;
+ return (
+ (blessed $self ? $self->_action_roles : ()),
+ @{ $args{attributes}->{Does} || [] },
+ );
+}
+
+sub gather_default_action_roles {
+ my ($self, %args) = @_;
+ my @roles = ();
+ push @roles, 'Catalyst::ActionRole::HTTPMethods'
+ if $args{attributes}->{Method};
+ return @roles;
+}
+
sub _parse_attrs {
my ( $self, $c, $name, @attrs ) = @_;
my %final_attributes;
- foreach my $key (keys %raw_attributes) {
+ while (my ($key, $value) = each %raw_attributes){
+ my $new_attrs = $self->_parse_attr($c, $name, $key => $value );
+ push @{ $final_attributes{$_} }, @{ $new_attrs->{$_} } for keys %$new_attrs;
+ }
- my $raw = $raw_attributes{$key};
+ return \%final_attributes;
+}
- foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
+sub _parse_attr {
+ my ($self, $c, $name, $key, $values) = @_;
- my $meth = "_parse_${key}_attr";
- if ( my $code = $self->can($meth) ) {
- ( $key, $value ) = $self->$code( $c, $name, $value );
+ my %final_attributes;
+ foreach my $value (ref($values) eq 'ARRAY' ? @$values : $values) {
+ my $meth = "_parse_${key}_attr";
+ if ( my $code = $self->can($meth) ) {
+ my %new_attrs = $self->$code( $c, $name, $value );
+ while (my ($new_key, $value) = each %new_attrs){
+ my $new_attrs = $key eq $new_key ?
+ { $new_key => [$value] } :
+ $self->_parse_attr($c, $name, $new_key => $value );
+ push @{ $final_attributes{$_} }, @{ $new_attrs->{$_} } for keys %$new_attrs;
}
+ }
+ else {
push( @{ $final_attributes{$key} }, $value );
}
}
sub _parse_Global_attr {
my ( $self, $c, $name, $value ) = @_;
- return $self->_parse_Path_attr( $c, $name, "/$name" );
+ # _parse_attr will call _parse_Path_attr for us
+ return Path => "/$name";
}
sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); }
sub _parse_Local_attr {
my ( $self, $c, $name, $value ) = @_;
- return $self->_parse_Path_attr( $c, $name, $name );
+ # _parse_attr will call _parse_Path_attr for us
+ return Path => $name;
}
sub _parse_Relative_attr { shift->_parse_Local_attr(@_); }
my ( $self, $c, $name, $value ) = @_;
my $appclass = Catalyst::Utils::class2appclass($self);
- $value = "${appclass}::Action::${value}";
+ $value = "+${appclass}::Action::${value}";
return ( 'ActionClass', $value );
}
+sub _parse_Does_attr {
+ my ($self, $app, $name, $value) = @_;
+ return Does => $self->_expand_role_shortname($value);
+}
+
+sub _parse_GET_attr { Method => 'GET' }
+sub _parse_POST_attr { Method => 'POST' }
+sub _parse_PUT_attr { Method => 'PUT' }
+sub _parse_DELETE_attr { Method => 'DELETE' }
+sub _parse_OPTION_attr { Method => 'OPTION' }
+sub _parse_HEAD_attr { Method => 'HEAD' }
+
+sub _expand_role_shortname {
+ my ($self, @shortnames) = @_;
+ my $app = $self->_application;
+
+ my $prefix = $self->can('_action_role_prefix') ? $self->_action_role_prefix : ['Catalyst::ActionRole::'];
+ my @prefixes = (qq{${app}::ActionRole::}, @$prefix);
+
+ return String::RewritePrefix->rewrite(
+ { '' => sub {
+ my $loaded = load_first_existing_class(
+ map { "$_$_[0]" } @prefixes
+ );
+ return first { $loaded =~ /^$_/ }
+ sort { length $b <=> length $a } @prefixes;
+ },
+ '~' => $prefixes[0],
+ '+' => '' },
+ @shortnames,
+ );
+}
+
__PACKAGE__->meta->make_immutable;
1;
Called with a hash of data to be use for construction of a new
Catalyst::Action (or appropriate sub/alternative class) object.
+=head2 $self->gather_action_roles(\%action_args)
+
+Gathers the list of roles to apply to an action with the given %action_args.
+
+=head2 $self->gather_default_action_roles(\%action_args)
+
+returns a list of action roles to be applied based on core, builtin rules.
+Currently only the L<Catalyst::ActionRole::HTTPMethods> role is applied
+this way.
+
=head2 $self->_application
=head2 $self->_app
Returns the application instance stored by C<new()>
+=head1 ACTION SUBROUTINE ATTRIBUTES
+
+Please see L<Catalyst::Manual::Intro> for more details
+
+Think of action attributes as a sort of way to record metadata about an action,
+similar to how annotations work in other languages you might have heard of.
+Generally L<Catalyst> uses these to influence how the dispatcher sees your
+action and when it will run it in response to an incoming request. They can
+also be used for other things. Here's a summary, but you should refer to the
+liked manual page for additional help.
+
+=head2 Global
+
+ sub homepage :Global { ... }
+
+A global action defined in any controller always runs relative to your root.
+So the above is the same as:
+
+ sub myaction :Path("/homepage") { ... }
+
+=head2 Absolute
+
+Status: Deprecated alias to L</Global>.
+
+=head2 Local
+
+Alias to "Path("$action_name"). The following two actions are the same:
+
+ sub myaction :Local { ... }
+ sub myaction :Path('myaction') { ... }
+
+=head2 Relative
+
+Status: Deprecated alias to L</Local>
+
+=head2 Path
+
+Handle various types of paths:
+
+ package MyApp::Controller::Baz {
+
+ ...
+
+ sub myaction1 :Path { ... } # -> /baz
+ sub myaction2 :Path('foo') { ... } # -> /baz/bar
+ sub myaction2 :Path('/bar') { ... } # -> /bar
+ }
+
+This is a general toolbox for attaching your action to a give path.
+
+
+=head2 Regex
+
+=head2 Regexp
+
+Status: Deprecated. Use Chained methods or other techniques
+
+A global way to match a give regular expression in the incoming request path.
+
+=head2 LocalRegex
+
+=head2 LocalRegexp
+
+Like L</Regex> but scoped under the namespace of the containing controller
+
+=head2 Chained
+
+=head2 ChainedParent
+
+=head2 PathPrefix
+
+=head2 PathPart
+
+=head2 CaptureArgs
+
+Please see L<Catalyst::DispatchType::Chained>
+
+=head2 ActionClass
+
+Set the base class for the action, defaults to L</Catalyst::Action>. It is now
+preferred to use L</Does>.
+
+=head2 MyAction
+
+Set the ActionClass using a custom Action in your project namespace.
+
+The following is exactly the same:
+
+ sub foo_action1 : Local ActionClass('+MyApp::Action::Bar') { ... }
+ sub foo_action2 : Local MyAction('Bar') { ... }
+
+=head2 Does
+
+ package MyApp::Controller::Zoo;
+
+ sub foo : Local Does('Moo') { ... } # Catalyst::ActionRole::
+ sub bar : Local Does('~Moo') { ... } # MyApp::ActionRole::Moo
+ sub baz : Local Does('+MyApp::ActionRole::Moo') { ... }
+
+=head2 GET
+
+=head2 POST
+
+=head2 PUT
+
+=head2 DELETE
+
+=head2 OPTION
+
+=head2 HEAD
+
+=head2 PATCH
+
+=head2 Method('...')
+
+Sets the give action path to match the specified HTTP method, or via one of the
+broadly accepted methods of overriding the 'true' method (see
+L<Catalyst::ActionRole::HTTPMethods>).
+
+=head2 Args
+
+When used with L</Path> indicates the number of arguments expected in
+the path. However if no Args value is set, assumed to 'slurp' all
+remaining path pars under this namespace.
+
+=head1 OPTIONAL METHODS
+
+=head2 _parse_[$name]_attr
+
+Allows you to customize parsing of subroutine attributes.
+
+ sub myaction1 :Path TwoArgs { ... }
+
+ sub _parse_TwoArgs_attr {
+ my ( $self, $c, $name, $value ) = @_;
+ # $self -> controller instance
+ #
+ return(Args => 2);
+ }
+
+Please note that this feature does not let you actually assign new functions
+to actions via subroutine attributes, but is really more for creating useful
+aliases to existing core and extended attributes, and transforms based on
+existing information (like from configuration). Code for actually doing
+something meaningful with the subroutine attributes will be located in the
+L<Catalyst::Action> classes (or your subclasses), L<Catalyst::Dispatcher> and
+in subclasses of L<Catalyst::DispatchType>. Remember these methods only get
+called basically once when the application is starting, not per request!
+
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
sort { $a->reverse cmp $b->reverse }
@{ $self->_endpoints }
) {
- my $args = $endpoint->attributes->{Args}->[0];
+ my $args = $endpoint->list_extra_info->{Args};
my @parts = (defined($args) ? (("*") x $args) : '...');
my @parents = ();
my $parent = "DUMMY";
+ my $extra = $self->_list_extra_http_methods($endpoint);
my $curr = $endpoint;
while ($curr) {
- if (my $cap = $curr->attributes->{CaptureArgs}) {
- unshift(@parts, (("*") x $cap->[0]));
+ if (my $cap = $curr->list_extra_info->{CaptureArgs}) {
+ unshift(@parts, (("*") x $cap));
}
if (my $pp = $curr->attributes->{PathPart}) {
unshift(@parts, $pp->[0])
my @rows;
foreach my $p (@parents) {
my $name = "/${p}";
- if (my $cap = $p->attributes->{CaptureArgs}) {
- $name .= ' ('.$cap->[0].')';
+
+ if (defined(my $extra = $self->_list_extra_http_methods($p))) {
+ $name = "${extra} ${name}";
+ }
+ if (defined(my $cap = $p->list_extra_info->{CaptureArgs})) {
+ $name .= ' ('.$cap.')';
}
unless ($p eq $parents[0]) {
$name = "-> ${name}";
}
push(@rows, [ '', $name ]);
}
- push(@rows, [ '', (@rows ? "=> " : '')."/${endpoint}" ]);
+ push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : '')."/${endpoint}" ]);
$rows[0][0] = join('/', '', @parts) || '/';
$paths->row(@$_) for @rows;
}
if $has_unattached_actions;
}
+sub _list_extra_http_methods {
+ my ( $self, $action ) = @_;
+ return unless defined $action->list_extra_info->{HTTP_METHODS};
+ return join(', ', @{$action->list_extra_info->{HTTP_METHODS}});
+}
+
=head2 $self->match( $c, $path )
Calls C<recurse_match> to see if a chain matches the C<$path>.
my @try_actions = @{$children->{$try_part}};
TRY_ACTION: foreach my $action (@try_actions) {
if (my $capture_attr = $action->attributes->{CaptureArgs}) {
+ $capture_attr ||= 0;
# Short-circuit if not enough remaining parts
- next TRY_ACTION unless @parts >= ($capture_attr->[0]||0);
+ next TRY_ACTION unless @parts >= $capture_attr->[0];
my @captures;
my @parts = @parts; # localise
# strip CaptureArgs into list
push(@captures, splice(@parts, 0, $capture_attr->[0]));
+ # check if the action may fit, depending on a given test by the app
+ if ($action->can('match_captures')) { next TRY_ACTION unless $action->match_captures($c, \@captures) }
+
# try the remaining parts against children of this action
my ($actions, $captures, $action_parts, $n_pathparts) = $self->recurse_match(
$c, '/'.$action->reverse, \@parts
if (!$best_action ||
@parts < @{$best_action->{parts}} ||
- (!@parts && $args_attr eq 0)){
+ (!@parts && defined($args_attr) && $args_attr eq "0")){
$best_action = {
actions => [ $action ],
captures=> [],
my $curr = $action;
while ($curr) {
if (my $cap = $curr->attributes->{CaptureArgs}) {
- return undef unless @captures >= $cap->[0]; # not enough captures
+ return undef unless @captures >= ($cap->[0]||0); # not enough captures
if ($cap->[0]) {
unshift(@parts, splice(@captures, -$cap->[0]));
}
If you C<detach> out of a chain, the rest of the chain will not get
called after the C<detach>.
+=head2 match_captures
+
+A method which can optionally be implemented by actions to
+stop chain matching.
+
+See L<Catalyst::Action> for further details.
+
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
use HTTP::Body;
use HTTP::Headers;
use URI::QueryParam;
-use Moose::Util::TypeConstraints;
use Plack::Loader;
use Catalyst::EngineLoader;
use Encode ();
use namespace::clean -except => 'meta';
-has env => (is => 'ro', writer => '_set_env', clearer => '_clear_env');
+# Amount of data to read from input on each pass
+our $CHUNKSIZE = 64 * 1024;
+# XXX - this is only here for compat, do not use!
+has env => ( is => 'rw', writer => '_set_env' );
my $WARN_ABOUT_ENV = 0;
around env => sub {
my ($orig, $self, @args) = @_;
return $self->$orig;
};
-# input position and length
-has read_length => (is => 'rw');
-has read_position => (is => 'rw');
-
-has _prepared_write => (is => 'rw');
-
-has _response_cb => (
- is => 'ro',
- isa => 'CodeRef',
- writer => '_set_response_cb',
- clearer => '_clear_response_cb',
- predicate => '_has_response_cb',
-);
-
-subtype 'Catalyst::Engine::Types::Writer',
- as duck_type([qw(write close)]);
-
-has _writer => (
- is => 'ro',
- isa => 'Catalyst::Engine::Types::Writer',
- writer => '_set_writer',
- clearer => '_clear_writer',
-);
-
-# Amount of data to read from input on each pass
-our $CHUNKSIZE = 64 * 1024;
+# XXX - Only here for Engine::PSGI compat
+sub prepare_connection {
+ my ($self, $ctx) = @_;
+ $ctx->request->prepare_connection;
+}
=head1 NAME
$self->write( $c, $body );
}
- $self->_writer->close;
- $self->_clear_writer;
- $self->_clear_env;
+ my $res = $c->response;
+ $res->_writer->close;
+ $res->_clear_writer;
return;
}
$name = "<h1>$name</h1>";
# Don't show context in the dump
- $c->req->_clear_context;
$c->res->_clear_context;
# Don't show body parser in the dump
=head2 $self->finalize_headers($c)
-Abstract method, allows engines to write headers to response
+Allows engines to write headers to response
=cut
sub finalize_headers {
my ($self, $ctx) = @_;
- # This is a less-than-pretty hack to avoid breaking the old
- # Catalyst::Engine::PSGI. 5.9 Catalyst::Engine sets a response_cb and
- # expects us to pass headers to it here, whereas Catalyst::Enngine::PSGI
- # just pulls the headers out of $ctx->response in its run method and never
- # sets response_cb. So take the lack of a response_cb as a sign that we
- # don't need to set the headers.
-
- return unless $self->_has_response_cb;
-
- my @headers;
- $ctx->response->headers->scan(sub { push @headers, @_ });
-
- $self->_set_writer($self->_response_cb->([ $ctx->response->status, \@headers ]));
- $self->_clear_response_cb;
-
+ $ctx->finalize_headers unless $ctx->response->finalized_headers;
return;
}
-=head2 $self->finalize_read($c)
-
-=cut
-
-sub finalize_read { }
-
=head2 $self->finalize_uploads($c)
Clean up after uploads, deleting temp files.
sub prepare_body {
my ( $self, $c ) = @_;
- my $appclass = ref($c) || $c;
- if ( my $length = $self->read_length ) {
- my $request = $c->request;
- unless ( $request->_body ) {
- my $type = $request->header('Content-Type');
- $request->_body(HTTP::Body->new( $type, $length ));
- $request->_body->cleanup(1); # Make extra sure!
- $request->_body->tmpdir( $appclass->config->{uploadtmp} )
- if exists $appclass->config->{uploadtmp};
- }
-
- # Check for definedness as you could read '0'
- while ( defined ( my $buffer = $self->read($c) ) ) {
- $c->prepare_body_chunk($buffer);
- }
-
- # paranoia against wrong Content-Length header
- my $remaining = $length - $self->read_position;
- if ( $remaining > 0 ) {
- $self->finalize_read($c);
- Catalyst::Exception->throw(
- "Wrong Content-Length value: $length" );
- }
- }
- else {
- # Defined but will cause all body code to be skipped
- $c->request->_body(0);
- }
+ $c->request->prepare_body;
}
=head2 $self->prepare_body_chunk($c)
=cut
+# XXX - Can this be deleted?
sub prepare_body_chunk {
my ( $self, $c, $chunk ) = @_;
- $c->request->_body->add($chunk);
+ $c->request->prepare_body_chunk($chunk);
}
=head2 $self->prepare_body_parameters($c)
sub prepare_body_parameters {
my ( $self, $c ) = @_;
- return unless $c->request->_body;
-
- $c->request->body_parameters( $c->request->_body->param );
-}
-
-=head2 $self->prepare_connection($c)
-
-Abstract method implemented in engines.
-
-=cut
-
-sub prepare_connection {
- my ($self, $ctx) = @_;
-
- my $env = $self->env;
- my $request = $ctx->request;
-
- $request->address( $env->{REMOTE_ADDR} );
- $request->hostname( $env->{REMOTE_HOST} )
- if exists $env->{REMOTE_HOST};
- $request->protocol( $env->{SERVER_PROTOCOL} );
- $request->remote_user( $env->{REMOTE_USER} );
- $request->method( $env->{REQUEST_METHOD} );
- $request->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
-
- return;
-}
-
-=head2 $self->prepare_cookies($c)
-
-Parse cookies from header. Sets a L<CGI::Simple::Cookie> object.
-
-=cut
-
-sub prepare_cookies {
- my ( $self, $c ) = @_;
-
- if ( my $header = $c->request->header('Cookie') ) {
- $c->req->cookies( { CGI::Simple::Cookie->parse($header) } );
- }
-}
-
-=head2 $self->prepare_headers($c)
-
-=cut
-
-sub prepare_headers {
- my ($self, $ctx) = @_;
-
- my $env = $self->env;
- my $headers = $ctx->request->headers;
-
- for my $header (keys %{ $env }) {
- next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
- (my $field = $header) =~ s/^HTTPS?_//;
- $field =~ tr/_/-/;
- $headers->header($field => $env->{$header});
- }
+ $c->request->prepare_body_parameters;
}
=head2 $self->prepare_parameters($c)
-sets up parameters from query and post parameters.
+Sets up parameters from query and post parameters.
+If parameters have already been set up will clear
+existing parameters and set up again.
=cut
sub prepare_parameters {
my ( $self, $c ) = @_;
- my $request = $c->request;
- my $parameters = $request->parameters;
- my $body_parameters = $request->body_parameters;
- my $query_parameters = $request->query_parameters;
- # We copy, no references
- foreach my $name (keys %$query_parameters) {
- my $param = $query_parameters->{$name};
- $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
- }
-
- # Merge query and body parameters
- foreach my $name (keys %$body_parameters) {
- my $param = $body_parameters->{$name};
- my @values = ref $param eq 'ARRAY' ? @$param : ($param);
- if ( my $existing = $parameters->{$name} ) {
- unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
- }
- $parameters->{$name} = @values > 1 ? \@values : $values[0];
- }
+ $c->request->_clear_parameters;
+ return $c->request->parameters;
}
=head2 $self->prepare_path($c)
sub prepare_path {
my ($self, $ctx) = @_;
- my $env = $self->env;
+ my $env = $ctx->request->env;
my $scheme = $ctx->request->secure ? 'https' : 'http';
my $host = $env->{HTTP_HOST} || $env->{SERVER_NAME};
sub prepare_query_parameters {
my ($self, $c) = @_;
- my $query_string = exists $self->env->{QUERY_STRING}
- ? $self->env->{QUERY_STRING}
+ my $env = $c->request->env;
+ my $query_string = exists $env->{QUERY_STRING}
+ ? $env->{QUERY_STRING}
: '';
# Check for keywords (no = signs)
$query{$param} = $value;
}
}
-
$c->request->query_parameters( \%query );
}
=head2 $self->prepare_read($c)
-prepare to read from the engine.
+Prepare to read by initializing the Content-Length from headers.
=cut
sub prepare_read {
my ( $self, $c ) = @_;
- # Initialize the read position
- $self->read_position(0);
-
# Initialize the amount of data we think we need to read
- $self->read_length( $c->request->header('Content-Length') || 0 );
+ $c->request->_read_length;
}
=head2 $self->prepare_request(@arguments)
sub prepare_request {
my ($self, $ctx, %args) = @_;
- $self->_set_env($args{env});
+ $ctx->log->psgienv($args{env}) if $ctx->log->can('psgienv');
+ $ctx->request->_set_env($args{env});
+ $self->_set_env($args{env}); # Nasty back compat!
+ $ctx->response->_set_response_cb($args{response_cb});
}
=head2 $self->prepare_uploads($c)
}
}
-=head2 $self->prepare_write($c)
+=head2 $self->write($c, $buffer)
-Abstract method. Implemented by the engines.
+Writes the buffer to the client.
=cut
-sub prepare_write { }
+sub write {
+ my ( $self, $c, $buffer ) = @_;
+
+ $c->response->write($buffer);
+}
=head2 $self->read($c, [$maxlength])
sub read {
my ( $self, $c, $maxlength ) = @_;
- my $remaining = $self->read_length - $self->read_position;
- $maxlength ||= $CHUNKSIZE;
-
- # Are we done reading?
- if ( $remaining <= 0 ) {
- $self->finalize_read($c);
- return;
- }
-
- my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
- my $rc = $self->read_chunk( $c, my $buffer, $readlen );
- if ( defined $rc ) {
- if (0 == $rc) { # Nothing more to read even though Content-Length
- # said there should be.
- $self->finalize_read;
- return;
- }
- $self->read_position( $self->read_position + $rc );
- return $buffer;
- }
- else {
- Catalyst::Exception->throw(
- message => "Unknown error reading input: $!" );
- }
+ $c->request->read($maxlength);
}
-=head2 $self->read_chunk($c, $buffer, $length)
+=head2 $self->read_chunk($c, \$buffer, $length)
Each engine implements read_chunk as its preferred way of reading a chunk
of data. Returns the number of bytes read. A return of 0 indicates that
sub read_chunk {
my ($self, $ctx) = (shift, shift);
- return $self->env->{'psgi.input'}->read(@_);
+ return $ctx->request->read_chunk(@_);
}
-=head2 $self->read_length
-
-The length of input data to be read. This is obtained from the Content-Length
-header.
-
-=head2 $self->read_position
-
-The amount of input data that has already been read.
-
=head2 $self->run($app, $server)
Start the engine. Builds a PSGI application and calls the
=head2 build_psgi_app ($app, @args)
-Builds and returns a PSGI application closure, wrapping it in the reverse proxy
-middleware if the using_frontend_proxy config setting is set.
+Builds and returns a PSGI application closure. (Raw, not wrapped in middleware)
=cut
return sub {
my ($respond) = @_;
- $self->_set_response_cb($respond);
- $app->handle_request(env => $env);
+ confess("Did not get a response callback for writer, cannot continiue") unless $respond;
+ $app->handle_request(env => $env, response_cb => $respond);
};
};
}
-=head2 $self->write($c, $buffer)
-
-Writes the buffer to the client.
-
-=cut
-
-sub write {
- my ( $self, $c, $buffer ) = @_;
-
- unless ( $self->_prepared_write ) {
- $self->prepare_write($c);
- $self->_prepared_write(1);
- }
-
- $buffer = q[] unless defined $buffer;
-
- my $len = length($buffer);
- $self->_writer->write($buffer);
-
- return $len;
-}
-
=head2 $self->unescape_uri($uri)
Unescapes a given URI using the most efficient method available. Engines such
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
warn("You are loading Catalyst::Engine::HTTP explicitly.
-This is almost certainally a bad idea, as Catalyst::Engine::HTTP
+This is almost certainly a bad idea, as Catalyst::Engine::HTTP
has been removed in this version of Catalyst.
Please update your application's scripts with:
catalyst.pl -force -scripts MyApp
-to update your scripts to not do this.\n");
+to update your scripts to not do this.\n") unless $ENV{HARNESS_ACTIVE};
1;
use Data::Dump;
use Class::MOP ();
+use Carp qw/ cluck /;
our %LEVELS = (); # Levels stored as bit field, ergo debug = 1, warn = 2 etc
our %LEVEL_MATCH = (); # Stored as additive, thus debug = 31, warn = 30 etc
has level => (is => 'rw');
has _body => (is => 'rw');
has abort => (is => 'rw');
+has _psgi_logger => (is => 'rw', predicate => '_has_psgi_logger', clearer => '_clear_psgi_logger');
+has _psgi_errors => (is => 'rw', predicate => '_has_psgi_errors', clearer => '_clear_psgi_errors');
+
+sub clear_psgi {
+ my $self = shift;
+ $self->_clear_psgi_logger;
+ $self->_clear_psgi_errors;
+}
+
+sub psgienv {
+ my ($self, $env) = @_;
+
+ $self->_psgi_logger($env->{'psgix.logger'}) if $env->{'psgix.logger'};
+ $self->_psgi_errors($env->{'psgi.errors'}) if $env->{'psgi.errors'};
+}
+
{
my @levels = qw[ debug info warn error fatal ];
$self->level($level);
}
+our $HAS_DUMPED;
sub _dump {
my $self = shift;
+ unless ($HAS_DUMPED++) {
+ cluck("Catalyst::Log::_dump is deprecated and will be removed. Please change to using your own Dumper.\n");
+ }
$self->info( Data::Dump::dump(@_) );
}
my $self = shift;
my $level = shift;
my $message = join( "\n", @_ );
- $message .= "\n" unless $message =~ /\n$/;
- my $body = $self->_body;
- $body .= sprintf( "[%s] %s", $level, $message );
- $self->_body($body);
+ if ($self->can('_has_psgi_logger') and $self->_has_psgi_logger) {
+ $self->_psgi_logger->({
+ level => $level,
+ message => $message,
+ });
+ } else {
+ $message .= "\n" unless $message =~ /\n$/;
+ my $body = $self->_body;
+ $body .= sprintf( "[%s] %s", $level, $message );
+ $self->_body($body);
+ }
}
sub _flush {
sub _send_to_log {
my $self = shift;
- print STDERR @_;
+ if ($self->can('_has_psgi_errors') and $self->_has_psgi_errors) {
+ $self->_psgi_errors->print(@_);
+ } else {
+ print STDERR @_;
+ }
}
# 5.7 compat code.
You may subclass this module and override this method to get finer control
over the log output.
+=head2 psgienv $env
+
+ $log->psgienv($env);
+
+NOTE: This is not meant for public consumption.
+
+Set the PSGI environment for this request. This ensures logs will be sent to
+the right place. If the environment has a C<psgix.logger>, it will be used. If
+not, we will send logs to C<psgi.errors> if that exists. As a last fallback, we
+will send to STDERR as before.
+
=head2 meta
=head1 SEE ALSO
with 'MooseX::Emulate::Class::Accessor::Fast';
+has env => (is => 'ro', writer => '_set_env');
+# XXX Deprecated crap here - warn?
has action => (is => 'rw');
+# XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
+# to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
+has user => (is => 'rw');
+sub snippets { shift->captures(@_) }
+
+has _read_position => (
+ # FIXME: work around Moose bug RT#75367
+ # init_arg => undef,
+ is => 'ro',
+ writer => '_set_read_position',
+ default => 0,
+);
+has _read_length => (
+ # FIXME: work around Moose bug RT#75367
+ # init_arg => undef,
+ is => 'ro',
+ default => sub {
+ my $self = shift;
+ $self->header('Content-Length') || 0;
+ },
+ lazy => 1,
+);
+
has address => (is => 'rw');
has arguments => (is => 'rw', default => sub { [] });
-has cookies => (is => 'rw', default => sub { {} });
+has cookies => (is => 'ro', builder => 'prepare_cookies', lazy => 1);
+
+sub prepare_cookies {
+ my ( $self ) = @_;
+
+ if ( my $header = $self->header('Cookie') ) {
+ return { CGI::Simple::Cookie->parse($header) };
+ }
+ {};
+}
+
has query_keywords => (is => 'rw');
has match => (is => 'rw');
has method => (is => 'rw');
is => 'rw',
isa => 'HTTP::Headers',
handles => [qw(content_encoding content_length content_type header referer user_agent)],
- default => sub { HTTP::Headers->new() },
- required => 1,
+ builder => 'prepare_headers',
lazy => 1,
);
-has _context => (
- is => 'rw',
- weak_ref => 1,
- handles => ['read'],
- clearer => '_clear_context',
+sub prepare_headers {
+ my ($self) = @_;
+
+ my $env = $self->env;
+ my $headers = HTTP::Headers->new();
+
+ for my $header (keys %{ $env }) {
+ next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
+ (my $field = $header) =~ s/^HTTPS?_//;
+ $field =~ tr/_/-/;
+ $headers->header($field => $env->{$header});
+ }
+ return $headers;
+}
+
+has _log => (
+ is => 'ro',
+ weak_ref => 1,
+ required => 1,
);
+# Amount of data to read from input on each pass
+our $CHUNKSIZE = 64 * 1024;
+
+sub read {
+ my ($self, $maxlength) = @_;
+ my $remaining = $self->_read_length - $self->_read_position;
+ $maxlength ||= $CHUNKSIZE;
+
+ # Are we done reading?
+ if ( $remaining <= 0 ) {
+ return;
+ }
+
+ my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
+ my $rc = $self->read_chunk( my $buffer, $readlen );
+ if ( defined $rc ) {
+ if (0 == $rc) { # Nothing more to read even though Content-Length
+ # said there should be.
+ return;
+ }
+ $self->_set_read_position( $self->_read_position + $rc );
+ return $buffer;
+ }
+ else {
+ Catalyst::Exception->throw(
+ message => "Unknown error reading input: $!" );
+ }
+}
+
+sub read_chunk {
+ my $self = shift;
+ return $self->env->{'psgi.input'}->read(@_);
+}
+
has body_parameters => (
is => 'rw',
required => 1,
lazy => 1,
- default => sub { {} },
+ builder => 'prepare_body_parameters',
);
has uploads => (
);
has parameters => (
- is => 'rw',
- required => 1,
- lazy => 1,
- default => sub { {} },
+ is => 'rw',
+ lazy => 1,
+ builder => '_build_parameters',
+ clearer => '_clear_parameters',
);
# TODO:
# these lazy build from there and kill all the direct hash access
# in Catalyst.pm and Engine.pm?
-before $_ => sub {
+sub prepare_parameters {
+ my ( $self ) = @_;
+ $self->_clear_parameters;
+ return $self->parameters;
+}
+
+
+
+sub _build_parameters {
+ my ( $self ) = @_;
+ my $parameters = {};
+ my $body_parameters = $self->body_parameters;
+ my $query_parameters = $self->query_parameters;
+ # We copy, no references
+ foreach my $name (keys %$query_parameters) {
+ my $param = $query_parameters->{$name};
+ $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
+ }
+
+ # Merge query and body parameters
+ foreach my $name (keys %$body_parameters) {
+ my $param = $body_parameters->{$name};
+ my @values = ref $param eq 'ARRAY' ? @$param : ($param);
+ if ( my $existing = $parameters->{$name} ) {
+ unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
+ }
+ $parameters->{$name} = @values > 1 ? \@values : $values[0];
+ }
+ $parameters;
+}
+
+has _uploadtmp => (
+ is => 'ro',
+ predicate => '_has_uploadtmp',
+);
+
+sub prepare_body {
+ my ( $self ) = @_;
+
+ if ( my $length = $self->_read_length ) {
+ unless ( $self->_body ) {
+ my $type = $self->header('Content-Type');
+ $self->_body(HTTP::Body->new( $type, $length ));
+ $self->_body->cleanup(1); # Make extra sure!
+ $self->_body->tmpdir( $self->_uploadtmp )
+ if $self->_has_uploadtmp;
+ }
+
+ # Check for definedness as you could read '0'
+ while ( defined ( my $buffer = $self->read() ) ) {
+ $self->prepare_body_chunk($buffer);
+ }
+
+ # paranoia against wrong Content-Length header
+ my $remaining = $length - $self->_read_position;
+ if ( $remaining > 0 ) {
+ Catalyst::Exception->throw(
+ "Wrong Content-Length value: $length" );
+ }
+ }
+ else {
+ # Defined but will cause all body code to be skipped
+ $self->_body(0);
+ }
+}
+
+sub prepare_body_chunk {
+ my ( $self, $chunk ) = @_;
+
+ $self->_body->add($chunk);
+}
+
+sub prepare_body_parameters {
+ my ( $self ) = @_;
+
+ $self->prepare_body if ! $self->_has_body;
+ return {} unless $self->_body;
+
+ return $self->_body->param;
+}
+
+sub prepare_connection {
my ($self) = @_;
- my $context = $self->_context || return;
- $context->prepare_body;
-} for qw/parameters body_parameters/;
+ my $env = $self->env;
+
+ $self->address( $env->{REMOTE_ADDR} );
+ $self->hostname( $env->{REMOTE_HOST} )
+ if exists $env->{REMOTE_HOST};
+ $self->protocol( $env->{SERVER_PROTOCOL} );
+ $self->remote_user( $env->{REMOTE_USER} );
+ $self->method( $env->{REQUEST_METHOD} );
+ $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
+}
+
+# XXX - FIXME - method is here now, move this crap...
around parameters => sub {
my ($orig, $self, $params) = @_;
if ($params) {
if ( !ref $params ) {
- $self->_context->log->warn(
+ $self->_log->warn(
"Attempt to retrieve '$params' with req->params(), " .
"you probably meant to call req->param('$params')"
);
# and provide a custom reader..
sub body {
my $self = shift;
- $self->_context->prepare_body();
+ $self->prepare_body unless ! $self->_has_body;
croak 'body is a reader' if scalar @_;
return blessed $self->_body ? $self->_body->body : $self->_body;
}
has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
-# XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
-# to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
-has user => (is => 'rw');
-
sub args { shift->arguments(@_) }
sub body_params { shift->body_parameters(@_) }
sub input { shift->body(@_) }
sub params { shift->parameters(@_) }
sub query_params { shift->query_parameters(@_) }
sub path_info { shift->path(@_) }
-sub snippets { shift->captures(@_) }
=for stopwords param params
=head1 SYNOPSIS
$req = $c->request;
- $req->action;
- $req->address;
+ $req->address eq "127.0.0.1";
$req->arguments;
$req->args;
$req->base;
$req->read;
$req->referer;
$req->secure;
- $req->captures; # previously knows as snippets
+ $req->captures;
$req->upload;
$req->uploads;
$req->uri;
=head1 METHODS
-=head2 $req->action
-
-[DEPRECATED] Returns the name of the requested action.
-
-
-Use C<< $c->action >> instead (which returns a
-L<Catalyst::Action|Catalyst::Action> object).
-
=head2 $req->address
Returns the IP address of the client.
used in a while loop, reading $maxlength bytes on every call. $maxlength
defaults to the size of the request if not specified.
+=head2 $req->read_chunk(\$buff, $max)
+
+Reads a chunk..
+
You have to set MyApp->config(parse_on_demand => 1) to use this directly.
=head2 $req->referer
Returns true or false, indicating whether the connection is secure
(https). Note that the URI scheme (e.g., http vs. https) must be determined
through heuristics, and therefore the reliability of $req->secure will depend
-on your server configuration. If you are serving secure pages on the standard
-SSL port (443) and/or setting the HTTPS environment variable, $req->secure
-should be valid.
+on your server configuration. If you are setting the HTTPS environment variable,
+$req->secure should be valid.
=head2 $req->captures
my @captures = @{ $c->request->captures };
-=head2 $req->snippets
-
-C<captures> used to be called snippets. This is still available for backwards
-compatibility, but is considered deprecated.
-
=head2 $req->upload
A convenient method to access $req->uploads.
Shortcut to $req->headers->user_agent. Returns the user agent (browser)
version string.
+=head1 SETUP METHODS
+
+You should never need to call these yourself in application code,
+however they are useful if extending Catalyst by applying a request role.
+
+=head2 $self->prepare_headers()
+
+Sets up the C<< $res->headers >> accessor.
+
+=head2 $self->prepare_body()
+
+Sets up the body using L<HTTP::Body>
+
+=head2 $self->prepare_body_chunk()
+
+Add a chunk to the request body.
+
+=head2 $self->prepare_body_parameters()
+
+Sets up parameters from body.
+
+=head2 $self->prepare_cookies()
+
+Parse cookies from header. Sets up a L<CGI::Simple::Cookie> object.
+
+=head2 $self->prepare_connection()
+
+Sets up various fields in the request like the local and remote addresses,
+request method, hostname requested etc.
+
+=head2 $self->prepare_parameters()
+
+Ensures that the body has been parsed, then builds the parameters, which are
+combined from those in the request and those in the body.
+
+If parameters have already been set will clear the parameters and build them again.
+
+
=head2 meta
Provided by Moose
use Moose;
use HTTP::Headers;
+use Moose::Util::TypeConstraints;
+use namespace::autoclean;
with 'MooseX::Emulate::Class::Accessor::Fast';
+has _response_cb => (
+ is => 'ro',
+ isa => 'CodeRef',
+ writer => '_set_response_cb',
+ clearer => '_clear_response_cb',
+ predicate => '_has_response_cb',
+);
+
+subtype 'Catalyst::Engine::Types::Writer',
+ as duck_type([qw(write close)]);
+
+has _writer => (
+ is => 'ro',
+ isa => 'Catalyst::Engine::Types::Writer',
+ writer => '_set_writer',
+ clearer => '_clear_writer',
+ predicate => '_has_writer',
+);
+
+sub DEMOLISH { $_[0]->_writer->close if $_[0]->_has_writer }
+
has cookies => (is => 'rw', default => sub { {} });
has body => (is => 'rw', default => undef);
sub has_body { defined($_[0]->body) }
has _context => (
is => 'rw',
weak_ref => 1,
- handles => ['write'],
clearer => '_clear_context',
);
sub code { shift->status(@_) }
-no Moose;
+sub write {
+ my ( $self, $buffer ) = @_;
+
+ # Finalize headers if someone manually writes output
+ $self->_context->finalize_headers unless $self->finalized_headers;
+
+ $buffer = q[] unless defined $buffer;
+
+ my $len = length($buffer);
+ $self->_writer->write($buffer);
+
+ return $len;
+}
+
+sub finalize_headers {
+ my ($self) = @_;
+
+ # This is a less-than-pretty hack to avoid breaking the old
+ # Catalyst::Engine::PSGI. 5.9 Catalyst::Engine sets a response_cb and
+ # expects us to pass headers to it here, whereas Catalyst::Enngine::PSGI
+ # just pulls the headers out of $ctx->response in its run method and never
+ # sets response_cb. So take the lack of a response_cb as a sign that we
+ # don't need to set the headers.
+
+ return unless $self->_has_response_cb;
+
+ # If we already have a writer, we already did this, so don't do it again
+ return if $self->_has_writer;
+
+ my @headers;
+ $self->headers->scan(sub { push @headers, @_ });
+
+ my $writer = $self->_response_cb->([ $self->status, \@headers ]);
+ $self->_set_writer($writer);
+ $self->_clear_response_cb;
+
+ return;
+}
=head1 NAME
Writes $data to the output stream.
-=head2 meta
-
-Provided by Moose
-
=head2 $res->print( @data )
Prints @data to the output stream, separated by $,. This lets you pass
the response object to functions that want to write to an L<IO::Handle>.
+=head2 $self->finalize_headers($c)
+
+Writes headers to response if not already written
+
+=head2 DEMOLISH
+
+Ensures that the response is flushed and closed at the end of the
+request.
+
+=head2 meta
+
+Provided by Moose
+
=cut
sub print {
use strict;
use warnings;
-BEGIN { require 5.008004; }
+BEGIN { require 5.008003; }
# Remember to update this in Catalyst as well!
-our $VERSION = '5.90006';
+our $VERSION = '5.90020';
=head1 NAME
package Catalyst::Script::Create;
use Moose;
-use MooseX::Types::Moose qw/Bool Str/;
use namespace::autoclean;
with 'Catalyst::ScriptRole';
has force => (
traits => [qw(Getopt)],
cmd_aliases => 'nonew',
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
documentation => 'Force new scripts',
);
has debug => (
traits => [qw(Getopt)],
cmd_aliases => 'd',
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
documentation => 'Force debug mode',
);
has mechanize => (
traits => [qw(Getopt)],
cmd_aliases => 'mech',
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
documentation => 'use WWW::Mechanize',
);
has helper_class => (
- isa => Str,
+ isa => 'Str',
is => 'ro',
builder => '_build_helper_class',
);
sub run {
my ($self) = @_;
- $self->_getopt_full_usage if !$self->ARGV->[0];
+ $self->print_usage_text if !$self->ARGV->[0];
my $helper_class = $self->helper_class;
Class::MOP::load_class($helper_class);
my $helper = $helper_class->new( { '.newfiles' => !$self->force, mech => $self->mechanize } );
- $self->_getopt_full_usage unless $helper->mk_component( $self->application_name, @{$self->extra_argv} );
+ $self->print_usage_text unless $helper->mk_component( $self->application_name, @{$self->extra_argv} );
}
package Catalyst::Script::FastCGI;
use Moose;
-use MooseX::Types::Moose qw/Str Bool Int/;
use Data::OptList;
use namespace::autoclean;
has listen => (
traits => [qw(Getopt)],
cmd_aliases => 'l',
- isa => Str,
+ isa => 'Str',
is => 'ro',
documentation => 'Specify a listening port/socket',
);
has pidfile => (
traits => [qw(Getopt)],
cmd_aliases => [qw/pid p/],
- isa => Str,
+ isa => 'Str',
is => 'ro',
documentation => 'Specify a pidfile',
);
has daemon => (
traits => [qw(Getopt)],
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
cmd_aliases => [qw/d detach/], # Eww, detach is here as we fucked it up.. Deliberately not documented
documentation => 'Daemonize (go into the background)',
has manager => (
traits => [qw(Getopt)],
- isa => Str,
+ isa => 'Str',
is => 'ro',
cmd_aliases => 'M',
documentation => 'Use a different FastCGI process manager class',
has keeperr => (
traits => [qw(Getopt)],
cmd_aliases => 'e',
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
documentation => 'Log STDERR',
);
has nproc => (
traits => [qw(Getopt)],
cmd_aliases => 'n',
- isa => Int,
+ isa => 'Int',
is => 'ro',
documentation => 'Specify a number of child processes',
);
has proc_title => (
traits => [qw(Getopt)],
- isa => Str,
+ isa => 'Str',
is => 'ro',
lazy => 1,
builder => '_build_proc_title',
package Catalyst::Script::Server;
use Moose;
-use MooseX::Types::Common::Numeric qw/PositiveInt/;
-use MooseX::Types::Moose qw/ArrayRef Str Bool Int RegexpRef/;
use Catalyst::Utils;
use Try::Tiny;
use namespace::autoclean;
has debug => (
traits => [qw(Getopt)],
cmd_aliases => 'd',
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
documentation => q{Force debug mode},
);
has host => (
traits => [qw(Getopt)],
cmd_aliases => 'h',
- isa => Str,
+ isa => 'Str',
is => 'ro',
# N.B. undef (the default) means we bind on all interfaces on the host.
documentation => 'Specify a hostname or IP on this host for the server to bind to',
has fork => (
traits => [qw(Getopt)],
cmd_aliases => 'f',
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
default => 0,
documentation => 'Fork the server to be able to serve multiple requests at once',
has port => (
traits => [qw(Getopt)],
cmd_aliases => 'p',
- isa => PositiveInt,
+ isa => 'Int',
is => 'ro',
default => sub {
Catalyst::Utils::env_value(shift->application_name, 'port') || 3000
subtype 'Catalyst::Script::Server::Types::Pidfile',
as 'MooseX::Daemonize::Pid::File';
-coerce 'Catalyst::Script::Server::Types::Pidfile', from Str, via {
+coerce 'Catalyst::Script::Server::Types::Pidfile', from 'Str', via {
try { Class::MOP::load_class("MooseX::Daemonize::Pid::File") }
catch {
warn("Could not load MooseX::Daemonize::Pid::File, needed for --pid option\n");
predicate => '_has_pidfile',
);
+# Override MooseX::Daemonize
+sub dont_close_all_files { 1 }
sub BUILD {
my $self = shift;
if ($self->background) {
# FIXME - This is evil. Should we just add MX::Daemonize to the deps?
- try { Class::MOP::load_class('MooseX::Daemonize::Core') }
+ try { Class::MOP::load_class('MooseX::Daemonize::Core'); Class::MOP::load_class('POSIX') }
catch {
warn("MooseX::Daemonize is needed for the --background option\n");
exit 1;
};
MooseX::Daemonize::Core->meta->apply($self);
+ POSIX::close($_) foreach (0..2);
}
}
has keepalive => (
traits => [qw(Getopt)],
cmd_aliases => 'k',
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
default => 0,
documentation => 'Support keepalive',
has background => (
traits => [qw(Getopt)],
cmd_aliases => 'bg',
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
default => 0,
documentation => 'Run in the background',
has restart => (
traits => [qw(Getopt)],
cmd_aliases => 'r',
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
default => sub {
Catalyst::Utils::env_value(shift->application_name, 'reload') || 0;
has restart_directory => (
traits => [qw(Getopt)],
cmd_aliases => [ 'rdir', 'restartdirectory' ],
- isa => ArrayRef[Str],
+ isa => 'ArrayRef[Str]',
is => 'ro',
documentation => 'Restarter directory to watch',
predicate => '_has_restart_directory',
has restart_delay => (
traits => [qw(Getopt)],
cmd_aliases => 'rd',
- isa => Int,
+ isa => 'Int',
is => 'ro',
documentation => 'Set a restart delay',
predicate => '_has_restart_delay',
{
use Moose::Util::TypeConstraints;
- my $tc = subtype 'Catalyst::Script::Server::Types::RegexpRef', as RegexpRef;
- coerce $tc, from Str, via { qr/$_/ };
+ my $tc = subtype 'Catalyst::Script::Server::Types::RegexpRef', as 'RegexpRef';
+ coerce $tc, from 'Str', via { qr/$_/ };
MooseX::Getopt::OptionTypeMap->add_option_type_to_map($tc => '=s');
has follow_symlinks => (
traits => [qw(Getopt)],
cmd_aliases => 'sym',
- isa => Bool,
+ isa => 'Bool',
is => 'ro',
default => 0,
documentation => 'Follow symbolic links',
has restarter_class => (
is => 'ro',
- isa => Str,
+ isa => 'Str',
lazy => 1,
default => sub {
my $self = shift;
package Catalyst::ScriptRole;
use Moose::Role;
-use MooseX::Types::Moose qw/Str Bool/;
use Pod::Usage;
use MooseX::Getopt;
use Catalyst::EngineLoader;
-use MooseX::Types::LoadableClass qw/LoadableClass/;
+use Moose::Util::TypeConstraints;
+use Catalyst::Utils qw/ ensure_class_loaded /;
use namespace::autoclean;
+subtype 'Catalyst::ScriptRole::LoadableClass',
+ as 'ClassName';
+coerce 'Catalyst::ScriptRole::LoadableClass',
+ from 'Str',
+ via { ensure_class_loaded($_); 1 };
+
with 'MooseX::Getopt' => {
+ -version => 0.48,
-excludes => [qw/
_getopt_spec_warnings
_getopt_spec_exception
- _getopt_full_usage
+ print_usage_text
/],
};
has application_name => (
traits => ['NoGetopt'],
- isa => Str,
+ isa => 'Str',
is => 'ro',
required => 1,
);
has loader_class => (
- isa => LoadableClass,
+ isa => 'Catalyst::ScriptRole::LoadableClass',
is => 'ro',
coerce => 1,
default => 'Catalyst::EngineLoader',
warn @_;
}
-sub _getopt_full_usage {
+sub print_usage_text {
my $self = shift;
pod2usage();
exit 0;
The method invoked to run the application.
+=head2 print_usage_text
+
+Prints out the usage text for the script you tried to invoke.
+
=head1 ATTRIBUTES
=head2 application_name
use lib;
use File::Spec;
use Class::Load qw/ load_first_existing_class load_optional_class /;
+use Catalyst::Utils;
use namespace::autoclean -also => 'subclass_with_traits';
use Try::Tiny;
sub run {
my ($self, $appclass, $scriptclass) = @_;
- lib->import(File::Spec->catdir($FindBin::Bin, '..', 'lib'));
+ if (grep { -f File::Spec->catfile($FindBin::Bin, '..', $_) } Catalyst::Utils::dist_indicator_file_list()) {
+ lib->import(File::Spec->catdir($FindBin::Bin, '..', 'lib'));
+ }
my $class = $self->find_script_class($appclass, $scriptclass);
# HTML head parsing based on LWP::UserAgent
#
+ # This is because if you make a remote request with LWP, then the
+ # <BASE HREF="..."> from the returned HTML document will be used
+ # to fill in $res->base, as documented in HTTP::Response. We need
+ # to support this in local test requests so that they work 'the same'.
+ #
# This is not just horrible and possibly broken, but also really
# doesn't belong here. Whoever wants this should be working on
# getting it into Plack::Test, or make a middleware out of it, or
# whatever. Seriously - horrible.
- require HTML::HeadParser;
+ if (!$resp->content_type || $resp->content_is_html) {
+ require HTML::HeadParser;
- my $parser = HTML::HeadParser->new();
- $parser->xml_mode(1) if $resp->content_is_xhtml;
- $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40;
+ my $parser = HTML::HeadParser->new();
+ $parser->xml_mode(1) if $resp->content_is_xhtml;
+ $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40;
- $parser->parse( $resp->content );
- my $h = $parser->header;
- for my $f ( $h->header_field_names ) {
- $resp->init_header( $f, [ $h->header($f) ] );
+ $parser->parse( $resp->content );
+ my $h = $parser->header;
+ for my $f ( $h->header_field_names ) {
+ $resp->init_header( $f, [ $h->header($f) ] );
+ }
}
# Another horrible hack to make the response headers have a
# 'status' field. This is for back-compat, but you should
COMPONENT method you would like to inherit is the first (left-hand most)
COMPONENT method in your @ISA.
+=head2 Development server relying on environment variables
+
+Previously, the development server would allow propagation of system
+environment variables into the request environment, this has changed with the
+adoption of Plack. You can use L<Plack::Middleware::ForceEnv> to achieve the
+same effect.
+
=head1 WARNINGS
=head2 Actions in your application class
Returns home directory for given class.
+=head2 dist_indicator_file_list
+
+Returns a list of files which can be tested to check if you're inside
+a CPAN distribution which is not yet installed.
+
+These are:
+
+=over
+
+=item Makefile.PL
+
+=item Build.PL
+
+=item dist.ini
+
+=item L<cpanfile>
+
+=back
+
=cut
+sub dist_indicator_file_list {
+ qw{Makefile.PL Build.PL dist.ini cpanfile};
+}
+
sub home {
my $class = shift;
$home = $home->parent while $home =~ /b?lib$/;
# only return the dir if it has a Makefile.PL or Build.PL or dist.ini
- if (-f $home->file("Makefile.PL") or -f $home->file("Build.PL")
- or -f $home->file("dist.ini")) {
-
+ if (grep { -f $home->file($_) } dist_indicator_file_list()) {
# clean up relative path:
# MyApp/script/.. -> MyApp
is_deeply $action->attributes->{extra_attribute}, [13];
is_deeply $action->attributes->{another_extra_attribute}, ['foo'];
}
+ {
+ ok( my $response = request('http://localhost/action_action_nine'),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'),
+ 'action_action_nine', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Action::Action',
+ 'Test Class'
+ );
+ is( $response->header('X-TestExtraArgsAction'), '42,13', 'Extra args get passed to action constructor' );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ }
}
done_testing;
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
use Test::More;
+use URI;
+use URI::QueryParam;
use Catalyst::Test 'TestApp';
if ( $ENV{CAT_BENCHMARK} ) {
ok( my $content =
get('http://localhost/' . $path),
'request ' . $path . ' ok');
+ my $exp = URI->new('http://localhost:3000' . $path);
+ my ($want) = $content =~ m{/chained/(.*)};
+ my $got = URI->new('http://localhost:3000/chained/' . $want);
# Just check that the path matches, as who the hell knows or cares
# where the app is based (live tests etc)
- ok( index($content, $path) > 1, 'uri can round trip through uri_for' )
+ is $got->path, $exp->path, "uri $path can round trip through uri_for (path)"
or diag("Expected $path, got $content");
+ is_deeply $got->query_form_hash, $exp->query_form_hash, "uri $path can round trip through uri_for (query)"
+ or diag("Expected $path, got $content");
+ }
+
+ #
+ # match_captures
+ #
+ {
+
+ ok( my $response = request('http://localhost/chained/match_captures/foo/bar'), 'match_captures: falling through' );
+ is($response->header('X-TestAppActionTestMatchCaptures'), 'fallthrough', 'match_captures: fell through');
+
+ ok($response = request('http://localhost/chained/match_captures/force/bar'), 'match_captures: *not* falling through' );
+ is($response->header('X-TestAppActionTestMatchCaptures'), 'forcing', 'match_captures: forced');
+ is($response->header('X-TestAppActionTestMatchCapturesHasRan'), 'yes', 'match_captures: actually ran');
}
}
content_like('/account/123', qr/This is account 123/, '/account/123');
content_like('/account/profile/007/James Bond', qr/This is profile of James Bond/, 'account');
-TODO: {
- local $TODO = q(new chained action test case that fails yet.);
- content_like('/downloads/', qr/This is downloads index/, 'downloads');
-}
+content_like('/downloads/', qr/This is download index/, 'downloads');
action_notfound('/c');
ok(
eval '$creq = ' . $response->content,
'Unserialize Catalyst::Request'
- );
+ ) or fail("EXCEPTION $@ DESERIALIZING " . $response->content);
is_deeply( $creq->{arguments}, $expected, 'Arguments ok' );
}
'TestApp::Controller::Action::Local',
'Test Class'
);
- like(
- $response->content,
- qr~arguments => \[\s*'foo/bar'\s*\]~,
- "Parameters don't split on %2F"
- );
+ my $content = $response->content;
+ {
+ local $@;
+ my $request = eval $content;
+ if ($@) {
+ fail("Content cannot be unserialized: $@ $content");
+ }
+ else {
+ is_deeply $request->arguments, ['foo/bar'], "Parameters don't split on %2F";
+ }
+ }
}
{
ok( my $response = request('http://localhost/streaming'), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' );
+ is( $response->header('X-Test-Header-Call-Count'), 1);
SKIP:
{
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
is( $response->content_length, -s $file, 'Response Content-Length' );
+ is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' );
+ is( $response->header('X-Test-Header-Call-Count'), 1);
is( $response->content, $buffer, 'Content is read from filehandle' );
ok( $response = request('http://localhost/action/streaming/body_glob'),
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
is( $response->content_length, -s $file, 'Response Content-Length' );
+ is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' );
+ is( $response->header('X-Test-Header-Call-Count'), 1);
is( $response->content, $buffer, 'Content is read from filehandle' );
}
ok( my $response = request('http://localhost/action/streaming/body_large'), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' );
+ is( $response->header('X-Test-Header-Call-Count'), 1);
is( $response->content_length, $size, 'Response Content-Length' );
is( $response->content, "\0" x $size, 'Content is read from filehandle' );
}
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Catalyst::Test 'TestApp';
+
+my %roles = (
+ foo => 'TestApp::ActionRole::Moo',
+ bar => 'TestApp::ActionRole::Moo',
+ baz => 'Moo',
+ quux => 'Catalyst::ActionRole::Zoo',
+);
+
+while (my ($path, $role) = each %roles) {
+ my $resp = request("/actionroles/${path}");
+ ok($resp->is_success);
+ is($resp->content, $role);
+ is($resp->header('X-Affe'), 'Tiger');
+}
+
+{
+ my $resp = request("/actionroles/corge");
+ ok($resp->is_success);
+ is($resp->content, 'TestApp::ActionRole::Moo');
+ is($resp->header('X-Affe'), 'Tiger');
+ is($resp->header('X-Action-After'), 'moo');
+}
+{
+ my $resp = request("/actionroles/frew");
+ ok($resp->is_success);
+ is($resp->content, 'hello', 'action_args are honored with ActionRoles');
+ }
+done_testing;
use strict;
use warnings;
+use Data::Dumper;
+$Data::Dumper::Maxdepth=1;
use FindBin;
use lib "$FindBin::Bin/../lib";
-use Test::More tests => 4;
+use Test::More tests => 13;
use Catalyst::Test 'TestApp';
+sub ok_actions {
+ my ($response, $actions, $msg) = @_;
+ my $expected = join ", ",
+ (map { "TestApp::Controller::Attributes->$_" } @$actions),
+ 'TestApp::Controller::Root->end';
+ is( $response->header('x-catalyst-executed') => $expected,
+ $msg || 'Executed correct acitons');
+ }
+
ok( my $response = request('http://localhost/attributes/view'),
'get /attributes/view' );
ok( !$response->is_success, 'Response Unsuccessful' );
ok( $response = request('http://localhost/attributes/foo'),
"get /attributes/foo" );
+ok_actions($response => ['foo']);
+
+ok( $response = request('http://localhost/attributes/all_attrs'),
+ "get /attributes/all_attrs" );
+ok( $response->is_success, "Response OK" );
+ok_actions($response => [qw/fetch all_attrs_action/]);
+ok( $response = request('http://localhost/attributes/some_attrs'),
+ "get /attributes/some_attrs" );
ok( $response->is_success, "Response OK" );
+ok_actions($response => [qw/fetch some_attrs_action/]);
+
+ok( $response = request('http://localhost/attributes/one_attr'),
+ "get /attributes/one_attr" );
+ok( $response->is_success, "Response OK" );
+ok_actions($response => [qw/fetch one_attr_action/]);
+
+
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+use HTTP::Request::Common qw/GET POST DELETE PUT /;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Catalyst::Test 'TestApp';
+
+is(request(GET '/httpmethods/foo')->content, 'get');
+is(request(POST '/httpmethods/foo')->content, 'post');
+is(request(DELETE '/httpmethods/foo')->content, 'default');
+
+is(request(GET '/httpmethods/bar')->content, 'get or post');
+is(request(POST '/httpmethods/bar')->content, 'get or post');
+is(request(DELETE '/httpmethods/bar')->content, 'default');
+
+is(request(GET '/httpmethods/baz')->content, 'any');
+is(request(POST '/httpmethods/baz')->content, 'any');
+is(request(DELETE '/httpmethods/baz')->content, 'any');
+
+is(request(GET '/httpmethods/chained_get')->content, 'chained_get');
+is(request(POST '/httpmethods/chained_post')->content, 'chained_post');
+is(request(PUT '/httpmethods/chained_put')->content, 'chained_put');
+is(request(DELETE '/httpmethods/chained_delete')->content, 'chained_delete');
+
+is(request(GET '/httpmethods/get_put_post_delete')->content, 'get2');
+is(request(POST '/httpmethods/get_put_post_delete')->content, 'post2');
+is(request(PUT '/httpmethods/get_put_post_delete')->content, 'put2');
+is(request(DELETE '/httpmethods/get_put_post_delete')->content, 'delete2');
+
+is(request(GET '/httpmethods/check_default')->content, 'get3');
+is(request(POST '/httpmethods/check_default')->content, 'post3');
+is(request(PUT '/httpmethods/check_default')->content, 'chain_default');
+
+done_testing;
ok( my $response = request($request), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
-
{
no strict 'refs';
ok(
$EXPECTED_ENV_VAL = "Test env value " . rand(100000);
}
-use Test::More tests => 7;
+use Test::More;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
use HTTP::Headers;
use HTTP::Request::Common;
-{
- my $response = request("http://localhost/dump/env", {
+foreach my $path (qw/ env env_on_engine /) {
+ my $response = request("http://localhost/dump/${path}", {
extra_env => { $EXPECTED_ENV_VAR => $EXPECTED_ENV_VAL },
});
my $env;
ok( eval '$env = ' . $response->content, 'Unserialize Catalyst::Request' );
is ref($env), 'HASH';
- ok exists($env->{PATH_INFO}), 'Have a PATH_INFO env var';
+ ok exists($env->{PATH_INFO}), 'Have a PATH_INFO env var for ' . $path;
SKIP:
{
skip 'Using remote server', 1;
}
is $env->{$EXPECTED_ENV_VAR}, $EXPECTED_ENV_VAL,
- 'Value we set as expected';
+ 'Value we set as expected for ' . $path;
}
}
+done_testing;
+
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' );
- ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ) or fail("Exception deseializing $@ from content " . $response->content);
isa_ok( $creq, 'Catalyst::Request' );
ok( $creq->secure, 'Forwarded port sets secure' );
isa_ok( $creq->headers, 'HTTP::Headers', 'Catalyst::Request->headers' );
use FindBin;
use lib "$FindBin::Bin/../lib";
-use Test::More tests => 53;
+use Test::More tests => 54;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
'Content is a serialized Catalyst::Request'
);
ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
- isa_ok( $creq, 'Catalyst::Request' );
+ isa_ok( $creq, 'Catalyst::Request' )
+ or fail("EXCEPTION: $@");
is( $creq->method, 'GET', 'Catalyst::Request method' );
is_deeply( $creq->parameters, $parameters,
'Catalyst::Request parameters' );
}
-
{
my $creq;
ok( my $response = request("http://localhost/dump/request?q=foo%2bbar"),
'Content-Type' => 'application/x-www-form-urlencoded'
);
- unshift( @{ $parameters->{a} }, 1, 2, 3 );
-
ok( my $response = request($request), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
isa_ok( $creq, 'Catalyst::Request' );
is( $creq->method, 'POST', 'Catalyst::Request method' );
+ is_deeply( $creq->body_parameters, $parameters,
+ 'Catalyst::Request body_parameters' );
+ unshift( @{ $parameters->{a} }, 1, 2, 3 );
is_deeply( $creq->parameters, $parameters,
'Catalyst::Request parameters' );
is_deeply( $creq->arguments, [qw(a b)], 'Catalyst::Request arguments' );
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Test::More tests => 8;
+use Catalyst::Test 'TestApp';
+
+use Catalyst::Request;
+use HTTP::Headers;
+use HTTP::Request::Common;
+
+{
+ my $creq;
+
+ my $parameters = { 'a' => [qw(A b C d E f G)], };
+
+ my $query = join( '&', map { 'a=' . $_ } @{ $parameters->{a} } );
+
+ ok( my $response = request("http://localhost/dump/prepare_parameters?$query"),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ isa_ok( $creq, 'Catalyst::Request' );
+ is( $creq->method, 'GET', 'Catalyst::Request method' );
+ is_deeply( $creq->parameters, $parameters,
+ 'Catalyst::Request parameters' );
+}
+
+
ok(
eval '$creq = ' . $response->content,
'Unserialize Catalyst::Request'
- );
+ )
+ or fail("Failed to deserialize $@ from " . $response->content);
}
isa_ok( $creq, 'Catalyst::Request' );
use Test::More tests => 105;
use Catalyst::Test 'TestApp';
-
+use Scalar::Util qw/ blessed /;
use Catalyst::Request;
use Catalyst::Request::Upload;
use HTTP::Body::OctetStream;
ok( my $response = request($request), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
- like( $response->content, qr/file1 => bless/, 'Upload with name file1');
- like( $response->content, qr/file2 => bless/, 'Upload with name file2');
-
+ {
+ local $@;
+ my $request = eval $response->content;
+ if ($@) {
+ fail("Could not inflate response: $@ " . $response->content);
+ }
+ else {
+ ok blessed($request->uploads->{file1}), 'Upload with name file1';
+ ok blessed($request->uploads->{file2}),'Upload with name file2';
+ }
+ }
my $creq;
{
no strict 'refs';
{
ok( my $response = request('http://localhost/engine/request/uri/change_path'), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
- ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
+ ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' )
+ or diag("Exception '$@', content " . $response->content);
like( $creq->uri, qr{/my/app/lives/here$}, 'URI contains new path' );
}
use File::Temp qw/ tempdir /;
use TestApp;
use File::Spec;
+use Carp qw/croak/;
my $home = tempdir( CLEANUP => 1 );
my $path = File::Spec->catfile($home, 'testapp.psgi');
TestApp->psgi_app;
};
close($psgi);
+
+my ($saved_stdout, $saved_stderr);
+my $stdout = !open( $saved_stdout, '>&'. STDOUT->fileno );
+my $stderr = !open( $saved_stderr, '>&'. STDERR->fileno );
+open( STDOUT, '+>', undef )
+ or croak("Can't reopen stdout to /dev/null");
+open( STDERR, '+>', undef )
+ or croak("Can't reopen stdout to /dev/null");
# Check we wrote out something that compiles
system($^X, '-I', "$FindBin::Bin/../lib", '-c', $path)
? fail('.psgi does not compile')
: pass('.psgi compiles');
+if ($stdout) {
+ open( STDOUT, '>&'. fileno($saved_stdout) );
+}
+if ($stderr) {
+ open( STDERR, '>&'. fileno($saved_stderr) );
+}
+
# NOTE - YOU *CANNOT* do something like:
#my $psgi_ref = require $path;
# otherwise this test passes!
use Moose::Meta::Class;
#use Moose::Meta::Attribute;
use Catalyst::Request;
+use Catalyst::Log;
use_ok('Catalyst::Action');
request => (
reader => 'request',
required => 1,
- default => sub { Catalyst::Request->new(arguments => [qw/one two/]) },
+ default => sub { Catalyst::Request->new(_log => Catalyst::Log->new, arguments => [qw/one two/]) },
),
),
],
use_ok('TestApp');
my $request = Catalyst::Request->new( {
+ _log => Catalyst::Log->new,
base => URI->new('http://127.0.0.1/foo')
} );
my $dispatcher = TestApp->dispatcher;
PATH_INFO => '/',
);
- my $engine = Catalyst::Engine->new(
- env => { %template, @_ },
- );
+ my $engine = Catalyst::Engine->new();
my $i = TestApp->new;
$i->setup_finished(0);
$i->config(use_request_uri_for_path => $use_request_uri_for_path);
$i->setup_finished(1);
+ $engine->prepare_request($i, env => { %template, @_ }, response_cb => sub {});
$engine->prepare_path($i);
return $i->req;
}
-use Test::More tests => 51;
+use Test::More;
use strict;
use warnings;
__PACKAGE__->setup_log;
}
+{
+ package MyStringThing;
+
+ use overload '""' => sub { $_[0]->{string} }, fallback => 1;
+}
+
is( MyMVCTestApp->view('View'), 'MyMVCTestApp::V::View', 'V::View ok' );
is( MyMVCTestApp->controller('Controller'),
# object w/ qr{}
is_deeply( [ MyMVCTestApp->model( qr{Test} ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' );
+ is_deeply([ MyMVCTestApp->model( bless({ string => 'Model' }, 'MyStringThing') ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::M::Model'} ], 'Explicit model search with overloaded object');
+
+ {
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+
+ # object w/ regexp fallback
+ is_deeply( [ MyMVCTestApp->model( bless({ string => 'Test' }, 'MyStringThing') ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' );
+ ok( $warnings, 'regexp fallback warnings' );
+ }
+
{
my $warnings = 0;
no warnings 'redefine';
is( MyApp::WithoutRegexFallback->controller('Foo'), undef, 'no controller Foo found');
ok( !$warnings, 'no regexp fallback warnings' );
}
+
+done_testing;
use FindBin;
use Path::Class;
use File::Basename;
+BEGIN {
+ delete $ENV{CATALYST_HOME}; # otherwise it'll set itself up to the wrong place
+}
+use lib "$FindBin::Bin/../lib";
+use TestApp;
my %non_unix = (
MacOS => 1,
use_ok('Catalyst');
-my $context = 'Catalyst';
-
-delete $ENV{CATALYST_HOME}; # otherwise it'll set itself up to the wrong place
-
-$context->setup_home;
-my $base = dir($FindBin::Bin)->relative->stringify;
+my $context = 'TestApp';
+my $base;
-isa_ok( Catalyst::path_to( $context, $base ), 'Path::Class::Dir' );
-isa_ok( Catalyst::path_to( $context, $base, basename $0 ), 'Path::Class::File' );
+isa_ok( $base = Catalyst::path_to( $context, '' ), 'Path::Class::Dir' );
my $config = Catalyst->config;
-$config->{home} = '/home/sri/my-app/';
-
-is( Catalyst::path_to( $context, 'foo' ), '/home/sri/my-app/foo', 'Unix path' );
-
-$config->{home} = '/Users/sri/myapp/';
+is( Catalyst::path_to( $context, 'foo' ), "$base/foo", 'Unix path' );
is( Catalyst::path_to( $context, 'foo', 'bar' ),
- '/Users/sri/myapp/foo/bar', 'deep Unix path' );
+ "$base/foo/bar", 'deep Unix path' );
done_testing;
use Moose;
extends 'Catalyst::Script::Create';
our $help;
- sub _getopt_full_usage { $help++ }
+ sub print_usage_text { $help++ }
}
{
use Moose;
with 'Catalyst::ScriptRole';
our $help;
- sub _getopt_full_usage { $help++ }
+ sub print_usage_text { $help++ }
}
test('--help');
use strict;
use warnings;
use FindBin qw/$Bin/;
+
+# Package::Stash::XS has a weird =~ XS invocation during its compilation
+# This interferes with @INC hooks that do rematcuing on their own on
+# perls before 5.8.7. Just use the PP version to work around this.
+BEGIN { $ENV{PACKAGE_STASH_IMPLEMENTATION} = 'PP' if $] < '5.008007' }
+
use Test::More;
use Try::Tiny;
use_ok('TestApp');
my $request = Catalyst::Request->new( {
+ _log => Catalyst::Log->new,
base => URI->new('http://127.0.0.1/foo')
} );
my $dispatcher = TestApp->dispatcher;
);
}
-done_testing;
+{
+ package MyStringThing;
+
+ use overload '""' => sub { $_[0]->{string} }, fallback => 1;
+}
+is(
+ Catalyst::uri_for( $context, bless( { string => 'test' }, 'MyStringThing' ) ),
+ 'http://127.0.0.1/test',
+ 'overloaded object handled correctly'
+);
+
+done_testing;
# Tests with Context
#
my $request = Catalyst::Request->new( {
+ _log => Catalyst::Log->new,
base => URI->new('http://127.0.0.1/foo')
} );
my $base = 'http://127.0.0.1';
my $request = Catalyst::Request->new({
+ _log => Catalyst::Log->new,
base => URI->new($base),
uri => URI->new("$base/"),
});
use strict;
use warnings;
-use Test::More tests => 10;
+use Test::More;
use URI;
+use URI::QueryParam;
+use Catalyst::Log;
use_ok('Catalyst::Request');
+sub cmp_uri {
+ my ($got, $exp_txt, $comment) = @_;
+ $comment ||= '';
+ my $exp = URI->new($exp_txt);
+ foreach my $thing (qw/ scheme host path /) {
+ is $exp->$thing, $got->$thing, "$comment: $thing";
+ }
+ is_deeply $got->query_form_hash, $exp->query_form_hash, "$comment: query";
+}
+
my $request = Catalyst::Request->new( {
+ _log => Catalyst::Log->new,
uri => URI->new('http://127.0.0.1/foo/bar/baz')
} );
-is(
+cmp_uri(
$request->uri_with({}),
'http://127.0.0.1/foo/bar/baz',
'URI for absolute path'
);
-is(
+cmp_uri(
$request->uri_with({ foo => 'bar' }),
'http://127.0.0.1/foo/bar/baz?foo=bar',
'URI adds param'
);
my $request2 = Catalyst::Request->new( {
+ _log => Catalyst::Log->new,
uri => URI->new('http://127.0.0.1/foo/bar/baz?bar=gorch')
} );
-is(
+
+cmp_uri(
$request2->uri_with({}),
'http://127.0.0.1/foo/bar/baz?bar=gorch',
'URI retains param'
);
-is(
+cmp_uri(
$request2->uri_with({ me => 'awesome' }),
'http://127.0.0.1/foo/bar/baz?bar=gorch&me=awesome',
'URI retains param and adds new'
);
-is(
+cmp_uri(
$request2->uri_with({ bar => undef }),
'http://127.0.0.1/foo/bar/baz',
'URI loses param when explicitly undef'
);
-is(
+cmp_uri(
$request2->uri_with({ bar => 'snort' }),
'http://127.0.0.1/foo/bar/baz?bar=snort',
'URI changes param'
);
-is(
+cmp_uri(
$request2->uri_with({ bar => [ 'snort', 'ewok' ] }),
'http://127.0.0.1/foo/bar/baz?bar=snort&bar=ewok',
'overwrite mode URI appends arrayref param'
);
-is(
+cmp_uri(
$request2->uri_with({ bar => 'snort' }, { mode => 'append' }),
'http://127.0.0.1/foo/bar/baz?bar=gorch&bar=snort',
'append mode URI appends param'
);
-is(
+cmp_uri(
$request2->uri_with({ bar => [ 'snort', 'ewok' ] }, { mode => 'append' }),
'http://127.0.0.1/foo/bar/baz?bar=gorch&bar=snort&bar=ewok',
'append mode URI appends arrayref param'
);
+done_testing;
+
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use File::Temp qw/ tempdir /;
+use Catalyst::Utils;
+use File::Spec;
+use Path::Class qw/ dir /;
+use Cwd qw/ cwd /;
+
+my @dists = Catalyst::Utils::dist_indicator_file_list();
+is(scalar(@dists), 3, 'Makefile.PL Build.PL dist.ini');
+
+my $cwd = cwd();
+foreach my $inc ('', 'lib', 'blib'){
+ my $d = tempdir(CLEANUP => 1);
+ chdir($d);
+ local $INC{'MyApp.pm'} = File::Spec->catfile($d, $inc, 'MyApp.pm');
+ ok !Catalyst::Utils::home('MyApp'), "No files found inc $inc";
+ open(my $fh, '>', "Makefile.PL");
+ close($fh);
+ is Catalyst::Utils::home('MyApp'), dir($d)->absolute->cleanup, "Did find inc '$inc'";
+}
+
+{
+ my $d = tempdir(CLEANUP => 1);
+ local $INC{'MyApp.pm'} = File::Spec->catfile($d, 'MyApp.pm');
+ ok !Catalyst::Utils::home('MyApp'), 'No files found';
+ mkdir File::Spec->catdir($d, 'MyApp');
+ is Catalyst::Utils::home('MyApp'), dir($d, 'MyApp')->absolute->cleanup;
+}
+
+chdir($cwd);
+
+done_testing;
+
use Try::Tiny;
use Plack::Builder;
-use Catalyst::Devel 1.0;
-use File::Copy::Recursive;
+eval { require Catalyst::Devel; Catalyst::Devel->VERSION(1.0); 1; } || do {
+ fail("Could not load Catalyst::Devel: $@");
+ exit 1;
+};
+
+eval { require File::Copy::Recursive; 1 } || do {
+ fail("Could not load File::Copy::Recursive: $@");
+ exit 1;
+};
# Run a single test by providing it as the first arg
my $single_test = shift;
is( $return, 0, 'live tests' );
+# kill 'INT' doesn't exist in Windows, so to prevent child hanging,
+# this process will need to commit seppuku to clean up the children.
+if ($^O eq 'MSWin32') {
+ # Furthermore, it needs to do it 'politely' so that TAP doesn't
+ # smell anything 'dubious'.
+ require Win32::Process; # core in all versions of Win32 Perl
+ Win32::Process::KillProcess($$, $return);
+}
+
sub wait_port_timeout {
my ($port, $timeout) = @_;
my @modules = all_modules;
our @private = ( 'BUILD' );
foreach my $module (@modules) {
- local @private = (@private, 'run') if $module =~ /^Catalyst::Script::/;
+ local @private = (@private, 'run', 'dont_close_all_files') if $module =~ /^Catalyst::Script::/;
local @private = (@private, 'plugin') if $module =~ /^Catalyst$/;
+ local @private = (@private, 'snippets') if $module =~ /^Catalyst::Request$/;
+ local @private = (@private, 'prepare_connection') if $module =~ /^Catalyst::Engine$/;
+
pod_coverage_ok($module, {
also_private => \@private,
coverage_class => 'Pod::Coverage::TrustPod',
BUILDARGS metaclass namespaces pre ARGV ReverseProxy
filename tempname request's subdirectory ini uninstalled uppercased
wiki bitmask uri url urls dir hostname proxied http https IP SSL
+ inline INLINE plugins
+ FastCGI Stringifies Rethrows DispatchType Wishlist Refactor ROADMAP HTTPS Unescapes Restarter Nginx Refactored
+ ActionClass LocalRegex LocalRegexp MyAction metadata
+ Andreas
+ Ashton
+ Axel
+ Balint
+ Belka
+ Brocard
+ Caelum
+ Cassidy
+ Dagfinn
+ Danijel
+ Dhanani
+ Dhaval
+ Diment
+ Doran
+ Edvinsson
+ Florian
+ Geoff
+ Grundman
+ Hartmaier
+ Hawes
+ Ilmari
+ Johan
+ Kamholz
+ Kiefer
+ Kieren
+ Kitover
+ Kogman
+ Kostyuk
+ Kubb
+ Lammel
+ Lindstrom
+ Mannsåker
+ Marienborg
+ Marrandi
+ McWhirter
+ Milicevic
+ Miyagawa
+ Montes
+ Naughton
+ Oleg
+ Ragwitz
+ Ramberg
+ Rasnita
+ Reis
+ Riedel
+ Rockway
+ Roditi
+ Rodland
+ Ruthven
+ Sascha
+ Schutz
+ Sedlacek
+ Sheidlower
+ SpiceMan
+ Szilakszi
+ Tatsuhiko
+ Ulf
+ Vilain
+ Viljo
+ Wardley
+ Westermann
+ Willert
+ Yuval
+ abraxxa
+ abw
+ andyg
+ audreyt
+ bricas
+ chansen
+ dhoss
+ dkubb
+ dwc
+ esskar
+ fREW
+ fireartist
+ frew
+ gabb
+ groditi
+ hobbs
+ ilmari
+ jcamacho
+ jhannah
+ jon
+ konobi
+ marcus
+ miyagawa
+ mst
+ naughton
+ ningu
+ nothingmuch
+ numa
+ obra
+ phaylon
+ rafl
+ rainboxx
+ sri
+ szbalint
+ willert
+ wreis
));
set_spell_cmd('aspell list -l en');
all_pod_files_spelling_ok();
use strict;
use warnings;
-use base qw/Catalyst::Action/;
+use base qw/Catalyst::Action/; # N.B. Keep as a non-moose class, this also
+ # tests metaclass initialization works as expected
sub execute {
my $self = shift;
--- /dev/null
+package Catalyst::ActionRole::Moo;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->body(__PACKAGE__);
+};
+
+1;
--- /dev/null
+package Catalyst::ActionRole::Zoo;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->body(__PACKAGE__);
+};
+
+1;
--- /dev/null
+package Moo;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->body(__PACKAGE__);
+};
+
+1;
package TestApp;
-
use strict;
use Catalyst qw/
Test::MangleDollarUnderScore
our $VERSION = '0.01';
-TestApp->config( name => 'TestApp', root => '/some/dir', use_request_uri_for_path => 1 );
+TestApp->config(
+ name => 'TestApp',
+ root => '/some/dir',
+ use_request_uri_for_path => 1,
+ 'Controller::Action::Action' => {
+ action_args => {
+ action_action_nine => { another_extra_arg => 13 }
+ }
+ }
+);
# Test bug found when re-adjusting the metaclass compat code in Moose
# in 292360. Test added to Moose in 4b760d6, but leave this attribute
sub Catalyst::Log::error { }
}
+# Pretend to be Plugin::Session and hook finalize_headers to send a header
+
+sub finalize_headers {
+ my $c = shift;
+
+ $c->res->header('X-Test-Header', 'valid');
+
+ my $call_count = $c->stash->{finalize_headers_call_count} || 0;
+ $call_count++;
+ $c->stash(finalize_headers_call_count => $call_count);
+ $c->res->header('X-Test-Header-Call-Count' => $call_count);
+
+ return $c->maybe::next::method(@_);
+}
+
# Make sure we can load Inline plugins.
package Catalyst::Plugin::Test::Inline;
--- /dev/null
+package TestApp::Action::TestActionArgsFromConstructor;
+
+use Moose;
+use namespace::autoclean;
+
+extends 'Catalyst::Action';
+
+has [qw/extra_arg another_extra_arg/] => ( is => 'ro' );
+
+after execute => sub {
+ my ($self, $controller, $ctx) = @_;
+ $ctx->response->header('X-TestExtraArgsAction' => join q{,} => $self->extra_arg, $self->another_extra_arg);
+};
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
--- /dev/null
+package TestApp::Action::TestMatchCaptures;
+
+use Moose;
+
+extends 'Catalyst::Action';
+
+sub match_captures {
+ my ($self, $c, $cap) = @_;
+ if ($cap->[0] eq 'force') {
+ $c->res->header( 'X-TestAppActionTestMatchCaptures', 'forcing' );
+ return 1;
+ } else {
+ $c->res->header( 'X-TestAppActionTestMatchCaptures', 'fallthrough' );
+ return 0;
+ }
+}
+
+1;
\ No newline at end of file
--- /dev/null
+package TestApp::ActionRole::Boo;
+
+use Moose::Role;
+
+has boo => (
+ is => 'ro',
+ required => 1,
+);
+
+around execute => sub {
+ my ($orig, $self, $controller, $ctx, @rest) = @_;
+ $ctx->stash(action_boo => $self->boo);
+ return $self->$orig($controller, $ctx, @rest);
+};
+
+1;
--- /dev/null
+package TestApp::ActionRole::Kooh;
+
+use Moose::Role;
+
+use namespace::autoclean;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->header('X-Affe' => 'Tiger');
+};
+
+1;
--- /dev/null
+package TestApp::ActionRole::Moo;
+
+use Moose::Role;
+
+after execute => sub {
+ my ($self, $controller, $c) = @_;
+ $c->response->body(__PACKAGE__);
+};
+
+1;
$c->forward('TestApp::View::Dump::Action');
}
+sub action_action_nine : Global : ActionClass('~TestActionArgsFromConstructor') {
+ my ( $self, $c ) = @_;
+ $c->forward('TestApp::View::Dump::Request');
+}
1;
sub foo :PathPart('chained/foo') :CaptureArgs(1) :Chained('/') {
my ( $self, $c, @args ) = @_;
die "missing argument" unless @args;
- die "more than 1 argument" if @args > 1;
+ die "more than 1 argument: got @args" if @args > 1;
}
sub endpoint :PathPart('end') :Chained('/action/chained/foo') :Args(1) { }
$c->stash->{no_end} = 1;
}
+sub match_captures : Chained('/') PathPart('chained/match_captures') CaptureArgs(1) ActionClass('+TestApp::Action::TestMatchCaptures') {
+ my ($self, $c) = @_;
+ $c->res->header( 'X-TestAppActionTestMatchCapturesHasRan', 'yes');
+}
+
+sub match_captures_end : Chained('match_captures') PathPart('bar') Args(0) { }
+
sub end :Private {
my ($self, $c) = @_;
return if $c->stash->{no_end};
--- /dev/null
+package TestApp::Controller::ActionRoles;
+
+use Moose;
+
+BEGIN { extends 'Catalyst::Controller' }
+
+__PACKAGE__->config(
+ action_roles => ['~Kooh'],
+ action_args => {
+ frew => { boo => 'hello' },
+ },
+);
+
+sub foo : Local Does('Moo') {}
+sub bar : Local Does('~Moo') {}
+sub baz : Local Does('+Moo') {}
+sub quux : Local Does('Zoo') {}
+
+sub corge : Local Does('Moo') ActionClass('TestAfter') {
+ my ($self, $ctx) = @_;
+ $ctx->stash(after_message => 'moo');
+}
+
+sub frew : Local Does('Boo') {
+ my ($self, $ctx) = @_;
+ my $boo = $ctx->stash->{action_boo};
+ $ctx->response->body($boo);
+}
+
+1;
package My::AttributesBaseClass;
use base qw( Catalyst::Controller );
-sub fetch : Chained('/') PathPrefix CaptureArgs(1) {
+sub fetch : Chained('/') PathPrefix CaptureArgs(0) { }
-}
+sub left_alone :Chained('fetch') PathPart Args(0) { }
-sub view : PathPart Chained('fetch') Args(0) {
+sub view : PathPart Chained('fetch') Args(0) { }
-}
+sub foo { } # no attributes
-sub foo { # no attributes
+package TestApp::Controller::Attributes;
+use base qw(My::AttributesBaseClass);
+sub _parse_MakeMeVisible_attr {
+ my ($self, $c, $name, $value) = @_;
+ if (!$value){
+ return Chained => 'fetch', PathPart => 'all_attrs', Args => 0;
+ }
+ elsif ($value eq 'some'){
+ return Chained => 'fetch', Args => 0;
+ }
+ elsif ($value eq 'one'){
+ return PathPart => 'one_attr';
+ }
}
-package TestApp::Controller::Attributes;
-use base qw(My::AttributesBaseClass);
+sub view { } # override attributes to "hide" url
-sub view { # override attributes to "hide" url
+sub foo : Local { }
-}
+sub all_attrs_action :MakeMeVisible { }
-sub foo : Local {
+sub some_attrs_action :MakeMeVisible('some') PathPart('some_attrs') { }
-}
+sub one_attr_action :MakeMeVisible('one') Chained('fetch') Args(0) { }
1;
--- /dev/null
+package TestApp::Controller::BodyParams;
+
+use strict;
+use base 'Catalyst::Controller';
+
+sub default : Private {
+ my ( $self, $c ) = @_;
+ $c->req->body_params({override => 'that'});
+ $c->res->output($c->req->body_params->{override});
+ $c->res->status(200);
+}
+
+sub no_params : Local {
+ my ( $self, $c ) = @_;
+ my $params = $c->req->body_parameters;
+ $c->res->output(ref $params);
+ $c->res->status(200);
+}
+
+1;
sub env : Action Relative {
my ( $self, $c ) = @_;
+ $c->stash(env => $c->req->env);
+ $c->forward('TestApp::View::Dump::Env');
+}
+
+sub env_on_engine : Action Relative {
+ my ( $self, $c ) = @_;
+ $c->stash(env => $c->engine->env);
$c->forward('TestApp::View::Dump::Env');
}
$c->forward('TestApp::View::Dump::Request');
}
+sub prepare_parameters : Action Relative {
+ my ( $self, $c ) = @_;
+
+ die 'Must pass in parameters' unless keys %{$c->req->parameters};
+
+ $c->req->parameters( {} );
+ die 'parameters are not empty' if keys %{$c->req->parameters};
+
+ # Now reset and reload
+ $c->prepare_parameters;
+ die 'Parameters were not reset' unless keys %{$c->req->parameters};
+
+ $c->forward('TestApp::View::Dump::Request');
+}
sub response : Action Relative {
my ( $self, $c ) = @_;
$c->forward('TestApp::View::Dump::Response');
--- /dev/null
+package TestApp::Controller::HTTPMethods;
+
+use Moose;
+use MooseX::MethodAttributes;
+
+extends 'Catalyst::Controller';
+
+sub default : Path Args {
+ my ($self, $ctx) = @_;
+ $ctx->response->body('default');
+}
+
+sub get : Path('foo') Method('GET') {
+ my ($self, $ctx) = @_;
+ $ctx->response->body('get');
+}
+
+sub post : Path('foo') Method('POST') {
+ my ($self, $ctx) = @_;
+ $ctx->response->body('post');
+}
+
+sub get_or_post : Path('bar') Method('GET') Method('POST') {
+ my ($self, $ctx) = @_;
+ $ctx->response->body('get or post');
+}
+
+sub any_method : Path('baz') {
+ my ($self, $ctx) = @_;
+ $ctx->response->body('any');
+}
+
+sub base :Chained('/') PathPrefix CaptureArgs(0) { }
+
+sub chained_get :Chained('base') Args(0) GET {
+ pop->res->body('chained_get');
+}
+
+sub chained_post :Chained('base') Args(0) POST {
+ pop->res->body('chained_post');
+}
+
+sub chained_put :Chained('base') Args(0) PUT {
+ pop->res->body('chained_put');
+}
+
+sub chained_delete :Chained('base') Args(0) DELETE {
+ pop->res->body('chained_delete');
+}
+
+sub get_or_put :Chained('base') PathPart('get_put_post_delete') CaptureArgs(0) GET PUT { }
+
+sub get2 :Chained('get_or_put') PathPart('') Args(0) GET {
+ pop->res->body('get2');
+}
+
+sub put2 :Chained('get_or_put') PathPart('') Args(0) PUT {
+ pop->res->body('put2');
+}
+
+sub post_or_delete :Chained('base') PathPart('get_put_post_delete') CaptureArgs(0) POST DELETE { }
+
+sub post2 :Chained('post_or_delete') PathPart('') Args(0) POST {
+ pop->res->body('post2');
+}
+
+sub delete2 :Chained('post_or_delete') PathPart('') Args(0) DELETE {
+ pop->res->body('delete2');
+}
+
+sub check_default :Chained('base') CaptureArgs(0) { }
+
+sub default_get :Chained('check_default') PathPart('') Args(0) GET {
+ pop->res->body('get3');
+}
+
+sub default_post :Chained('check_default') PathPart('') Args(0) POST {
+ pop->res->body('post3');
+}
+
+sub chain_default :Chained('check_default') PathPart('') Args(0) {
+ pop->res->body('chain_default');
+}
+
+__PACKAGE__->meta->make_immutable;
--- /dev/null
+package TestApp::Controller::Log;
+
+use strict;
+use base 'Catalyst::Controller';
+
+sub debug :Local {
+ my ( $self, $c ) = @_;
+ $c->log->debug('debug');
+ $c->res->body( 'logged' );
+}
+
+
+1;
+
sub recursion_test : Local {
my ( $self, $c ) = @_;
+ no warnings 'recursion';
$c->forward( 'recursion_test' );
}
$c->res->redirect('/go_here');
}
+sub test_redirect_uri_for :Global {
+ my ($self, $c) = @_;
+ # Don't set content_type
+ # Don't set body
+ $c->res->redirect($c->uri_for('/go_here'));
+}
+
sub test_redirect_with_contenttype :Global {
my ($self, $c) = @_;
# set content_type but don't set body
$dumper->Purity($purity);
$dumper->Useqq(0);
$dumper->Deepcopy(1);
- $dumper->Quotekeys(0);
+ $dumper->Quotekeys(1);
$dumper->Terse(1);
+ local $SIG{ __WARN__ } = sub { warn unless $_[ 0 ] =~ m{dummy} };
return $dumper->Dump;
}
# Remove context from reference if needed
my $context = delete $reference->{_context};
+ if (my $log = $reference->{_log}) {
+ $log->clear_psgienv if $log->can('psgienv');
+ }
+
if ( my $output =
$self->dump( $reference, $purity ) )
{
sub process {
my ( $self, $c ) = @_;
- my $env = $c->engine->env;
+ my $env = $c->stash->{env};
return $self->SUPER::process($c, {
map { ($_ => $env->{$_}) }
grep { $_ ne 'psgi.input' }
sub process {
my ( $self, $c ) = @_;
- return $self->SUPER::process( $c, $c->request );
+ my $r = $c->request;
+ local $r->{env};
+ return $self->SUPER::process( $c, $r );
}
1;
sub process {
my ( $self, $c ) = @_;
- return $self->SUPER::process( $c, $c->response );
+ my $r = $c->response;
+ local $r->{_writer};
+ local $r->{_reponse_cb};
+ return $self->SUPER::process( $c, $r );
}
1;
package TestAppBadlyImmutable;
use Catalyst qw/+TestPluginWithConstructor/;
+
+use base qw/Class::Accessor Catalyst/;
+
use Test::More;
__PACKAGE__->setup;
-ok !__PACKAGE__->meta->is_immutable, 'Am not already immutable';
__PACKAGE__->meta->make_immutable( inline_constructor => 0 );
ok __PACKAGE__->meta->is_immutable, 'Am now immutable';
sub binary : Local {
my ($self, $c) = @_;
- $c->res->body(do {
+ $c->res->body(do {
open(my $fh, '<', $c->path_to('..', '..', 'catalyst_130pix.gif')) or die $!;
binmode($fh);
local $/ = undef; <$fh>;
use lib "$FindBin::Bin/lib";
use Catalyst::Test 'TestApp', {default_host => 'default.com'};
use Catalyst::Request;
+use HTTP::Request::Common;
use Test::More;
is( $creq->uri->host, $opts{host}, 'target host is mutable via options hashref' );
}
+{
+ my $response = request( POST( '/bodyparams', { override => 'this' } ) )->content;
+ is($response, 'that', 'body param overridden');
+}
+
+{
+ my $response = request( POST( '/bodyparams/no_params' ) )->content;
+ is($response, 'HASH', 'empty body param is hashref');
+}
+
done_testing;
use lib "$FindBin::Bin/lib";
BEGIN { $::setup_leakchecker = 1 }
-
+local $SIG{__WARN__} = sub { return if $_[0] =~ /Unhandled type: GLOB/; warn $_[0] };
use Catalyst::Test 'TestApp';
{
like( $response->content, qr/kind sir/, 'Content contains content set by the Controller' );
}
+# test redirect with dodgy host
+{
+ local $Catalyst::Test::default_host = "-->\">'>'\"<sfi000003v407412>";
+ my $request =
+ HTTP::Request->new( GET => 'http://localhost:3000/test_redirect_uri_for');
+
+ ok( my $response = request($request), 'Request' );
+ is( $response->code, 302, 'Response Code' );
+
+ # When no body and no content_type has been set, redirecting should set both.
+ is( $response->header( 'Content-Type' ), 'text/html; charset=utf-8', 'Content Type' );
+ like( $response->content, qr/<body>/, 'Content contains HTML body' );
+ like( $response->content, qr/href="[^"]+">here<\/a>/, 'link doesn\'t have xss' );
+}
+
done_testing;
# that plugins don't get it wrong for us.
# Also tests method modifiers and etc in MyApp.pm still work as expected.
-use Test::More tests => 8;
+use Test::More;
use Test::Exception;
use Moose::Util qw/find_meta/;
use FindBin;
use lib "$FindBin::Bin/lib";
use Catalyst::Test qw/TestAppPluginWithConstructor/;
+TestAppPluginWithConstructor->_make_immutable_if_needed;
ok find_meta('TestAppPluginWithConstructor')->is_immutable,
'Am immutable after use';
is $TestAppPluginWithConstructor::MODIFIER_FIRED, 1, 'Before modifier was fired correctly.';
my $warning;
-local $SIG{__WARN__} = sub { $warning = $_[0] };
-eval "use TestAppBadlyImmutable;";
+eval "use TestAppBadlyImmutable";
+local $SIG{__WARN__} = sub { $warning .= $_[0] };
+
+TestAppBadlyImmutable->_make_immutable_if_needed;
+
like $warning, qr/\QYou made your application class (TestAppBadlyImmutable) immutable/,
'An application class that is already immutable but does not inline the constructor warns at ->setup';
+done_testing;
+
--- /dev/null
+=head1 PROBLEM
+
+In https://github.com/plack/Plack/commit/cafa5db84921f020183a9c834fd6a4541e5a6b84
+chansen made a change to the FCGI handler in Plack, in which he replaced
+STDERR, STDOUT and STDIN with proper IO::Handle objects.
+
+The side effect of that change is that catalyst outputing logs on STDERR will
+no longer end up by default in the error log of the webserver when running
+under FCGI. This test tries to make sure we use the propper parts of the psgi
+environment when we output things from Catalyst::Log.
+
+There is one more "regression", and that is warnings. By using
+Catalyst::Plugin::LogWarnings, you also get those in the right place if this
+test passes :)
+
+=cut
+
+use strict;
+use warnings;
+no warnings 'once';
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More;
+
+use File::Spec;
+use File::Temp qw/ tempdir /;
+
+use TestApp;
+
+use Plack::Builder;
+use Plack::Test;
+use HTTP::Request::Common;
+
+{
+ package MockHandle;
+ use Moose;
+
+ has 'log' => (is => 'ro', isa => 'ArrayRef', traits => ['Array'], default => sub { [] },
+ handles => {
+ 'logs' => 'elements',
+ 'print' => 'push',
+ }
+ );
+
+ no Moose;
+}
+
+#subtest "psgi.errors" => sub
+{
+
+ my $handle = MockHandle->new();
+ my $app = builder {
+
+ enable sub {
+ my $app = shift;
+ sub {
+ my $env = shift;
+ $env->{'psgi.errors'} = $handle;
+ my $res = $app->($env);
+ return $res;
+ };
+ };
+ TestApp->psgi_app;
+ };
+
+
+ test_psgi $app, sub {
+ my $cb = shift;
+ my $res = $cb->(GET "/log/debug");
+ my @logs = $handle->logs;
+ is(scalar(@logs), 1, "psgi.errors: one event output");
+ like($logs[0], qr/debug$/, "psgi.errors: event matches test data");
+ };
+};
+
+#subtest "psgix.logger" => sub
+{
+
+ my @logs;
+ my $logger = sub {
+ push(@logs, @_);
+ };
+ my $app = builder {
+ enable sub {
+ my $app = shift;
+ sub {
+ my $env = shift;
+ $env->{'psgix.logger'} = $logger;
+ $app->($env);
+ };
+ };
+ TestApp->psgi_app;
+ };
+
+ test_psgi $app, sub {
+ my $cb = shift;
+ my $res = $cb->(GET "/log/debug");
+ is(scalar(@logs), 1, "psgix.logger: one event logged");
+ is_deeply($logs[0], { level => 'debug', message => "debug" }, "psgix.logger: right stuff");
+ };
+};
+
+
+
+done_testing;
$temp = tempdir( CLEANUP => 1 );
$ENV{CATALYST_HOME} = $temp;
- open(my $psgi, '>', File::Spec->catdir($temp, 'testapp.psgi')) or die;
+ open(my $psgi, '>', File::Spec->catfile($temp, 'testapp.psgi')) or die;
print $psgi q{
use strict;
use TestApp;
use HTTP::Request::Common;
plan skip_all => "Catalyst::Engine::PSGI required for this test"
- unless eval { require Catalyst::Engine::PSGI; 1; };
+ unless eval { local $SIG{__WARN__} = sub{}; require Catalyst::Engine::PSGI; 1; };
my $warning;
local $SIG{__WARN__} = sub { $warning = $_[0] };
$temp = tempdir( CLEANUP => 1 );
$ENV{CATALYST_HOME} = $temp;
- open(my $psgi, '>', File::Spec->catdir($temp, 'testapp.psgi')) or die;
+ open(my $psgi, '>', File::Spec->catfile($temp, 'testapp.psgi')) or die;
print $psgi q{
use strict;
use TestApp;
use Carp qw(croak);
use FindBin qw/$Bin/;
-use lib "$Bin/../lib";
+use lib "$Bin/lib";
use Test::More;
use Test::Exception;
projects / catagits/Catalyst-Runtime.git / commitdiff