!.gitignore
Makefile*
!Makefile.PL
+MYMETA.json
MYMETA.yml
META.yml
blib
# This file documents the revision history for Perl extension Catalyst.
+5.90004 - 2011-10-11 17:12:00
+
+ Bug fixes:
+
+ - Don't guess engine class names when setting an engine through
+ MyApp->engine_class.
+
+5.90003 - 2011-10-05 08:32:00
+ Bug fixes:
+
+ - Make default body reponses for 302s W3C compliant. RT#71237
+
+ - Fix issue where groups of attributes to override controller actions
+ in config would be (incorrectly) overwritten, if the parser for that
+ attribute mangled the contents of the attribute. This was found
+ with Catalyst::Controller::ActionRole, where Does => [ '+Foo' ]
+ would be transformed to Does => [ 'Foo' ] and written back to config,
+ whereas Does => '+Foo' would not be changed in config. RT#65463
+
+ Enhancements:
+
+ - Set a matching Content-type for the redirect if Catalyst sets the
+ body. This is for compatibility with a WatchGuard Firewall.
+
+ Backward compatibility fixes:
+
+ - Restore (an almost empty) Catalyst::Engine::HTTP to the dist for old
+ scripts which explictly require Catalyst::Engine::HTTP
+
+ Documentation fixes:
+
+ - Document Catalyst::Plugin::Authentication fails tests unless
+ you use the latest version with Catalyst 5.9
+
+ - Clarify that prepare is called as a class method
+
+ - Clarify use of uri_for further. RT#57011
+
+5.90002 - 2011-08-22 21:44:00
+ Backward compatibility fixes:
+
+ - Deploying via mod_perl in some cases is fixed by making
+ Catalyst::EngineLoader detect mod_perl in more generic
+ circumstances.
+ https://github.com/miyagawa/Plack/issues/239
+
+ Documentation fixes:
+
+ - Fix incorrect example in Catalyst::PSGI.
+ - Add note that if you are using the PSGI engine, then $c->req->env
+ needs to become $c->engine->env when you upgrade.
+
+5.90001 - 2011-08-15 22:42
+
+ Realise that we accidentally chopped a digit off the versioning scheme
+ without anyone noticing, which is a bad thing.
+
+ Feel like a fool. Well done t0m.
+
+ Cut another release.
+
+5.9000 - 2011-08-15 22:18
+
+ See Catalyst::Delta for the major changes in this release.
+
+ Changelog since the last TRIAL release:
+
+ Backward compatibility fixes:
+
+ - Fix calling MyApp->engine_class to set the engine class manually.
+
+ - Re-add a $res->headers->{status} field to Catalyst::Test responses.
+ This _should_ be accessed with $c->res->code instead, but is here
+ for backward compatibility.
+
+ Documentation:
+
+ - Documentation which was in the now removed Catalyst::Engine::* classes
+ has been moved to Catalyst::Manual::Deployment
+
+ Changes:
+
+ - nginx specific behaviour is removed as it is not needed with any
+ web server configuration I can come up with (recommended config is
+ documented in Catalst::Manual::Deployment::nginx::FastCGI)
+
+5.89003 2011-07-28 20:11:50 (TRIAL release)
+
+ Backward compatibility fixes:
+
+ - Application scripts which have not been upgraded to newer
+ Catalyst::Script::XXX style scripts have been fixed
+
+ Bug fixes:
+
+ - mod_perl handler fixed to work with application classes which have manually
+ been made immutable.
+
+ - Scripts now force the Plack engine choice manually, rather than relying
+ on auto-detection, as the automatic mechanism gets it wrong if (for
+ example) Coro is loaded.
+
+ - Server script option for --fork --keepalive are now handled by loading
+ the Starman server, rather than silently ignored.
+
+ - Server script options for --background and --pid are now fixed by
+ using MooseX::Deamonize
+
+ - Plack middlewares to deal with issues in Lighttpd and IIS6 are now
+ automatically applied to applications and deployments which need them
+ (when there is not a user written .psgi script available).
+ This fixes compatibility with previous stable releases for applications
+ deployed in these environments.
+
+ Enhancements:
+
+ - Catalyst::Test's remote_request method not uses Plack::Test to perform
+ the remote request.
+
+ Documentation:
+ - Added a Catalyst::PSGI manual page with information about writing a .psgi
+ file for your application.
+
+ - Catalyst::Uprading has been improved, and the status of old Catalyst
+ engines clarified.
+
+ Deprecations:
+ - Catalyst::Test's local_request function is now deprecated. You should just
+ use the normal request function against a local server instead.
+
5.80033 2011-07-24 16:09:00
Bug fixes:
- Update tests to ignore CATALYST_HOME env var.
+5.89002 2011-03-02 11:30:00 (TRIAL release)
+
+ Bug fixes:
+ - Fix a couple of test failures caused by optional dependencies such as FCGI
+ not being installed.
+
+ Refactoring:
+ - Simplified the API for getting a PSGI application code reference for a
+ Catalyst application for use in, for example, .psgi files. See
+ Catalyst::Upgrading for details.
+
+5.89001 2011-03-01 15:27:00 (TRIAL release)
+
+ Bug fixes:
+ - Fixed command-line argument passing in Catalyst::Script::FastCGI.
+
+ - Fixed Catalyst::Engine::Stomp compatibility. Applications using
+ Catalyst::Engine::Stomp are believed to continue working without
+ any changes with the new Catalyst major version.
+
+ - Fixed issues auto-loading engine with older scripts.
+
+ Known problems:
+ - Catalyst::Engine::Wx is officially unsupported and BROKEN. If you
+ are using this engine then please get in touch with us and we'll
+ be happy to help with the changes it needs to be compatible with
+ the new major version of Catalyst.
+
+ Documentation:
+ - The section of Catalyst::Upgrading describing how to upgrade to version 5.90
+ of Catalyst has been much improved.
+
5.80032 2011-02-23 01:10:00
Bug fixes:
- Fix undef warning in Catalyst::Engine::FastCGI when writing an empty
body (e.g. doing a redirect)
+5.89000 2011-01-24 09:28:45 (TRIAL release)
+
+ This is a development release from psgi branch of Catalyst-Runtime.
+
+ Removed features:
+
+ - All of the Catalyst::Engine::* namespace is now gone. Instead we only have
+ one Catalyst::Engine class speaking the PSGI protocol natively. Everything
+ the various Catalyst::Engine:: classes did before is now supposed to happen
+ through PSGI handlers such as Plack::Handler::FCGI,
+ Plack::Handler::HTTP::Server::PSGI, Plack::Handler::Apache2, and so
+ on. However, deployment can still work the same as it did before. The
+ catalyst scripts still exist and continue to work.
+
+ If you find anything that either doesn't work anymore as it did before or
+ anything that could be done before with the various Catalyst::Engine::
+ classes, but can't be done anymore with the single PSGI Catalyst::Engine
+ class, please tell us *now*.
+
5.80030 2011-01-04 13:13:02
New features:
requires 'B::Hooks::EndOfScope' => '0.08';
requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903';
requires 'Class::MOP' => '0.95';
+requires 'Data::OptList';
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 'Time::HiRes';
requires 'Tree::Simple' => '1.15';
requires 'Tree::Simple::Visitor::FindByPath';
+requires 'Try::Tiny';
requires 'URI' => '1.35';
requires 'Task::Weaken';
requires 'Text::Balanced'; # core in 5.8.x but mentioned for completeness
requires 'MooseX::Types';
requires 'MooseX::Types::Common::Numeric';
requires 'String::RewritePrefix' => '0.004'; # Catalyst::Utils::resolve_namespace
+requires 'Plack' => '0.9974'; # IIS6 fix middleware
+requires 'Plack::Middleware::ReverseProxy' => '0.04';
+requires 'Plack::Test::ExternalServer';
test_requires 'Class::Data::Inheritable';
test_requires 'Test::Exception';
test_requires 'Test::More' => '0.88';
+test_requires 'Data::Dump';
+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
if ($ENV{AGGREGATE_TESTS} && can_use('Test::Simple', '0.88') && can_use('Test::Aggregate', '0.364')) {
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(
Test::NoTabs
Test::Pod
Test::Pod::Coverage
- Pod::Coverage
+ Test::Spelling
+ Pod::Coverage::TrustPod
));
if ($Module::Install::AUTHOR) {
'Catalyst::Plugin::Unicode::Encoding' => '0.2',
'Catalyst::Plugin::Authentication' => '0.10010', # _config accessor in ::Credential::Password
'Catalyst::Authentication::Credential::HTTP' => '1.009',
- 'Catalyst::Plugin::Session::Store::File' => '0.16',
- 'Catalyst::Plugin::Session' => '0.21',
- 'Catalyst::Plugin::Session::State::Cookie' => '0.10',
+ 'Catalyst::Plugin::Session::Store::File' => '0.16',
+ 'Catalyst::Plugin::Session' => '0.21',
+ 'Catalyst::Plugin::Session::State::Cookie' => '0.10',
'Catalyst::Plugin::Session::Store::FastMmap' => '0.09',
- 'Catalyst::Controller::AllowDisable' => '0.03',
- 'Reaction' => '0.001999',
- 'Catalyst::Plugin::Upload::Image::Magick' => '0.03',
- 'Catalyst::Plugin::ConfigLoader' => '0.22', # Older versions work but
+ 'Catalyst::Controller::AllowDisable' => '0.03',
+ 'Reaction' => '0.001999',
+ 'Catalyst::Plugin::Upload::Image::Magick' => '0.03',
+ 'Catalyst::Plugin::ConfigLoader' => '0.22', # Older versions work but
# throw Data::Visitor warns
- 'Catalyst::Devel' => '1.19',
- 'Catalyst::Plugin::SmartURI' => '0.032',
- 'CatalystX::CRUD' => '0.37',
- 'Catalyst::Action::RenderView' => '0.07',
- 'Catalyst::Plugin::DebugCookie' => '0.999002',
- 'Catalyst::Plugin::Authentication' => '0.100091',
- 'CatalystX::Imports' => '0.03',
- 'Catalyst::Plugin::HashedCookies' => '1.03',
- 'Catalyst::Action::REST' => '0.67',
- 'CatalystX::CRUD' => '0.42',
- 'CatalystX::CRUD::Model::RDBO' => '0.20',
- 'Catalyst::View::Mason' => '0.17',
+ 'Catalyst::Devel' => '1.19',
+ 'Catalyst::Plugin::SmartURI' => '0.032',
+ 'CatalystX::CRUD' => '0.37',
+ 'Catalyst::Action::RenderView' => '0.07',
+ 'Catalyst::Plugin::DebugCookie' => '0.999002',
+ 'Catalyst::Plugin::Authentication' => '0.100091',
+ 'CatalystX::Imports' => '0.03',
+ 'Catalyst::Plugin::HashedCookies' => '1.03',
+ 'Catalyst::Action::REST' => '0.67',
+ 'CatalystX::CRUD' => '0.42',
+ 'CatalystX::CRUD::Model::RDBO' => '0.20',
+ 'Catalyst::View::Mason' => '0.17',
+# Note these are not actually needed - they fail tests against the
+# new version, but still work fine..
+# 'Catalyst::ActionRole::ACL' => '0.05',
+# 'Catalyst::Plugin::Session::Store::DBIC' => '0.11',
+ 'Test::WWW::Mechanize::Catalyst' => '0.53', # Dep warnings unless upgraded.
);
check_conflicts(%conflicts);
See also: Catalyst::Plugin::Log::Dispatch and
http://github.com/willert/catalyst-plugin-log4perl-simple/tree
-# REFACTORING
+## Capture arguments that the plack engine component was run with somewhere,
+ to more easily support custom args from scripts (e.g. Gitalist's
+ --git_dir)
-## The horrible hack for plugin setup - replacing it:
+## throw away the restarter and allow using the restarters Plack provides
+
+## remove per-request state from the engine instance
+
+## be smarter about how we use PSGI - not every response needs to be delayed
+ and streaming
+
+# The horrible hack for plugin setup - replacing it:
* Have a look at the Devel::REPL BEFORE_PLUGIN stuff
I wonder if what we need is that combined with plugins-as-roles
-## App / ctx split:
+# PSGI
+
+## To do at release time
+
+ - Release psgi branch of Catalyst-Devel
+ - Release new Task::Catalyst
+ - Release 5.9 branch of Catalyst-Manual
+ - Release Catalyst::Engine::HTTP::Prefork with deprecation notice
+ + exit in Makefile.PL if Catalyst > 5.89 is installed.
+
+## Blockers
+
+ * I've noticed a small difference with Catalyst::Test. The latest stable
+ version include two headers, 'host' and 'https'. They are missing from
+ this version - Pedro Melo on list
+ ^^ Cannot replicate this? Mailed back to ask for tests..
+
+# App / ctx split:
NOTE - these are notes that t0m thought up after doing back compat for
catalyst_component_class, may be inaccurate, wrong or missing things
use Catalyst::Controller;
use Data::OptList;
use Devel::InnerPackage ();
-use File::stat;
use Module::Pluggable::Object ();
use Text::SimpleTable ();
use Path::Class::Dir ();
use Class::C3::Adopt::NEXT;
use List::MoreUtils qw/uniq/;
use attributes;
+use String::RewritePrefix;
+use Catalyst::EngineLoader;
use utf8;
use Carp qw/croak carp shortmess/;
+use Try::Tiny;
+use Plack::Middleware::Conditional;
+use Plack::Middleware::ReverseProxy;
+use Plack::Middleware::IIS6ScriptNameFix;
+use Plack::Middleware::LighttpdScriptNameFix;
BEGIN { require 5.008004; }
#maybe we should just make them attributes with a default?
__PACKAGE__->mk_classdata($_)
for qw/components arguments dispatcher engine log dispatcher_class
- engine_class context_class request_class response_class stats_class
- setup_finished/;
+ engine_loader context_class request_class response_class stats_class
+ setup_finished _psgi_app loading_psgi_file/;
__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
-__PACKAGE__->engine_class('Catalyst::Engine::CGI');
__PACKAGE__->request_class('Catalyst::Request');
__PACKAGE__->response_class('Catalyst::Response');
__PACKAGE__->stats_class('Catalyst::Stats');
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.80033';
+our $VERSION = '5.90004';
sub import {
my ( $class, @arguments ) = @_;
use Catalyst qw/-Debug/; # include plugins here as well
### In lib/MyApp/Controller/Root.pm (autocreated)
- sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
+ sub foo : Chained('/') Args() { # called for /foo, /foo/1, /foo/1/2, etc.
my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
$c->stash->{template} = 'foo.tt'; # set the template
# lookup something from db -- stash vars are passed to TT
[% END %]
# called for /bar/of/soap, /bar/of/soap/10, etc.
- sub bar : Path('/bar/of/soap') { ... }
-
- # called for all actions, from the top-most controller downwards
- sub auto : Private {
- my ( $self, $c ) = @_;
- if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
- $c->res->redirect( '/login' ); # require login
- return 0; # abort request and go immediately to end()
- }
- return 1; # success; carry on to next action
- }
+ sub bar : Chained('/') PathPart('/bar/of/soap') Args() { ... }
# called after all actions are finished
- sub end : Private {
+ sub end : Action {
my ( $self, $c ) = @_;
if ( scalar @{ $c->error } ) { ... } # handle errors
return if $c->res->body; # already have a response
$c->forward( 'MyApp::View::TT' ); # render template
}
- ### in MyApp/Controller/Foo.pm
- # called for /foo/bar
- sub bar : Local { ... }
-
- # called for /blargle
- sub blargle : Global { ... }
-
- # an index action matches /foo, but not /foo/1, etc.
- sub index : Private { ... }
-
- ### in MyApp/Controller/Foo/Bar.pm
- # called for /foo/bar/baz
- sub baz : Local { ... }
-
- # first Root auto is called, then Foo auto, then this
- sub auto : Private { ... }
-
- # powerful regular expression paths are also possible
- sub details : Regex('^product/(\w+)/details$') {
- my ( $self, $c ) = @_;
- # extract the (\w+) from the URI
- my $product = $c->req->captures->[0];
- }
-
See L<Catalyst::Manual::Intro> for additional information.
=head1 DESCRIPTION
+Fully::Qualified::Plugin::Name
/;
-Special flags like C<-Debug> and C<-Engine> can also be specified as
+Special flags like C<-Debug> can also be specified as
arguments when Catalyst is loaded:
use Catalyst qw/-Debug My::Module/;
This sets the log level to 'debug' and enables full debug output on the
error screen. If you only want the latter, see L<< $c->debug >>.
-=head2 -Engine
-
-Forces Catalyst to use a specific engine. Omit the
-C<Catalyst::Engine::> prefix of the engine name, i.e.:
-
- use Catalyst qw/-Engine=CGI/;
-
=head2 -Home
Forces Catalyst to use a specific home directory, e.g.:
MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
If none of these are set, Catalyst will attempt to automatically detect the
-home directory. If you are working in a development envirnoment, Catalyst
+home directory. If you are working in a development environment, Catalyst
will try and find the directory containing either Makefile.PL, Build.PL or
dist.ini. If the application has been installed into the system (i.e.
you have done C<make install>), then Catalyst will use the path to your
-application module, without the .pm extension (ie, /foo/MyApp if your
+application module, without the .pm extension (e.g., /foo/MyApp if your
application was installed at /foo/MyApp.pm)
=head2 -Log
Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
an C<< eval { } >> around the call (actually
-L<< execute|/"$c->execute( $class, $coderef )" >> does), thus de-fatalizing
-all 'dies' within the called action. If you want C<die> to propagate you
-need to do something like:
+L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all
+exceptions thrown by the called action non-fatal and pushing them onto
+$c->error instead. If you want C<die> to propagate you need to do something
+like:
$c->forward('foo');
die join "\n", @{ $c->error } if @{ $c->error };
when they are invoked within the visited action. This is different from the
behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
continues to use the $c->action object from the caller action even when
-invoked from the callee.
+invoked from the called action.
C<< $c->stash >> is kept unchanged.
else { return Path::Class::File->new( $c->config->{home}, @path ) }
}
-=head2 $c->plugin( $name, $class, @args )
-
-Helper method for plugins. It creates a class data accessor/mutator and
-loads and instantiates the given class.
-
- MyApp->plugin( 'prototype', 'HTML::Prototype' );
-
- $c->prototype->define_javascript_functions;
-
-B<Note:> This method of adding plugins is deprecated. The ability
-to add plugins like this B<will be removed> in a Catalyst 5.81.
-Please do not use this functionality in new code.
-
-=cut
-
sub plugin {
my ( $class, $name, $plugin, @args ) = @_;
# See block comment in t/unit_core_plugin.t
- $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
+ $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in a future release/);
$class->_register_plugin( $plugin, 1 );
$class->setup_log( delete $flags->{log} );
$class->setup_plugins( delete $flags->{plugins} );
$class->setup_dispatcher( delete $flags->{dispatcher} );
- $class->setup_engine( delete $flags->{engine} );
+ if (my $engine = delete $flags->{engine}) {
+ $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading");
+ }
+ $class->setup_engine();
$class->setup_stats( delete $flags->{stats} );
for my $flag ( sort keys %{$flags} ) {
if ( !$response->has_body ) {
# Add a default body if none is already present
- $response->body(
- qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
- );
+ $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">
+ <head>
+ <title>Moved</title>
+ </head>
+ <body>
+ <p>This item has moved <a href="$location">here</a>.</p>
+ </body>
+</html>
+EOF
+ $response->content_type('text/html; charset=utf-8');
}
}
# get the length from a filehandle
if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
{
- my $stat = stat $response->body;
- if ( $stat && $stat->size > 0 ) {
- $response->content_length( $stat->size );
+ my $size = -s $response->body;
+ if ( $size ) {
+ $response->content_length( $size );
}
else {
$c->log->warn('Serving filehandle without a content-length');
# Always expect worst case!
my $status = -1;
- eval {
+ try {
if ($class->debug) {
my $secs = time - $START || 1;
my $av = sprintf '%.3f', $COUNT / $secs;
my $c = $class->prepare(@arguments);
$c->dispatch;
$status = $c->finalize;
- };
-
- if ( my $error = $@ ) {
- chomp $error;
- $class->log->error(qq/Caught exception in engine "$error"/);
}
+ catch {
+ chomp(my $error = $_);
+ $class->log->error(qq/Caught exception in engine "$error"/);
+ };
$COUNT++;
return $status;
}
-=head2 $c->prepare( @arguments )
+=head2 $class->prepare( @arguments )
Creates a Catalyst context from an engine-specific request (Apache, CGI,
etc.).
$c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
}
- #XXX reuse coderef from can
- # Allow engine to direct the prepare flow (for POE)
- if ( $c->engine->can('prepare') ) {
- $c->engine->prepare( $c, @arguments );
- }
- else {
- $c->prepare_request(@arguments);
- $c->prepare_connection;
- $c->prepare_query_parameters;
- $c->prepare_headers;
- $c->prepare_cookies;
- $c->prepare_path;
-
- # Prepare the body for reading, either by prepare_body
- # or the user, if they are using $c->read
- $c->prepare_read;
-
- # Parse the body unless the user wants it on-demand
- unless ( ref($c)->config->{parse_on_demand} ) {
- $c->prepare_body;
+ try {
+ # Allow engine to direct the prepare flow (for POE)
+ if ( my $prepare = $c->engine->can('prepare') ) {
+ $c->engine->$prepare( $c, @arguments );
+ }
+ else {
+ $c->prepare_request(@arguments);
+ $c->prepare_connection;
+ $c->prepare_query_parameters;
+ $c->prepare_headers;
+ $c->prepare_cookies;
+ $c->prepare_path;
+
+ # Prepare the body for reading, either by prepare_body
+ # or the user, if they are using $c->read
+ $c->prepare_read;
+
+ # Parse the body unless the user wants it on-demand
+ unless ( ref($c)->config->{parse_on_demand} ) {
+ $c->prepare_body;
+ }
}
}
+ # VERY ugly and probably shouldn't rely on ->finalize actually working
+ catch {
+ # failed prepare is always due to an invalid request, right?
+ $c->response->status(400);
+ $c->response->content_type('text/plain');
+ $c->response->body('Bad Request');
+ $c->finalize;
+ die $_;
+ };
my $method = $c->req->method || '';
my $path = $c->req->path;
=head2 $c->log_response_headers($headers);
-Hook method which can be wrapped by plugins to log the responseheaders.
+Hook method which can be wrapped by plugins to log the response headers.
No-op in the default implementation.
=cut
=cut
-sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
+sub run {
+ my $app = shift;
+ $app->engine_loader->needs_psgi_engine_compat_hack ?
+ $app->engine->run($app, @_) :
+ $app->engine->run( $app, $app->_finalized_psgi_app, @_ );
+}
=head2 $c->set_action( $action, $code, $namespace, $attrs )
=cut
-sub setup_engine {
- my ( $class, $engine ) = @_;
+sub engine_class {
+ my ($class, $requested_engine) = @_;
- if ($engine) {
- $engine = 'Catalyst::Engine::' . $engine;
+ if (!$class->engine_loader || $requested_engine) {
+ $class->engine_loader(
+ Catalyst::EngineLoader->new({
+ application_name => $class,
+ (defined $requested_engine
+ ? (catalyst_engine_class => $requested_engine) : ()),
+ }),
+ );
}
- if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
- $engine = 'Catalyst::Engine::' . $env;
- }
+ $class->engine_loader->catalyst_engine_class;
+}
- if ( $ENV{MOD_PERL} ) {
- my $meta = Class::MOP::get_metaclass_by_name($class);
+sub setup_engine {
+ my ($class, $requested_engine) = @_;
- # create the apache method
- $meta->add_method('apache' => sub { shift->engine->apache });
+ my $engine = do {
+ my $loader = $class->engine_loader;
- my ( $software, $version ) =
- $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
+ if (!$loader || $requested_engine) {
+ $loader = Catalyst::EngineLoader->new({
+ application_name => $class,
+ (defined $requested_engine
+ ? (requested_engine => $requested_engine) : ()),
+ }),
- $version =~ s/_//g;
- $version =~ s/(\.[^.]+)\./$1/g;
+ $class->engine_loader($loader);
+ }
- if ( $software eq 'mod_perl' ) {
+ $loader->catalyst_engine_class;
+ };
- if ( !$engine ) {
+ # Don't really setup_engine -- see _setup_psgi_app for explanation.
+ return if $class->loading_psgi_file;
- if ( $version >= 1.99922 ) {
- $engine = 'Catalyst::Engine::Apache2::MP20';
- }
+ Class::MOP::load_class($engine);
- elsif ( $version >= 1.9901 ) {
- $engine = 'Catalyst::Engine::Apache2::MP19';
- }
+ if ($ENV{MOD_PERL}) {
+ my $apache = $class->engine_loader->auto;
- elsif ( $version >= 1.24 ) {
- $engine = 'Catalyst::Engine::Apache::MP13';
- }
+ my $meta = find_meta($class);
+ my $was_immutable = $meta->is_immutable;
+ my %immutable_options = $meta->immutable_options;
+ $meta->make_mutable if $was_immutable;
- else {
- Catalyst::Exception->throw( message =>
- qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
- }
+ $meta->add_method(handler => sub {
+ my $r = shift;
+ my $psgi_app = $class->psgi_app;
+ $apache->call_app($r, $psgi_app);
+ });
- }
+ $meta->make_immutable(%immutable_options) if $was_immutable;
+ }
- # install the correct mod_perl handler
- if ( $version >= 1.9901 ) {
- *handler = sub : method {
- shift->handle_request(@_);
- };
- }
- else {
- *handler = sub ($$) { shift->handle_request(@_) };
- }
+ $class->engine( $engine->new );
- }
+ return;
+}
- elsif ( $software eq 'Zeus-Perl' ) {
- $engine = 'Catalyst::Engine::Zeus';
- }
+sub _finalized_psgi_app {
+ my ($app) = @_;
- else {
- Catalyst::Exception->throw(
- message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
- }
+ unless ($app->_psgi_app) {
+ my $psgi_app = $app->_setup_psgi_app;
+ $app->_psgi_app($psgi_app);
}
- unless ($engine) {
- $engine = $class->engine_class;
- }
+ return $app->_psgi_app;
+}
- Class::MOP::load_class($engine);
+sub _setup_psgi_app {
+ my ($app) = @_;
- # check for old engines that are no longer compatible
- my $old_engine;
- if ( $engine->isa('Catalyst::Engine::Apache')
- && !Catalyst::Engine::Apache->VERSION )
- {
- $old_engine = 1;
- }
+ for my $home (Path::Class::Dir->new($app->config->{home})) {
+ my $psgi_file = $home->file(
+ Catalyst::Utils::appprefix($app) . '.psgi',
+ );
- elsif ( $engine->isa('Catalyst::Engine::Server::Base')
- && Catalyst::Engine::Server->VERSION le '0.02' )
- {
- $old_engine = 1;
- }
+ next unless -e $psgi_file;
- elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
- && $engine->VERSION eq '0.01' )
- {
- $old_engine = 1;
- }
+ # If $psgi_file calls ->setup_engine, it's doing so to load
+ # Catalyst::Engine::PSGI. But if it does that, we're only going to
+ # throw away the loaded PSGI-app and load the 5.9 Catalyst::Engine
+ # anyway. So set a flag (ick) that tells setup_engine not to populate
+ # $c->engine or do any other things we might regret.
- elsif ($engine->isa('Catalyst::Engine::Zeus')
- && $engine->VERSION eq '0.01' )
- {
- $old_engine = 1;
- }
+ $app->loading_psgi_file(1);
+ my $psgi_app = Plack::Util::load_psgi($psgi_file);
+ $app->loading_psgi_file(0);
- if ($old_engine) {
- Catalyst::Exception->throw( message =>
- qq/Engine "$engine" is not supported by this version of Catalyst/
- );
+ return $psgi_app
+ unless $app->engine_loader->needs_psgi_engine_compat_hack;
+
+ warn <<"EOW";
+Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}.
+
+Its content has been ignored. Please consult the Catalyst::Upgrading
+documentation on how to upgrade from Catalyst::Engine::PSGI.
+EOW
}
- # engine instance
- $class->engine( $engine->new );
+ return $app->apply_default_middlewares($app->psgi_app);
+}
+
+=head2 $c->apply_default_middlewares
+
+Adds the following L<Plack> middlewares to your application, since they are
+useful and commonly needed:
+
+L<Plack::Middleware::ReverseProxy>, (conditionally added based on the status
+of your $ENV{REMOTE_ADDR}, and can be forced on with C<using_frontend_proxy>
+or forced off with C<ignore_frontend_proxy>), L<Plack::Middleware::LighttpdScriptNameFix>
+(if you are using Lighttpd), L<Plack::Middleware::IIS6ScriptNameFix> (always
+applied since this middleware is smart enough to conditionally apply itself).
+
+Additionally if we detect we are using Nginx, we add a bit of custom middleware
+to solve some problems with the way that server handles $ENV{PATH_INFO} and
+$ENV{SCRIPT_NAME}
+
+=cut
+
+
+sub apply_default_middlewares {
+ my ($app, $psgi_app) = @_;
+
+ $psgi_app = Plack::Middleware::Conditional->wrap(
+ $psgi_app,
+ builder => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) },
+ condition => sub {
+ my ($env) = @_;
+ return if $app->config->{ignore_frontend_proxy};
+ return $env->{REMOTE_ADDR} eq '127.0.0.1'
+ || $app->config->{using_frontend_proxy};
+ },
+ );
+
+ # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME
+ # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html
+ $psgi_app = Plack::Middleware::LighttpdScriptNameFix->wrap($psgi_app);
+
+ # we're applying this unconditionally as the middleware itself already makes
+ # sure it doesn't fuck things up if it's not running under one of the right
+ # IIS versions
+ $psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app);
+
+ return $psgi_app;
+}
+
+=head2 $c->psgi_app
+
+Returns a PSGI application code reference for the catalyst application
+C<$c>. This is the bare application without any middlewares
+applied. C<${myapp}.psgi> is not taken into account.
+
+This is what you want to be using to retrieve the PSGI application code
+reference of your Catalyst application for use in F<.psgi> files.
+
+=cut
+
+sub psgi_app {
+ my ($app) = @_;
+ return $app->engine->build_psgi_app($app);
}
=head2 $c->setup_home
=head2 $c->registered_plugins
Returns a sorted list of the plugins which have either been stated in the
-import list or which have been added via C<< MyApp->plugin(@args); >>.
+import list.
If passed a given plugin name, it will report a boolean value indicating
whether or not that plugin is loaded. A fully qualified name is required if
C<parse_on_demand> - The request body (for example file uploads) will not be parsed
until it is accessed. This allows you to (for example) check authentication (and reject
-the upload) before actually recieving all the data. See L</ON-DEMAND PARSER>
+the upload) before actually receiving all the data. See L</ON-DEMAND PARSER>
=item *
=item *
-C<use_request_uri_for_path> - Controlls if the C<REQUEST_URI> or C<PATH_INFO> environment
-variable should be used for determining the request path. See L<Catalyst::Engine::CGI/PATH DECODING>
-for more information.
+C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment
+variable should be used for determining the request path.
+
+Most web server environments pass the requested path to the application using environment variables,
+from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
+exposed as C<< $c->request->base >>) and the request path below that base.
+
+There are two methods of doing this, both of which have advantages and disadvantages. Which method is used
+is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false).
+
+=over
+
+=item use_request_uri_for_path => 0
+
+This is the default (and the) traditional method that Catalyst has used for determining the path information.
+The path is generated from a combination of the C<PATH_INFO> and C<SCRIPT_NAME> environment variables.
+The allows the application to behave correctly when C<mod_rewrite> is being used to redirect requests
+into the application, as these variables are adjusted by mod_rewrite to take account for the redirect.
+
+However this method has the major disadvantage that it is impossible to correctly decode some elements
+of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot
+contain path-segment parameters. >>" This means PATH_INFO is B<always> decoded, and therefore Catalyst
+can't distinguish / vs %2F in paths (in addition to other encoded values).
+
+=item use_request_uri_for_path => 1
+
+This method uses the C<REQUEST_URI> and C<SCRIPT_NAME> environment variables. As C<REQUEST_URI> is never
+decoded, this means that applications using this mode can correctly handle URIs including the %2F character
+(i.e. with C<AllowEncodedSlashes> set to C<On> in Apache).
+
+Given that this method of path resolution is provably more correct, it is recommended that you use
+this unless you have a specific need to deploy your application in a non-standard environment, and you are
+aware of the implications of not being able to handle encoded URI paths correctly.
+
+However it also means that in a number of cases when the app isn't installed directly at a path, but instead
+is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a
+.htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed
+at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
+C<< $c->request->base >> will be incorrect.
+
+=back
=item *
=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.
=head1 AUTHOR
+=begin stopwords
+
Guillermo Roditi
+=end stopwords
+
=head1 COPYRIGHT
This library is free software. You can redistribute it and/or modify it under
This is the universal base class for Catalyst components
(Model/View/Controller).
-It provides you with a generic new() for instantiation through Catalyst's
+It provides you with a generic new() for component construction through Catalyst's
component loader with config() support and a process() method placeholder.
=cut
C<< __PACKAGE__->config >> hashref before calling C<< ->new >>
to instantiate the component.
-You can override it in your components to do custom instantiation, using
+You can override it in your components to do custom construction, using
something like this:
sub COMPONENT {
L<CatalystX::LeakChecker>
+=begin stopwords
+
=head1 AUTHOR
Florian Ragwitz E<lt>rafl@debian.orgE<gt>
+=end stopwords
+
=head1 COPYRIGHT
This library is free software. You can redistribute it and/or modify it under
%raw_attributes = (
%raw_attributes,
- exists $actions_config->{$name} ? %{ $actions_config->{$name } } : (),
+ # Note we deep copy array refs here to stop crapping on config
+ # when attributes are parsed. RT#65463
+ exists $actions_config->{$name} ? map { ref($_) eq 'ARRAY' ? [ @$_ ] : $_ } %{ $actions_config->{$name } } : (),
);
# Private actions with additional attributes will raise a warning and then
Allows you to set the attributes that the dispatcher creates actions out of.
This allows you to do 'rails style routes', or override some of the
-attribute defintions of actions composed from Roles.
+attribute definitions of actions composed from Roles.
You can set arguments globally (for all actions of the controller) and
specifically (for a single action).
=head1 DESCRIPTION
-This is an overview of the user-visible changes to Catalyst in version 5.8.
+This is an overview of the user-visible changes to Catalyst between major Catalyst releases.
-=head2 Deprecations
+=head2 VERSION 5.9XXXX 'cataplack'
+
+The Catalyst::Engine sub-classes have all been removed and deprecated,
+to be replaced with Plack handlers.
+
+Plack is an implementation of the L<PSGI> specification, which is
+a standard interface between web servers and application frameworks.
+
+This should be no different for developers, and you should not have to
+migrate your applications unless you are using a custom engine already.
+
+This change benefits Catalyst significantly by reducing the amount of
+code inside the framework, and means that the framework gets upstream
+bug fixes in L<Plack>, and automatically gains support for any web server
+which a L<PSGI> compliant handler is written for.
+
+It also allows you more flexibility with your application, and allows
+the use of cross web framework 'middleware'.
+
+Developers are recommended to read L<Catalyst::Upgrading> for notes about
+upgrading, especially if you are using an unusual deployment method.
+
+Documentation for how to take advantage of L<PSGI> can be found in
+L<Catalyst::PSGI>, and information about deploying your application
+has been moved to L<Catalyst::Manual::Deployment>.
+
+=head3 Updated modules:
+
+A number of modules have been updated to pass their tests or not
+produce deprecation warnings with the latest version of Catalyst.
+It is recommended that you upgrade any of these that you are using
+after installing this version of Catalyst.
+
+These extensions are:
+
+=over
+
+=item L<Catalyst::Engine::HTTP::Prefork>
+
+This is now deprecated, see L<Catalyst::Upgrading>.
+
+=item L<Test::WWW::Mechanize::Catalyst>
+
+Has been updated to not produce deprecation warnings, upgrade recommended.
+
+=item Catalyst::ActionRole::ACL
+
+Has been updated to fix failing tests (although older versions still
+function perfectly with this version of Catalyst).
+
+=item Catalyst::Plugin::Session::Store::DBIC
+
+Has been updated to fix failing tests (although older versions still
+function perfectly with this version of Catalyst).
+
+=item Catalyst::Plugin::Authentication
+
+Has been updated to fix failing tests (although older versions still
+function perfectly with this version of Catalyst).
+
+=back
+
+=head1 PREVIOUS VERSIONS
+
+=head2 VERSION 5.8XXXX 'catamoose'
+
+=head3 Deprecations
Please see L<Catalyst::Upgrading> for a full description of how changes in the
framework may affect your application.
=back
-=head2 New features
+=head3 New features
=head3 Dispatcher
=back
-=head2 Consequences of the Moose back end
+=head3 Consequences of the Moose back end
=over
=back
-=head2 Bug fixes
+=head3 Bug fixes
=over
=head2 $self->setup_actions( $class, $context )
-Loads all of the preload dispatch types, registers their actions and then
-loads all of the postload dispatch types, and iterates over the tree of
+Loads all of the pre-load dispatch types, registers their actions and then
+loads all of the post-load dispatch types, and iterates over the tree of
actions, displaying the debug information if appropriate.
=cut
$package_hash{$class}++ || do {
warn("Class $class is calling the deprecated method\n"
. " Catalyst::Dispatcher::$public_method_name,\n"
- . " this will be removed in Catalyst 5.9X\n");
+ . " this will be removed in Catalyst 5.9\n");
};
});
}
use HTTP::Body;
use HTTP::Headers;
use URI::QueryParam;
+use Moose::Util::TypeConstraints;
+use Plack::Loader;
+use Catalyst::EngineLoader;
use Encode ();
use utf8;
use namespace::clean -except => 'meta';
-has env => (is => 'rw', writer => '_set_env');
+has env => (is => 'ro', writer => '_set_env', clearer => '_clear_env');
+
+my $WARN_ABOUT_ENV = 0;
+around env => sub {
+ my ($orig, $self, @args) = @_;
+ if(@args) {
+ warn "env as a writer is deprecated, you probably need to upgrade Catalyst::Engine::PSGI"
+ unless $WARN_ABOUT_ENV++;
+ return $self->_set_env(@args);
+ }
+ return $self->$orig;
+};
# input position and length
has read_length => (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;
else {
$self->write( $c, $body );
}
+
+ $self->_writer->close;
+ $self->_clear_writer;
+ $self->_clear_env;
+
+ return;
}
=head2 $self->finalize_cookies($c)
=cut
-sub finalize_headers { }
+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;
+
+ return;
+}
=head2 $self->finalize_read($c)
=cut
-sub prepare_connection { }
+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)
=cut
-sub prepare_headers { }
+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});
+ }
+}
=head2 $self->prepare_parameters($c)
=cut
-sub prepare_path { }
+sub prepare_path {
+ my ($self, $ctx) = @_;
+
+ my $env = $self->env;
+
+ my $scheme = $ctx->request->secure ? 'https' : 'http';
+ my $host = $env->{HTTP_HOST} || $env->{SERVER_NAME};
+ my $port = $env->{SERVER_PORT} || 80;
+ my $base_path = $env->{SCRIPT_NAME} || "/";
+
+ # set the request URI
+ my $path;
+ if (!$ctx->config->{use_request_uri_for_path}) {
+ my $path_info = $env->{PATH_INFO};
+ if ( exists $env->{REDIRECT_URL} ) {
+ $base_path = $env->{REDIRECT_URL};
+ $base_path =~ s/\Q$path_info\E$//;
+ }
+ $path = $base_path . $path_info;
+ $path =~ s{^/+}{};
+ $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
+ $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
+ }
+ else {
+ my $req_uri = $env->{REQUEST_URI};
+ $req_uri =~ s/\?.*$//;
+ $path = $req_uri;
+ $path =~ s{^/+}{};
+ }
+
+ # Using URI directly is way too slow, so we construct the URLs manually
+ my $uri_class = "URI::$scheme";
+
+ # HTTP_HOST will include the port even if it's 80/443
+ $host =~ s/:(?:80|443)$//;
+
+ if ($port !~ /^(?:80|443)$/ && $host !~ /:/) {
+ $host .= ":$port";
+ }
+
+ my $query = $env->{QUERY_STRING} ? '?' . $env->{QUERY_STRING} : '';
+ my $uri = $scheme . '://' . $host . '/' . $path . $query;
+
+ $ctx->request->uri( (bless \$uri, $uri_class)->canonical );
+
+ # set the base URI
+ # base must end in a slash
+ $base_path .= '/' unless $base_path =~ m{/$};
+
+ my $base_uri = $scheme . '://' . $host . $base_path;
+
+ $ctx->request->base( bless \$base_uri, $uri_class );
+
+ return;
+}
=head2 $self->prepare_request($c)
=cut
sub prepare_query_parameters {
- my ( $self, $c, $query_string ) = @_;
+ my ($self, $c) = @_;
+
+ my $query_string = exists $self->env->{QUERY_STRING}
+ ? $self->env->{QUERY_STRING}
+ : '';
# Check for keywords (no = signs)
# (yes, index() is faster than a regex :))
=cut
-sub prepare_request { }
+sub prepare_request {
+ my ($self, $ctx, %args) = @_;
+ $self->_set_env($args{env});
+}
=head2 $self->prepare_uploads($c)
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. FIXME - Warn in the log here?
+ # said there should be.
$self->finalize_read;
return;
}
=cut
-sub read_chunk { }
+sub read_chunk {
+ my ($self, $ctx) = (shift, shift);
+ return $self->env->{'psgi.input'}->read(@_);
+}
=head2 $self->read_length
The amount of input data that has already been read.
-=head2 $self->run($c)
+=head2 $self->run($app, $server)
-Start the engine. Implemented by the various engine classes.
+Start the engine. Builds a PSGI application and calls the
+run method on the server passed in, which then causes the
+engine to loop, handling requests..
=cut
-sub run { }
+sub run {
+ my ($self, $app, $psgi, @args) = @_;
+ # @args left here rather than just a $options, $server for back compat with the
+ # old style scripts which send a few args, then a hashref
+
+ # They should never actually be used in the normal case as the Plack engine is
+ # passed in got all the 'standard' args via the loader in the script already.
+
+ # FIXME - we should stash the options in an attribute so that custom args
+ # like Gitalist's --git_dir are possible to get from the app without stupid tricks.
+ my $server = pop @args if (scalar @args && blessed $args[-1]);
+ my $options = pop @args if (scalar @args && ref($args[-1]) eq 'HASH');
+ # Back compat hack for applications with old (non Catalyst::Script) scripts to work in FCGI.
+ if (scalar @args && !ref($args[0])) {
+ if (my $listen = shift @args) {
+ $options->{listen} ||= [$listen];
+ }
+ }
+ if (! $server ) {
+ $server = Catalyst::EngineLoader->new(application_name => ref($self))->auto(%$options);
+ # We're not being called from a script, so auto detect what backend to
+ # run on. This should never happen, as mod_perl never calls ->run,
+ # instead the $app->handle method is called per request.
+ $app->log->warn("Not supplied a Plack engine, falling back to engine auto-loader (are your scripts ancient?)")
+ }
+ $server->run($psgi, $options);
+}
+
+=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.
+
+=cut
+
+sub build_psgi_app {
+ my ($self, $app, @args) = @_;
+
+ return sub {
+ my ($env) = @_;
+
+ return sub {
+ my ($respond) = @_;
+ $self->_set_response_cb($respond);
+ $app->handle_request(env => $env);
+ };
+ };
+}
=head2 $self->write($c, $buffer)
$self->_prepared_write(1);
}
- return 0 if !defined $buffer;
+ $buffer = q[] unless defined $buffer;
- my $len = length($buffer);
- my $wrote = syswrite STDOUT, $buffer;
-
- if ( !defined $wrote && $! == EWOULDBLOCK ) {
- # Unable to write on the first try, will retry in the loop below
- $wrote = 0;
- }
-
- if ( defined $wrote && $wrote < $len ) {
- # We didn't write the whole buffer
- while (1) {
- my $ret = syswrite STDOUT, $buffer, $CHUNKSIZE, $wrote;
- if ( defined $ret ) {
- $wrote += $ret;
- }
- else {
- next if $! == EWOULDBLOCK;
- return;
- }
-
- last if $wrote >= $len;
- }
- }
+ my $len = length($buffer);
+ $self->_writer->write($buffer);
- return $wrote;
+ return $len;
}
=head2 $self->unescape_uri($uri)
+++ /dev/null
-package Catalyst::Engine::CGI;
-
-use Moose;
-extends 'Catalyst::Engine';
-
-has _header_buf => (is => 'rw', clearer => '_clear_header_buf', predicate => '_has_header_buf');
-
-=head1 NAME
-
-Catalyst::Engine::CGI - The CGI Engine
-
-=head1 SYNOPSIS
-
-A script using the Catalyst::Engine::CGI module might look like:
-
- #!/usr/bin/perl -w
-
- use strict;
- use lib '/path/to/MyApp/lib';
- use MyApp;
-
- MyApp->run;
-
-The application module (C<MyApp>) would use C<Catalyst>, which loads the
-appropriate engine module.
-
-=head1 DESCRIPTION
-
-This is the Catalyst engine specialized for the CGI environment.
-
-=head1 PATH DECODING
-
-Most web server environments pass the requested path to the application using environment variables,
-from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
-exposed as C<< $c->request->base >>) and the request path below that base.
-
-There are two methods of doing this, both of which have advantages and disadvantages. Which method is used
-is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false).
-
-=head2 use_request_uri_for_path => 0
-
-This is the default (and the) traditional method that Catalyst has used for determining the path information.
-The path is synthesised from a combination of the C<PATH_INFO> and C<SCRIPT_NAME> environment variables.
-The allows the application to behave correctly when C<mod_rewrite> is being used to redirect requests
-into the application, as these variables are adjusted by mod_rewrite to take account for the redirect.
-
-However this method has the major disadvantage that it is impossible to correctly decode some elements
-of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot
-contain path-segment parameters. >>" This means PATH_INFO is B<always> decoded, and therefore Catalyst
-can't distinguish / vs %2F in paths (in addition to other encoded values).
-
-=head2 use_request_uri_for_path => 1
-
-This method uses the C<REQUEST_URI> and C<SCRIPT_NAME> environment variables. As C<REQUEST_URI> is never
-decoded, this means that applications using this mode can correctly handle URIs including the %2F character
-(i.e. with C<AllowEncodedSlashes> set to C<On> in Apache).
-
-Given that this method of path resolution is provably more correct, it is recommended that you use
-this unless you have a specific need to deploy your application in a non-standard environment, and you are
-aware of the implications of not being able to handle encoded URI paths correctly.
-
-However it also means that in a number of cases when the app isn't installed directly at a path, but instead
-is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a
-.htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed
-at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
-C<< $c->request->base >> will be incorrect.
-
-=head1 OVERLOADED METHODS
-
-This class overloads some methods from C<Catalyst::Engine>.
-
-=head2 $self->finalize_headers($c)
-
-=cut
-
-sub finalize_headers {
- my ( $self, $c ) = @_;
-
- $c->response->header( Status => $c->response->status );
-
- $self->_header_buf($c->response->headers->as_string("\015\012") . "\015\012");
-}
-
-=head2 $self->prepare_connection($c)
-
-=cut
-
-sub prepare_connection {
- my ( $self, $c ) = @_;
- local (*ENV) = $self->env || \%ENV;
-
- my $request = $c->request;
- $request->address( $ENV{REMOTE_ADDR} );
-
- PROXY_CHECK:
- {
- unless ( ref($c)->config->{using_frontend_proxy} ) {
- last PROXY_CHECK if $ENV{REMOTE_ADDR} ne '127.0.0.1';
- last PROXY_CHECK if ref($c)->config->{ignore_frontend_proxy};
- }
- last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_FOR};
-
- # If we are running as a backend server, the user will always appear
- # as 127.0.0.1. Select the most recent upstream IP (last in the list)
- my ($ip) = $ENV{HTTP_X_FORWARDED_FOR} =~ /([^,\s]+)$/;
- $request->address($ip);
- if ( defined $ENV{HTTP_X_FORWARDED_PORT} ) {
- $ENV{SERVER_PORT} = $ENV{HTTP_X_FORWARDED_PORT};
- }
- }
-
- $request->hostname( $ENV{REMOTE_HOST} ) if exists $ENV{REMOTE_HOST};
- $request->protocol( $ENV{SERVER_PROTOCOL} );
- $request->user( $ENV{REMOTE_USER} ); # XXX: Deprecated. See Catalyst::Request for removal information
- $request->remote_user( $ENV{REMOTE_USER} );
- $request->method( $ENV{REQUEST_METHOD} );
-
- if ( $ENV{HTTPS} && uc( $ENV{HTTPS} ) eq 'ON' ) {
- $request->secure(1);
- }
-
- if ( $ENV{SERVER_PORT} == 443 ) {
- $request->secure(1);
- }
- binmode(STDOUT); # Ensure we are sending bytes.
-}
-
-=head2 $self->prepare_headers($c)
-
-=cut
-
-sub prepare_headers {
- my ( $self, $c ) = @_;
- local (*ENV) = $self->env || \%ENV;
- my $headers = $c->request->headers;
- # Read headers from %ENV
- foreach my $header ( keys %ENV ) {
- next unless $header =~ /^(?:HTTP|CONTENT|COOKIE)/i;
- ( my $field = $header ) =~ s/^HTTPS?_//;
- $headers->header( $field => $ENV{$header} );
- }
-}
-
-=head2 $self->prepare_path($c)
-
-=cut
-
-# Please don't touch this method without adding tests in
-# t/aggregate/unit_core_engine_cgi-prepare_path.t
-sub prepare_path {
- my ( $self, $c ) = @_;
- local (*ENV) = $self->env || \%ENV;
-
- my $scheme = $c->request->secure ? 'https' : 'http';
- my $host = $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
- my $port = $ENV{SERVER_PORT} || 80;
-
- # fix up for IIS
- if ($ENV{SERVER_SOFTWARE} && $ENV{SERVER_SOFTWARE} =~ m{IIS/[6-9]\.\d}) {
- $ENV{PATH_INFO} =~ s/^\Q$ENV{SCRIPT_NAME}\E//;
- }
-
- my $script_name = $ENV{SCRIPT_NAME};
- $script_name =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go if $script_name;
-
- my $base_path;
- if ( exists $ENV{REDIRECT_URL} ) {
- $base_path = $ENV{REDIRECT_URL};
- $base_path =~ s/\Q$ENV{PATH_INFO}\E$//;
- }
- else {
- $base_path = $script_name || '/';
- }
-
- # If we are running as a backend proxy, get the true hostname
- PROXY_CHECK:
- {
- unless ( ref($c)->config->{using_frontend_proxy} ) {
- last PROXY_CHECK if $host !~ /localhost|127.0.0.1/;
- last PROXY_CHECK if ref($c)->config->{ignore_frontend_proxy};
- }
- last PROXY_CHECK unless $ENV{HTTP_X_FORWARDED_HOST};
-
- $host = $ENV{HTTP_X_FORWARDED_HOST};
-
- # backend could be on any port, so
- # assume frontend is on the default port
- $port = $c->request->secure ? 443 : 80;
- if ( $ENV{HTTP_X_FORWARDED_PORT} ) {
- $port = $ENV{HTTP_X_FORWARDED_PORT};
- }
- }
-
- my $path_info = $ENV{PATH_INFO};
- if ($c->config->{use_request_uri_for_path}) {
- # RFC 3875: "Unlike a URI path, the PATH_INFO is not URL-encoded,
- # and cannot contain path-segment parameters." This means PATH_INFO
- # is always decoded, and the script can't distinguish / vs %2F.
- # See https://issues.apache.org/bugzilla/show_bug.cgi?id=35256
- # Here we try to resurrect the original encoded URI from REQUEST_URI.
- if (my $req_uri = $ENV{REQUEST_URI}) {
- if (defined $script_name) {
- $req_uri =~ s/^\Q$script_name\E//;
- }
- $req_uri =~ s/\?.*$//;
- $path_info = $req_uri if $req_uri;
- }
- }
-
- # set the request URI
- my $path = $base_path . ( $path_info || '' );
- $path =~ s{^/+}{};
-
- # Using URI directly is way too slow, so we construct the URLs manually
- my $uri_class = "URI::$scheme";
-
- # HTTP_HOST will include the port even if it's 80/443
- $host =~ s/:(?:80|443)$//;
-
- if ( $port !~ /^(?:80|443)$/ && $host !~ /:/ ) {
- $host .= ":$port";
- }
-
- # Escape the path
- $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
- $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
-
- my $query = $ENV{QUERY_STRING} ? '?' . $ENV{QUERY_STRING} : '';
- my $uri = $scheme . '://' . $host . '/' . $path . $query;
-
- $c->request->uri( bless(\$uri, $uri_class)->canonical );
-
- # set the base URI
- # base must end in a slash
- $base_path .= '/' unless $base_path =~ m{/$};
-
- my $base_uri = $scheme . '://' . $host . $base_path;
-
- $c->request->base( bless \$base_uri, $uri_class );
-}
-
-=head2 $self->prepare_query_parameters($c)
-
-=cut
-
-around prepare_query_parameters => sub {
- my $orig = shift;
- my ( $self, $c ) = @_;
- local (*ENV) = $self->env || \%ENV;
-
- if ( $ENV{QUERY_STRING} ) {
- $self->$orig( $c, $ENV{QUERY_STRING} );
- }
-};
-
-=head2 $self->prepare_request($c, (env => \%env))
-
-=cut
-
-sub prepare_request {
- my ( $self, $c, %args ) = @_;
-
- if ( $args{env} ) {
- $self->_set_env( $args{env} );
- }
-}
-
-=head2 $self->prepare_write($c)
-
-Enable autoflush on the output handle for CGI-based engines.
-
-=cut
-
-around prepare_write => sub {
- *STDOUT->autoflush(1);
- return shift->(@_);
-};
-
-=head2 $self->write($c, $buffer)
-
-Writes the buffer to the client.
-
-=cut
-
-around write => sub {
- my $orig = shift;
- my ( $self, $c, $buffer ) = @_;
-
- # Prepend the headers if they have not yet been sent
- if ( $self->_has_header_buf ) {
- my $headers = $self->_clear_header_buf;
-
- $buffer = defined $buffer
- ? $headers . $buffer : $headers;
- }
-
- return $self->$orig( $c, $buffer );
-};
-
-=head2 $self->read_chunk($c, $buffer, $length)
-
-=cut
-
-sub read_chunk { shift; shift; *STDIN->sysread(@_); }
-
-=head2 $self->run
-
-=cut
-
-sub run { shift; shift->handle_request( env => \%ENV ) }
-
-=head1 SEE ALSO
-
-L<Catalyst>, L<Catalyst::Engine>
-
-=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;
-
-1;
+++ /dev/null
-package Catalyst::Engine::FastCGI;
-
-use Moose;
-extends 'Catalyst::Engine::CGI';
-
-# eval { Class::MOP::load_class("FCGI") };
-eval "use FCGI";
-die "Unable to load the FCGI module, you may need to install it:\n$@\n" if $@;
-
-=head1 NAME
-
-Catalyst::Engine::FastCGI - FastCGI Engine
-
-=head1 DESCRIPTION
-
-This is the FastCGI engine.
-
-=head1 OVERLOADED METHODS
-
-This class overloads some methods from C<Catalyst::Engine::CGI>.
-
-=head2 $self->run($c, $listen, { option => value, ... })
-
-Starts the FastCGI server. If C<$listen> is set, then it specifies a
-location to listen for FastCGI requests;
-
-=over 4
-
-=item /path
-
-listen via Unix sockets on /path
-
-=item :port
-
-listen via TCP on port on all interfaces
-
-=item hostname:port
-
-listen via TCP on port bound to hostname
-
-=back
-
-Options may also be specified;
-
-=over 4
-
-=item leave_umask
-
-Set to 1 to disable setting umask to 0 for socket open
-
-=item nointr
-
-Do not allow the listener to be interrupted by Ctrl+C
-
-=item nproc
-
-Specify a number of processes for FCGI::ProcManager
-
-=item pidfile
-
-Specify a filename for the pid file
-
-=item manager
-
-Specify a FCGI::ProcManager sub-class
-
-=item detach
-
-Detach from console
-
-=item keep_stderr
-
-Send STDERR to STDOUT instead of the webserver
-
-=back
-
-=cut
-
-sub run {
- my ( $self, $class, $listen, $options ) = @_;
-
- my $sock = 0;
- if ($listen) {
- my $old_umask = umask;
- unless ( $options->{leave_umask} ) {
- umask(0);
- }
- $sock = FCGI::OpenSocket( $listen, 100 )
- or die "failed to open FastCGI socket; $!";
- unless ( $options->{leave_umask} ) {
- umask($old_umask);
- }
- }
- elsif ( $^O ne 'MSWin32' ) {
- -S STDIN
- or die "STDIN is not a socket; specify a listen location";
- }
-
- $options ||= {};
-
- my %env;
- my $error = \*STDERR; # send STDERR to the web server
- $error = \*STDOUT # send STDERR to stdout (a logfile)
- if $options->{keep_stderr}; # (if asked to)
-
- my $request =
- FCGI::Request( \*STDIN, \*STDOUT, $error, \%env, $sock,
- ( $options->{nointr} ? 0 : &FCGI::FAIL_ACCEPT_ON_INTR ),
- );
-
- my $proc_manager;
-
- if ($listen) {
- $options->{manager} ||= "FCGI::ProcManager";
- $options->{nproc} ||= 1;
- $options->{proc_title} ||= "perl-fcgi-pm [$class]";
-
- $self->daemon_fork() if $options->{detach};
-
- if ( $options->{manager} ) {
- eval "use $options->{manager}; 1" or die $@;
-
- $proc_manager = $options->{manager}->new(
- {
- n_processes => $options->{nproc},
- pid_fname => $options->{pidfile},
- pm_title => $options->{proc_title},
- }
- );
-
- # detach *before* the ProcManager inits
- $self->daemon_detach() if $options->{detach};
-
- $proc_manager->pm_manage();
-
- # Give each child its own RNG state.
- srand;
- }
- elsif ( $options->{detach} ) {
- $self->daemon_detach();
- }
- }
-
- while ( $request->Accept >= 0 ) {
- $proc_manager && $proc_manager->pm_pre_dispatch();
-
- $self->_fix_env( \%env );
-
- $class->handle_request( env => \%env );
-
- $proc_manager && $proc_manager->pm_post_dispatch();
- }
-}
-
-=head2 $self->write($c, $buffer)
-
-=cut
-
-sub write {
- my ( $self, $c, $buffer ) = @_;
-
- # ->write will be called once with the body, even in a redirect (and
- # in that case, the body is undef)
- $buffer = '' if !defined $buffer;
-
- unless ( $self->_prepared_write ) {
- $self->prepare_write($c);
- $self->_prepared_write(1);
- }
-
- # XXX: We can't use Engine's write() method because syswrite
- # appears to return bogus values instead of the number of bytes
- # written: http://www.fastcgi.com/om_archive/mail-archive/0128.html
-
- # Prepend the headers if they have not yet been sent
- if ( $self->_has_header_buf ) {
- $buffer = $self->_clear_header_buf . $buffer;
- }
-
- # FastCGI does not stream data properly if using 'print $handle',
- # but a syswrite appears to work properly.
- *STDOUT->syswrite($buffer);
-}
-
-=head2 $self->daemon_fork()
-
-Performs the first part of daemon initialisation. Specifically,
-forking. STDERR, etc are still connected to a terminal.
-
-=cut
-
-sub daemon_fork {
- require POSIX;
- fork && exit;
-}
-
-=head2 $self->daemon_detach( )
-
-Performs the second part of daemon initialisation. Specifically,
-disassociates from the terminal.
-
-However, this does B<not> change the current working directory to "/",
-as normal daemons do. It also does not close all open file
-descriptors (except STDIN, STDOUT and STDERR, which are re-opened from
-F</dev/null>).
-
-=cut
-
-sub daemon_detach {
- my $self = shift;
- print "FastCGI daemon started (pid $$)\n";
- open STDIN, "+</dev/null" or die $!;
- open STDOUT, ">&STDIN" or die $!;
- open STDERR, ">&STDIN" or die $!;
- POSIX::setsid();
-}
-
-=head2 $self->_fix_env( $env )
-
-Adjusts the environment variables when necessary.
-
-=cut
-
-sub _fix_env
-{
- my $self = shift;
- my $env = shift;
-
- # we are gonna add variables from current system environment %ENV to %env
- # that contains at this moment just variables taken from FastCGI request
- foreach my $k (keys(%ENV)) {
- $env->{$k} = $ENV{$k} unless defined($env->{$k});
- }
-
- return unless ( $env->{SERVER_SOFTWARE} );
-
- # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME
- # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html
- # Thanks to Mark Blythe for this fix
- if ( $env->{SERVER_SOFTWARE} =~ /lighttpd/ ) {
- $env->{PATH_INFO} ||= delete $env->{SCRIPT_NAME};
- }
- elsif ( $env->{SERVER_SOFTWARE} =~ /^nginx/ ) {
- my $script_name = $env->{SCRIPT_NAME};
- $env->{PATH_INFO} =~ s/^$script_name//g;
- }
- # Fix the environment variables PATH_INFO and SCRIPT_NAME when running
- # under IIS
- elsif ( $env->{SERVER_SOFTWARE} =~ /IIS\/[6-9]\.[0-9]/ ) {
- my @script_name = split(m!/!, $env->{PATH_INFO});
- my @path_translated = split(m!/|\\\\?!, $env->{PATH_TRANSLATED});
- my @path_info;
-
- while ($script_name[$#script_name] eq $path_translated[$#path_translated]) {
- pop(@path_translated);
- unshift(@path_info, pop(@script_name));
- }
-
- unshift(@path_info, '', '');
-
- $env->{PATH_INFO} = join('/', @path_info);
- $env->{SCRIPT_NAME} = join('/', @script_name);
- }
-}
-
-1;
-__END__
-
-=head1 WEB SERVER CONFIGURATIONS
-
-=head2 Standalone FastCGI Server
-
-In server mode the application runs as a standalone server and accepts
-connections from a web server. The application can be on the same machine as
-the web server, on a remote machine, or even on multiple remote machines.
-Advantages of this method include running the Catalyst application as a
-different user than the web server, and the ability to set up a scalable
-server farm.
-
-To start your application in server mode, install the FCGI::ProcManager
-module and then use the included fastcgi.pl script.
-
- $ script/myapp_fastcgi.pl -l /tmp/myapp.socket -n 5
-
-Command line options for fastcgi.pl include:
-
- -d -daemon Daemonize the server.
- -p -pidfile Write a pidfile with the pid of the process manager.
- -l -listen Listen on a socket path, hostname:port, or :port.
- -n -nproc The number of processes started to handle requests.
-
-See below for the specific web server configurations for using the external
-server.
-
-=head2 Apache 1.x, 2.x
-
-Apache requires the mod_fastcgi module. The same module supports both
-Apache 1 and 2.
-
-There are three ways to run your application under FastCGI on Apache: server,
-static, and dynamic.
-
-=head3 Standalone server mode
-
- FastCgiExternalServer /tmp/myapp.fcgi -socket /tmp/myapp.socket
- Alias /myapp/ /tmp/myapp.fcgi/
-
- # Or, run at the root
- Alias / /tmp/myapp.fcgi/
-
- # Optionally, rewrite the path when accessed without a trailing slash
- RewriteRule ^/myapp$ myapp/ [R]
-
-
-The FastCgiExternalServer directive tells Apache that when serving
-/tmp/myapp to use the FastCGI application listenting on the socket
-/tmp/mapp.socket. Note that /tmp/myapp.fcgi B<MUST NOT> exist --
-it's a virtual file name. With some versions of C<mod_fastcgi> or
-C<mod_fcgid>, you can use any name you like, but some require that the
-virtual filename end in C<.fcgi>.
-
-It's likely that Apache is not configured to serve files in /tmp, so the
-Alias directive maps the url path /myapp/ to the (virtual) file that runs the
-FastCGI application. The trailing slashes are important as their use will
-correctly set the PATH_INFO environment variable used by Catalyst to
-determine the request path. If you would like to be able to access your app
-without a trailing slash (http://server/myapp), you can use the above
-RewriteRule directive.
-
-=head3 Static mode
-
-The term 'static' is misleading, but in static mode Apache uses its own
-FastCGI Process Manager to start the application processes. This happens at
-Apache startup time. In this case you do not run your application's
-fastcgi.pl script -- that is done by Apache. Apache then maps URIs to the
-FastCGI script to run your application.
-
- FastCgiServer /path/to/myapp/script/myapp_fastcgi.pl -processes 3
- Alias /myapp/ /path/to/myapp/script/myapp_fastcgi.pl/
-
-FastCgiServer tells Apache to start three processes of your application at
-startup. The Alias command maps a path to the FastCGI application. Again,
-the trailing slashes are important.
-
-=head3 Dynamic mode
-
-In FastCGI dynamic mode, Apache will run your application on demand,
-typically by requesting a file with a specific extension (e.g. .fcgi). ISPs
-often use this type of setup to provide FastCGI support to many customers.
-
-In this mode it is often enough to place or link your *_fastcgi.pl script in
-your cgi-bin directory with the extension of .fcgi. In dynamic mode Apache
-must be able to run your application as a CGI script so ExecCGI must be
-enabled for the directory.
-
- AddHandler fastcgi-script .fcgi
-
-The above tells Apache to run any .fcgi file as a FastCGI application.
-
-Here is a complete example:
-
- <VirtualHost *:80>
- ServerName www.myapp.com
- DocumentRoot /path/to/MyApp
-
- # Allow CGI script to run
- <Directory /path/to/MyApp>
- Options +ExecCGI
- </Directory>
-
- # Tell Apache this is a FastCGI application
- <Files myapp_fastcgi.pl>
- SetHandler fastcgi-script
- </Files>
- </VirtualHost>
-
-Then a request for /script/myapp_fastcgi.pl will run the
-application.
-
-For more information on using FastCGI under Apache, visit
-L<http://www.fastcgi.com/mod_fastcgi/docs/mod_fastcgi.html>
-
-=head3 Authorization header with mod_fastcgi or mod_cgi
-
-By default, mod_fastcgi/mod_cgi do not pass along the Authorization header,
-so modules like C<Catalyst::Plugin::Authentication::Credential::HTTP> will
-not work. To enable pass-through of this header, add the following
-mod_rewrite directives:
-
- RewriteCond %{HTTP:Authorization} ^(.+)
- RewriteRule ^(.*)$ $1 [E=HTTP_AUTHORIZATION:%1,PT]
-
-=head2 Lighttpd
-
-These configurations were tested with Lighttpd 1.4.7.
-
-=head3 Standalone server mode
-
- server.document-root = "/var/www/MyApp/root"
-
- fastcgi.server = (
- "" => (
- "MyApp" => (
- "socket" => "/tmp/myapp.socket",
- "check-local" => "disable"
- )
- )
- )
-
-=head3 Static mode
-
- server.document-root = "/var/www/MyApp/root"
-
- fastcgi.server = (
- "" => (
- "MyApp" => (
- "socket" => "/tmp/myapp.socket",
- "check-local" => "disable",
- "bin-path" => "/var/www/MyApp/script/myapp_fastcgi.pl",
- "min-procs" => 2,
- "max-procs" => 5,
- "idle-timeout" => 20
- )
- )
- )
-
-Note that in newer versions of lighttpd, the min-procs and idle-timeout
-values are disabled. The above example would start 5 processes.
-
-=head3 Non-root configuration
-
-You can also run your application at any non-root location with either of the
-above modes. Note the required mod_rewrite rule.
-
- url.rewrite = ( "myapp\$" => "myapp/" )
- fastcgi.server = (
- "/myapp" => (
- "MyApp" => (
- # same as above
- )
- )
- )
-
-For more information on using FastCGI under Lighttpd, visit
-L<http://www.lighttpd.net/documentation/fastcgi.html>
-
-=head2 nginx
-
-Catalyst runs under nginx via FastCGI in a similar fashion as the lighttpd
-standalone server as described above.
-
-nginx does not have its own internal FastCGI process manager, so you must run
-the FastCGI service separately.
-
-=head3 Configuration
-
-To configure nginx, you must configure the FastCGI parameters and also the
-socket your FastCGI daemon is listening on. It can be either a TCP socket
-or a Unix file socket.
-
-The server configuration block should look roughly like:
-
- server {
- listen $port;
-
- location / {
- fastcgi_param QUERY_STRING $query_string;
- fastcgi_param REQUEST_METHOD $request_method;
- fastcgi_param CONTENT_TYPE $content_type;
- fastcgi_param CONTENT_LENGTH $content_length;
-
- fastcgi_param SCRIPT_NAME /;
- fastcgi_param PATH_INFO $fastcgi_script_name;
- fastcgi_param REQUEST_URI $request_uri;
- fastcgi_param DOCUMENT_URI $document_uri;
- fastcgi_param DOCUMENT_ROOT $document_root;
- fastcgi_param SERVER_PROTOCOL $server_protocol;
-
- fastcgi_param GATEWAY_INTERFACE CGI/1.1;
- fastcgi_param SERVER_SOFTWARE nginx/$nginx_version;
-
- fastcgi_param REMOTE_ADDR $remote_addr;
- fastcgi_param REMOTE_PORT $remote_port;
- fastcgi_param SERVER_ADDR $server_addr;
- fastcgi_param SERVER_PORT $server_port;
- fastcgi_param SERVER_NAME $server_name;
-
- # Adjust the socket for your applications!
- fastcgi_pass unix:$docroot/myapp.socket;
- }
- }
-
-It is the standard convention of nginx to include the fastcgi_params in a
-separate file (usually something like C</etc/nginx/fastcgi_params>) and
-simply include that file.
-
-=head3 Non-root configuration
-
-If you properly specify the PATH_INFO and SCRIPT_NAME parameters your
-application will be accessible at any path. The SCRIPT_NAME variable is the
-prefix of your application, and PATH_INFO would be everything in addition.
-
-As an example, if your application is rooted at /myapp, you would configure:
-
- fastcgi_param SCRIPT_NAME /myapp/;
- fastcgi_param PATH_INFO $fastcgi_script_name;
-
-C<$fastcgi_script_name> would be "/myapp/path/of/the/action". Catalyst will
-process this accordingly and setup the application base as expected.
-
-This behavior is somewhat different than Apache and Lighttpd, but is still
-functional.
-
-For more information on nginx, visit:
-L<http://nginx.net>
-
-=head2 Microsoft IIS
-
-It is possible to run Catalyst under IIS with FastCGI, but only on IIS 6.0
-(Microsoft Windows 2003), IIS 7.0 (Microsoft Windows 2008 and Vista) and
-hopefully its successors.
-
-Even if it is declared that FastCGI is supported on IIS 5.1 (Windows XP) it
-does not support some features (specifically: wildcard mappings) that prevents
-running Catalyst application.
-
-Let us assume that our server has the following layout:
-
- d:\WWW\WebApp\ path to our Catalyst application
- d:\strawberry\perl\bin\perl.exe path to perl interpreter (with Catalyst installed)
- c:\windows Windows directory
-
-=head3 Setup IIS 6.0 (Windows 2003)
-
-=over 4
-
-=item Install FastCGI extension for IIS 6.0
-
-FastCGI is not a standard part of IIS 6 - you have to install it separately. For
-more info and download go to L<http://www.iis.net/extensions/FastCGI>. Choose
-approptiate version (32-bit/64-bit), installation is quite simple
-(in fact no questions, no options).
-
-=item Create a new website
-
-Open "Control Panel" > "Administrative Tools" > "Internet Information Services Manager".
-Click "Action" > "New" > "Web Site". After you finish the installation wizard
-you need to go to the new website's properties.
-
-=item Set website properties
-
-On tab "Web site" set proper values for:
-Site Description, IP Address, TCP Port, SSL Port etc.
-
-On tab "Home Directory" set the following:
-
- Local path: "d:\WWW\WebApp\root"
- Local path permission flags: check only "Read" + "Log visits"
- Execute permitions: "Scripts only"
-
-Click "Configuration" button (still on Home Directory tab) then click "Insert"
-the wildcard application mapping and in the next dialog set:
-
- Executable: "c:\windows\system32\inetsrv\fcgiext.dll"
- Uncheck: "Verify that file exists"
-
-Close all dialogs with "OK".
-
-=item Edit fcgiext.ini
-
-Put the following lines into c:\windows\system32\inetsrv\fcgiext.ini (on 64-bit
-system c:\windows\syswow64\inetsrv\fcgiext.ini):
-
- [Types]
- *:8=CatalystApp
- ;replace 8 with the identification number of the newly created website
- ;it is not so easy to get this number:
- ; - you can use utility "c:\inetpub\adminscripts\adsutil.vbs"
- ; to list websites: "cscript adsutil.vbs ENUM /P /W3SVC"
- ; to get site name: "cscript adsutil.vbs GET /W3SVC/<number>/ServerComment"
- ; to get all details: "cscript adsutil.vbs GET /W3SVC/<number>"
- ; - or look where are the logs located:
- ; c:\WINDOWS\SYSTEM32\Logfiles\W3SVC7\whatever.log
- ; means that the corresponding number is "7"
- ;if you are running just one website using FastCGI you can use '*=CatalystApp'
-
- [CatalystApp]
- ExePath=d:\strawberry\perl\bin\perl.exe
- Arguments="d:\WWW\WebApp\script\webapp_fastcgi.pl -e"
-
- ;by setting this you can instruct IIS to serve Catalyst static files
- ;directly not via FastCGI (in case of any problems try 1)
- IgnoreExistingFiles=0
-
- ;do not be fooled by Microsoft doc talking about "IgnoreExistingDirectories"
- ;that does not work and use "IgnoreDirectories" instead
- IgnoreDirectories=1
-
-=back
-
-=head3 Setup IIS 7.0 (Windows 2008 and Vista)
-
-Microsoft IIS 7.0 has built-in support for FastCGI so you do not have to install
-any addons.
-
-=over 4
-
-=item Necessary steps during IIS7 installation
-
-During IIS7 installation after you have added role "Web Server (IIS)"
-you need to check to install role feature "CGI" (do not be nervous that it is
-not FastCGI). If you already have IIS7 installed you can add "CGI" role feature
-through "Control panel" > "Programs and Features".
-
-=item Create a new website
-
-Open "Control Panel" > "Administrative Tools" > "Internet Information Services Manager"
-> "Add Web Site".
-
- site name: "CatalystSite"
- content directory: "d:\WWW\WebApp\root"
- binding: set proper IP address, port etc.
-
-=item Configure FastCGI
-
-You can configure FastCGI extension using commandline utility
-"c:\windows\system32\inetsrv\appcmd.exe"
-
-=over 4
-
-=item Configuring section "fastCgi" (it is a global setting)
-
- appcmd.exe set config -section:system.webServer/fastCgi /+"[fullPath='d:\strawberry\perl\bin\perl.exe',arguments='d:\www\WebApp\script\webapp_fastcgi.pl -e',maxInstances='4',idleTimeout='300',activityTimeout='30',requestTimeout='90',instanceMaxRequests='1000',protocol='NamedPipe',flushNamedPipe='False']" /commit:apphost
-
-=item Configuring proper handler (it is a site related setting)
-
- appcmd.exe set config "CatalystSite" -section:system.webServer/handlers /+"[name='CatalystFastCGI',path='*',verb='GET,HEAD,POST',modules='FastCgiModule',scriptProcessor='d:\strawberry\perl\bin\perl.exe|d:\www\WebApp\script\webapp_fastcgi.pl -e',resourceType='Unspecified',requireAccess='Script']" /commit:apphost
-
-Note: before launching the commands above do not forget to change site
-name and paths to values relevant for your server setup.
-
-=back
-
-=back
-
-=head1 SEE ALSO
-
-L<Catalyst>, L<FCGI>.
-
-=head1 AUTHORS
-
-Catalyst Contributors, see Catalyst.pm
-
-=head1 THANKS
-
-Bill Moseley, for documentation updates and testing.
-
-=head1 COPYRIGHT
-
-This library is free software. You can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
-package Catalyst::Engine::HTTP;
+package # Hide from PAUSE
+ Catalyst::Engine::HTTP;
+use strict;
+use warnings;
-use Moose;
-extends 'Catalyst::Engine::CGI';
+use base 'Catalyst::Engine';
-use Data::Dump qw(dump);
-use Errno 'EWOULDBLOCK';
-use HTTP::Date ();
-use HTTP::Headers;
-use HTTP::Status;
-use Socket;
-use IO::Socket::INET ();
-use IO::Select ();
+warn("You are loading Catalyst::Engine::HTTP explicitly.
-use constant CHUNKSIZE => 64 * 1024;
-use constant DEBUG => $ENV{CATALYST_HTTP_DEBUG} || 0;
+This is almost certainally a bad idea, as Catalyst::Engine::HTTP
+has been removed in this version of Catalyst.
-use namespace::clean -except => 'meta';
+Please update your application's scripts with:
-has options => ( is => 'rw' );
-has _keepalive => ( is => 'rw', predicate => '_is_keepalive', clearer => '_clear_keepalive' );
-has _write_error => ( is => 'rw', predicate => '_has_write_error' );
+ catalyst.pl -force -scripts MyApp
-# Refactoring note - could/should Eliminate all instances of $self->{inputbuf},
-# which I haven't touched as it is used as an lvalue in a lot of places, and I guess
-# doing it differently could be expensive.. Feel free to refactor and NYTProf :)
+to update your scripts to not do this.\n");
-=head1 NAME
-
-Catalyst::Engine::HTTP - Catalyst HTTP Engine
-
-=head1 SYNOPSIS
-
-A script using the Catalyst::Engine::HTTP module might look like:
-
- #!/usr/bin/perl -w
-
- BEGIN { $ENV{CATALYST_ENGINE} = 'HTTP' }
-
- use strict;
- use lib '/path/to/MyApp/lib';
- use MyApp;
-
- MyApp->run;
-
-=head1 DESCRIPTION
-
-This is the Catalyst engine specialized for development and testing.
-
-=head1 METHODS
-
-=head2 $self->finalize_headers($c)
-
-=cut
-
-sub finalize_headers {
- my ( $self, $c ) = @_;
- my $protocol = $c->request->protocol;
- my $status = $c->response->status;
- my $message = status_message($status);
- my $res_headers = $c->response->headers;
-
- my @headers;
- push @headers, "$protocol $status $message";
-
- $res_headers->header( Date => HTTP::Date::time2str(time) );
- $res_headers->header( Status => $status );
-
- # Should we keep the connection open?
- my $connection = $c->request->header('Connection');
- if ( $self->options
- && $self->options->{keepalive}
- && $connection
- && $connection =~ /^keep-alive$/i
- ) {
- $res_headers->header( Connection => 'keep-alive' );
- $self->_keepalive(1);
- }
- else {
- $res_headers->header( Connection => 'close' );
- }
-
- push @headers, $res_headers->as_string("\x0D\x0A");
-
- # Buffer the headers so they are sent with the first write() call
- # This reduces the number of TCP packets we are sending
- $self->_header_buf( join("\x0D\x0A", @headers, '') );
-}
-
-=head2 $self->finalize_read($c)
-
-=cut
-
-before finalize_read => sub {
- # Never ever remove this, it would result in random length output
- # streams if STDIN eq STDOUT (like in the HTTP engine)
- *STDIN->blocking(1);
-};
-
-=head2 $self->prepare_read($c)
-
-=cut
-
-before prepare_read => sub {
- # Set the input handle to non-blocking
- *STDIN->blocking(0);
-};
-
-=head2 $self->read_chunk($c, $buffer, $length)
-
-=cut
-
-sub read_chunk {
- my $self = shift;
- my $c = shift;
-
- # If we have any remaining data in the input buffer, send it back first
- if ( $_[0] = delete $self->{inputbuf} ) {
- my $read = length( $_[0] );
- DEBUG && warn "read_chunk: Read $read bytes from previous input buffer\n";
- return $read;
- }
-
- # support for non-blocking IO
- my $rin = '';
- vec( $rin, *STDIN->fileno, 1 ) = 1;
-
- READ:
- {
- select( $rin, undef, undef, undef );
- my $rc = *STDIN->sysread(@_);
- if ( defined $rc ) {
- DEBUG && warn "read_chunk: Read $rc bytes from socket\n";
- return $rc;
- }
- else {
- next READ if $! == EWOULDBLOCK;
- return;
- }
- }
-}
-
-=head2 $self->write($c, $buffer)
-
-Writes the buffer to the client.
-
-=cut
-
-around write => sub {
- my $orig = shift;
- my ( $self, $c, $buffer ) = @_;
-
- # Avoid 'print() on closed filehandle Remote' warnings when using IE
- return unless *STDOUT->opened();
-
- # Prepend the headers if they have not yet been sent
- if ( $self->_has_header_buf ) {
- $self->_warn_on_write_error(
- $self->$orig($c, $self->_clear_header_buf)
- );
- }
-
- $self->_warn_on_write_error($self->$orig($c, $buffer));
-};
-
-sub _warn_on_write_error {
- my ($self, $ret) = @_;
- if ( !defined $ret ) {
- $self->_write_error($!);
- DEBUG && warn "write: Failed to write response ($!)\n";
- }
- else {
- DEBUG && warn "write: Wrote response ($ret bytes)\n";
- }
- return $ret;
-}
-
-=head2 run
-
-=cut
-
-# A very very simple HTTP server that initializes a CGI environment
-sub run {
- my ( $self, $class, $port, $host, $options ) = @_;
-
- $options ||= {};
-
- $self->options($options);
-
- if ($options->{background}) {
- my $child = fork;
- die "Can't fork: $!" unless defined($child);
- return $child if $child;
- }
-
- my $restart = 0;
- local $SIG{CHLD} = 'IGNORE';
-
- my $allowed = $options->{allowed} || { '127.0.0.1' => '255.255.255.255' };
- my $addr = $host ? inet_aton($host) : INADDR_ANY;
- if ( $addr eq INADDR_ANY ) {
- require Sys::Hostname;
- $host = lc Sys::Hostname::hostname();
- }
- else {
- $host = gethostbyaddr( $addr, AF_INET ) || inet_ntoa($addr);
- }
-
- # Handle requests
-
- # Setup socket
- my $daemon = IO::Socket::INET->new(
- Listen => SOMAXCONN,
- LocalAddr => inet_ntoa($addr),
- LocalPort => $port,
- Proto => 'tcp',
- ReuseAddr => 1,
- Type => SOCK_STREAM,
- )
- or die "Couldn't create daemon: $@";
-
- $port = $daemon->sockport();
-
- my $url = "http://$host";
- $url .= ":$port" unless $port == 80;
-
- print "You can connect to your server at $url\n";
-
- if ($options->{background}) {
- open STDIN, "+</dev/null" or die $!;
- open STDOUT, ">&STDIN" or die $!;
- open STDERR, ">&STDIN" or die $!;
- if ( $^O !~ /MSWin32/ ) {
- require POSIX;
- POSIX::setsid()
- or die "Can't start a new session: $!";
- }
- }
-
- if (my $pidfile = $options->{pidfile}) {
- if (! open PIDFILE, "> $pidfile") {
- warn("Cannot open: $pidfile: $!");
- }
- print PIDFILE "$$\n";
- close PIDFILE;
- }
-
- my $pid = undef;
-
- # Ignore broken pipes as an HTTP server should
- local $SIG{PIPE} = 'IGNORE';
-
- # Restart on HUP
- local $SIG{HUP} = sub {
- $restart = 1;
- warn "Restarting server on SIGHUP...\n";
- };
-
- LISTEN:
- while ( !$restart ) {
- while ( accept( Remote, $daemon ) ) {
- DEBUG && warn "New connection\n";
-
- select Remote;
-
- Remote->blocking(1);
-
- # Read until we see all headers
- $self->{inputbuf} = '';
-
- if ( !$self->_read_headers ) {
- # Error reading, give up
- close Remote;
- next LISTEN;
- }
-
- my ( $method, $uri, $protocol ) = $self->_parse_request_line;
-
- DEBUG && warn "Parsed request: $method $uri $protocol\n";
- next unless $method;
-
- unless ( uc($method) eq 'RESTART' ) {
-
- # Fork
- if ( $options->{fork} ) {
- if ( $pid = fork ) {
- DEBUG && warn "Forked child $pid\n";
- next;
- }
- }
-
- $self->_handler( $class, $port, $method, $uri, $protocol );
-
- if ( $self->_has_write_error ) {
- close Remote;
-
- if ( !defined $pid ) {
- next LISTEN;
- }
- }
-
- if ( defined $pid ) {
- # Child process, close connection and exit
- DEBUG && warn "Child process exiting\n";
- $daemon->close;
- exit;
- }
- }
- else {
- my $sockdata = $self->_socket_data( \*Remote );
- my $ipaddr = _inet_addr( $sockdata->{peeraddr} );
- my $ready = 0;
- foreach my $ip ( keys %$allowed ) {
- my $mask = $allowed->{$ip};
- $ready = ( $ipaddr & _inet_addr($mask) ) == _inet_addr($ip);
- last if $ready;
- }
- if ($ready) {
- $restart = 1;
- last;
- }
- }
- }
- continue {
- close Remote;
- }
- }
-
- $daemon->close;
-
- DEBUG && warn "Shutting down\n";
-
- if ($restart) {
- $SIG{CHLD} = 'DEFAULT';
- wait;
-
- ### if the standalone server was invoked with perl -I .. we will loose
- ### those include dirs upon re-exec. So add them to PERL5LIB, so they
- ### are available again for the exec'ed process --kane
- use Config;
- $ENV{PERL5LIB} .= join $Config{path_sep}, @INC;
-
- exec $^X, $0, @{ $options->{argv} || [] };
- }
-
- exit;
-}
-
-sub _handler {
- my ( $self, $class, $port, $method, $uri, $protocol ) = @_;
-
- local *STDIN = \*Remote;
- local *STDOUT = \*Remote;
-
- # We better be careful and just use 1.0
- $protocol = '1.0';
-
- my $sockdata = $self->_socket_data( \*Remote );
- my %copy_of_env = %ENV;
-
- my $sel = IO::Select->new;
- $sel->add( \*STDIN );
-
- REQUEST:
- while (1) {
- my ( $path, $query_string ) = split /\?/, $uri, 2;
-
- # URI is not the same as path. Remove scheme, domain name and port from it
- $path =~ s{^https?://[^/?#]+}{};
-
- # Initialize CGI environment
- local %ENV = (
- PATH_INFO => $path || '',
- QUERY_STRING => $query_string || '',
- REMOTE_ADDR => $sockdata->{peeraddr},
- REQUEST_METHOD => $method || '',
- SERVER_NAME => $sockdata->{localname},
- SERVER_PORT => $port,
- SERVER_PROTOCOL => "HTTP/$protocol",
- %copy_of_env,
- );
-
- # Parse headers
- if ( $protocol >= 1 ) {
- $self->_parse_headers;
- }
-
- # Pass flow control to Catalyst
- {
- # FIXME: don't ignore SIGCHLD while handling requests so system()
- # et al. work within actions. it might be a little risky to do that
- # this far out, but then again it's only the dev server anyway.
- local $SIG{CHLD} = 'DEFAULT';
-
- $class->handle_request( env => \%ENV );
- }
-
- DEBUG && warn "Request done\n";
-
- # Allow keepalive requests, this is a hack but we'll support it until
- # the next major release.
- if ( $self->_is_keepalive ) {
- $self->_clear_keepalive;
-
- DEBUG && warn "Reusing previous connection for keep-alive request\n";
-
- if ( $sel->can_read(1) ) {
- if ( !$self->_read_headers ) {
- # Error reading, give up
- last REQUEST;
- }
-
- ( $method, $uri, $protocol ) = $self->_parse_request_line;
-
- DEBUG && warn "Parsed request: $method $uri $protocol\n";
-
- # Force HTTP/1.0
- $protocol = '1.0';
-
- next REQUEST;
- }
-
- DEBUG && warn "No keep-alive request within 1 second\n";
- }
-
- last REQUEST;
- }
-
- DEBUG && warn "Closing connection\n";
-
- close Remote;
-}
-
-sub _read_headers {
- my $self = shift;
-
- while (1) {
- my $read = sysread Remote, my $buf, CHUNKSIZE;
-
- if ( !defined $read ) {
- next if $! == EWOULDBLOCK;
- DEBUG && warn "Error reading headers: $!\n";
- return;
- } elsif ( $read == 0 ) {
- DEBUG && warn "EOF\n";
- return;
- }
-
- DEBUG && warn "Read $read bytes\n";
- $self->{inputbuf} .= $buf;
- last if $self->{inputbuf} =~ /(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)/s;
- }
-
- return 1;
-}
-
-sub _parse_request_line {
- my $self = shift;
-
- # Parse request line
- # Leading CRLF sometimes sent by buggy IE versions
- if ( $self->{inputbuf} !~ s/^(?:\x0D\x0A)?(\w+)[ \t]+(\S+)(?:[ \t]+(HTTP\/\d+\.\d+))?[^\012]*\012// ) {
- return ();
- }
-
- my $method = $1;
- my $uri = $2;
- my $proto = $3 || 'HTTP/0.9';
-
- return ( $method, $uri, $proto );
-}
-
-sub _parse_headers {
- my $self = shift;
-
- # Copy the buffer for header parsing, and remove the header block
- # from the content buffer.
- my $buf = $self->{inputbuf};
- $self->{inputbuf} =~ s/.*?(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)//s;
-
- # Parse headers
- my $headers = HTTP::Headers->new;
- my ($key, $val);
- HEADER:
- while ( $buf =~ s/^([^\012]*)\012// ) {
- $_ = $1;
- s/\015$//;
- if ( /^([\w\-~]+)\s*:\s*(.*)/ ) {
- $headers->push_header( $key, $val ) if $key;
- ($key, $val) = ($1, $2);
- }
- elsif ( /^\s+(.*)/ ) {
- $val .= " $1";
- }
- else {
- last HEADER;
- }
- }
- $headers->push_header( $key, $val ) if $key;
-
- DEBUG && warn "Parsed headers: " . dump($headers) . "\n";
-
- # Convert headers into ENV vars
- $headers->scan( sub {
- my ( $key, $val ) = @_;
-
- $key = uc $key;
- $key = 'COOKIE' if $key eq 'COOKIES';
- $key =~ tr/-/_/;
- $key = 'HTTP_' . $key
- unless $key =~ m/\A(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)\z/;
-
- if ( exists $ENV{$key} ) {
- $ENV{$key} .= ", $val";
- }
- else {
- $ENV{$key} = $val;
- }
- } );
-}
-
-sub _socket_data {
- my ( $self, $handle ) = @_;
-
- my $remote_sockaddr = getpeername($handle);
- my ( undef, $iaddr ) = $remote_sockaddr
- ? sockaddr_in($remote_sockaddr)
- : (undef, undef);
-
- my $local_sockaddr = getsockname($handle);
- my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr);
-
- # This mess is necessary to keep IE from crashing the server
- my $data = {
- peeraddr => $iaddr
- ? ( inet_ntoa($iaddr) || '127.0.0.1' )
- : '127.0.0.1',
- localname => _gethostbyaddr( $localiaddr ),
- localaddr => inet_ntoa($localiaddr) || '127.0.0.1',
- };
-
- return $data;
-}
-
-{ # If you have a crappy DNS server then these can be slow, so cache 'em
- my %hostname_cache;
- sub _gethostbyaddr {
- my $ip = shift;
- $hostname_cache{$ip} ||= gethostbyaddr( $ip, AF_INET ) || $ip;
- }
-}
-
-sub _inet_addr { unpack "N*", inet_aton( $_[0] ) }
-
-=head2 options
-
-Options hash passed to the http engine to control things like if keepalive
-is supported.
-
-=head1 SEE ALSO
-
-L<Catalyst>, L<Catalyst::Engine>
-
-=head1 AUTHORS
-
-Catalyst Contributors, see Catalyst.pm
-
-=head1 THANKS
-
-Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
-
-=head1 COPYRIGHT
+1;
-This library is free software. You can redistribute it and/or modify it under
-the same terms as Perl itself.
+# This is here only as some old generated scripts require Catalyst::Engine::HTTP
-=cut
-1;
--- /dev/null
+package Catalyst::EngineLoader;
+use Moose;
+use Catalyst::Exception;
+use Catalyst::Utils;
+use namespace::autoclean;
+
+extends 'Plack::Loader';
+
+has application_name => (
+ isa => 'Str',
+ is => 'ro',
+ required => 1,
+);
+
+has requested_engine => (
+ is => 'ro',
+ isa => 'Str',
+ predicate => 'has_requested_engine',
+);
+
+sub needs_psgi_engine_compat_hack {
+ my ($self) = @_;
+ return $self->has_requested_engine
+ && $self->requested_engine eq 'PSGI';
+}
+
+has catalyst_engine_class => (
+ isa => 'Str',
+ is => 'rw',
+ lazy => 1,
+ builder => '_guess_catalyst_engine_class',
+);
+
+sub _guess_catalyst_engine_class {
+ my $self = shift;
+ my $old_engine = $self->has_requested_engine
+ ? $self->requested_engine
+ : Catalyst::Utils::env_value($self->application_name, 'ENGINE');
+ if (!defined $old_engine) {
+ return 'Catalyst::Engine';
+ }
+ elsif ($old_engine eq 'PSGI') {
+ ## If we are running under plackup let the Catalyst::Engine::PSGI
+ ## continue to run, but warn.
+ warn <<"EOW";
+You are running Catalyst::Engine::PSGI, which is considered a legacy engine for
+this version of Catalyst. We will continue running and use your existing psgi
+file, but it is recommended to perform the trivial upgrade process, which will
+leave you with less code and a forward path.
+
+Please review Catalyst::Upgrading
+EOW
+ return 'Catalyst::Engine::' . $old_engine;
+ }
+ elsif ($old_engine =~ /^(CGI|FastCGI|HTTP|Apache.*)$/) {
+ return 'Catalyst::Engine';
+ }
+ else {
+ return 'Catalyst::Engine::' . $old_engine;
+ }
+}
+
+around guess => sub {
+ my ($orig, $self) = (shift, shift);
+ my $engine = $self->$orig(@_);
+ if ( $ENV{MOD_PERL} ) {
+ my ( $software, $version ) =
+ $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
+ $version =~ s/_//g;
+ $version =~ s/(\.[^.]+)\./$1/g;
+
+ if ( $software eq 'mod_perl' ) {
+ if ( $version >= 1.99922 ) {
+ $engine = 'Apache2';
+ }
+
+ elsif ( $version >= 1.9901 ) {
+ Catalyst::Exception->throw( message => 'Plack does not have a mod_perl 1.99 handler' );
+ $engine = 'Apache2::MP19';
+ }
+
+ elsif ( $version >= 1.24 ) {
+ $engine = 'Apache1';
+ }
+
+ else {
+ Catalyst::Exception->throw( message =>
+ qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
+ }
+ }
+ }
+
+ my $old_engine = Catalyst::Utils::env_value($self->application_name, 'ENGINE');
+ if (!defined $old_engine) { # Not overridden
+ }
+ elsif ($old_engine =~ /^(PSGI|CGI|Apache.*)$/) {
+ # Trust autodetect
+ }
+ elsif ($old_engine eq 'HTTP') {
+ $engine = 'Standalone';
+ }
+ elsif ($old_engine eq 'FastCGI') {
+ $engine = 'FCGI';
+ }
+ elsif ($old_engine eq "HTTP::Prefork") { # Too bad if you're customising, we don't handle options
+ # write yourself a script to collect and pass in the options
+ $engine = "Starman";
+ }
+ elsif ($old_engine eq "HTTP::POE") {
+ Catalyst::Exception->throw("HTTP::POE engine no longer works, recommend you use Twiggy instead");
+ }
+ elsif ($old_engine eq "Zeus") {
+ Catalyst::Exception->throw("Zeus engine no longer works");
+ }
+ else {
+ warn("You asked for an unrecognised engine '$old_engine' which is no longer supported, this has been ignored.\n");
+ }
+
+ return $engine;
+};
+
+# Force constructor inlining
+__PACKAGE__->meta->make_immutable( replace_constructor => 1 );
+
+1;
+
+__END__
+
+=head1 NAME
+
+Catalyst::EngineLoader - The Catalyst Engine Loader
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+Wrapper on L<Plack::Loader> which resets the ::Engine if you are using some
+version of mod_perl.
+
+=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.
+
+=begin Pod::Coverage
+
+needs_psgi_engine_compat_hack
+
+=end Pod::Coverage
+
+=cut
--- /dev/null
+=pod
+
+=head1 NAME
+
+Catalyst::PSGI - How Catalyst and PSGI work together
+
+=head1 SYNOPSIS
+
+The L<PSGI> specification defines an interface between web servers and
+Perl-based web applications and frameworks. It supports the writing of
+portable applications that can be run using various methods (as a
+standalone server, or using mod_perl, FastCGI, etc.). L<Plack> is an
+implementation of the PSGI specification for running Perl applications.
+
+Catalyst used to contain an entire set of C<< Catalyst::Engine::XXXX >>
+classes to handle various web servers and environments (e.g. CGI,
+FastCGI, mod_perl) etc.
+
+This has been changed in Catalyst 5.9 so that all of that work is done
+by Catalyst implementing the L<PSGI> specification, using L<Plack>'s
+adaptors to implement that functionality.
+
+This means that we can share common code, and share fixes for specific
+web servers.
+
+=head1 I already have an application
+
+If you already have a Catalyst application, then you should be able to
+upgrade to the latest release with little or no trouble (see the notes
+in L<Catalyst::Upgrading> for specifics about your web server
+deployment).
+
+=head1 Writing your own PSGI file.
+
+=head2 What is a .psgi file?
+
+A C<< .psgi >> file lets you control how your application code reference
+is built. Catalyst will automatically handle this for you, but it's
+possible to do it manually by creating a C<myapp.psgi> file in the root
+of your application.
+
+=head2 Why would I want to write my own .psgi file?
+
+Writing your own .psgi file allows you to use the alternate L<plackup> command
+to start your application, and allows you to add classes and extensions
+that implement L<Plack::Middleware>, such as L<Plack::Middleware::ErrorDocument>
+or L<Plack::Middleware::AccessLog>.
+
+The simplest C<.psgi> file for an application called C<TestApp> would be:
+
+ use strict;
+ use warnings;
+ use TestApp;
+
+ my $app = TestApp->psgi_app(@_);
+
+Note that Catalyst will apply a number of middleware components for you
+automatically, and these B<will not> be applied if you manually create a
+psgi file yourself. Details of these components can be found below.
+
+Additional information about psgi files can be found at:
+L<http://search.cpan.org/dist/Plack/lib/Plack.pm#.psgi_files>
+
+=head2 What is in the .psgi file Catalyst generates by default?
+
+Catalyst generates an application which, if the C<using_frontend_proxy>
+setting is on, is wrapped in L<Plack::Middleware::ReverseProxy>, and
+contains some engine-specific fixes for uniform behaviour, as contained
+in:
+
+=over
+
+=item L<Plack::Middleware::LighttpdScriptNameFix>
+
+=item L<Plack::Middleware::IIS6ScriptNameFix>
+
+=item nginx - local to Catalyst
+
+=back
+
+If you override the default by providing your own C<< .psgi >> file,
+then none of these things will be done automatically for you by the PSGI
+application returned when you call C<< MyApp->psgi_app >>. Thus, if you
+need any of this functionality, you'll need to implement this in your
+C<< .psgi >> file yourself.
+
+An apply_default_middlewares method is supplied to wrap your application
+in the default middlewares if you want this behaviour and you are providing
+your own .psgi file.
+
+=head1 SEE ALSO
+
+L<Catalyst::Upgrading>, L<Plack>, L<PSGI::FAQ>, L<PSGI>.
+
+=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
the Catalyst framework. It's liable to change at any time. This document lives
in the the catalyst trunk, currently at
- http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/5.80/trunk/lib/Catalyst/ROADMAP.pod
+ http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits/Catalyst-Runtime.git;a=blob;f=lib/Catalyst/ROADMAP.pod;h=acb5775e4f9ec2db88ab90953f8cf175ba276009;hb=HEAD
Make sure you get it from there to ensure you have the latest version.
-=head2 5.81000
+=head2 5.91000
=over
support for pluggable dispatcher builders (so that attributes can be
replaced).
-=item MyApp should not ISA Catalyst::Controller
-
-=over
-
-=item *
-
-Update Test suite to not assume MyApp ISA Controller
-
-=item *
-
-After that set up attr handlers that will output helpful error messages when
-you do it as well as how to fix it.
-
=back
-=back
-
-=head2 5.82000
+=head2 5.92000
=over
=back
-=head2 5.90000
+=head2 6.00000
=over
=item update pod coverage tests to detect stubbed pod, ensure real coverage
-=item Add support for configuration profiles to be selected at startup time
-through switches / ENV
-
=back
sub path_info { shift->path(@_) }
sub snippets { shift->captures(@_) }
+=for stopwords param params
+
=head1 NAME
Catalyst::Request - provides information about the current client request
=head2 $req->base
Contains the URI base. This will always have a trailing slash. Note that the
-URI scheme (eg., http vs. https) must be determined through heuristics;
+URI scheme (e.g., http vs. https) must be determined through heuristics;
depending on your server configuration, it may be incorrect. See $req->secure
for more info.
=head2 $req->hostname
-Returns the hostname of the client.
+Returns the hostname of the client. Use $req->uri->host to get the hostname of the server.
=head2 $req->input
=head2 $req->secure
Returns true or false, indicating whether the connection is secure
-(https). Note that the URI scheme (eg., http vs. https) must be determined
+(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
use Catalyst::Exception;
use File::Copy ();
-use IO::File qw( SEEK_SET );
+use IO::File ();
use File::Spec::Unix;
use namespace::clean -except => 'meta';
no Moose;
+=for stopwords uploadtmp
+
=head1 NAME
Catalyst::Request::Upload - handles file upload requests
Returns a scalar containing the contents of the temporary file.
-Note that this method will cause the filehandle pointed to by
-C<< $upload->fh >> to be seeked to the start of the file,
-and the file handle to be put into binary mode.
+Note that this will cause the filehandle pointed to by C<< $upload->fh >> to
+be reset to the start of the file using seek and the file handle to be put
+into binary mode.
=cut
binmode( $handle, $layer );
- $handle->seek(0, SEEK_SET);
+ $handle->seek(0, IO::File::SEEK_SET);
while ( $handle->sysread( my $buffer, 8192 ) ) {
$content .= $buffer;
}
- $handle->seek(0, SEEK_SET);
+ $handle->seek(0, IO::File::SEEK_SET);
return $content;
}
has finalized_headers => (is => 'rw', default => 0);
has headers => (
is => 'rw',
+ isa => 'HTTP::Headers',
handles => [qw(content_encoding content_length content_type header)],
default => sub { HTTP::Headers->new() },
required => 1,
want to C< return > or C<< $c->detach() >> to interrupt the normal
processing flow if you want the redirect to occur straight away.
+B<Note:> do not give a relative URL as $url, i.e: one that is not fully
+qualified (= C<http://...>, etc.) or that starts with a slash
+(= C</path/here>). While it may work, it is not guaranteed to do the right
+thing and is not a standard behaviour. You may opt to use uri_for() or
+uri_for_action() instead.
+
=cut
sub redirect {
# Remember to update this in Catalyst as well!
-our $VERSION = '5.80033';
+our $VERSION = '5.90004';
=head1 NAME
package Catalyst::Script::CGI;
use Moose;
-BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' }
use namespace::autoclean;
+sub _plack_engine_name { 'CGI' }
+
with 'Catalyst::ScriptRole';
__PACKAGE__->meta->make_immutable;
package Catalyst::Script::FastCGI;
-
-BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' }
use Moose;
use MooseX::Types::Moose qw/Str Bool Int/;
+use Data::OptList;
use namespace::autoclean;
+sub _plack_engine_name { 'FCGI' }
+
with 'Catalyst::ScriptRole';
has listen => (
traits => [qw(Getopt)],
isa => Str,
is => 'ro',
+ lazy => 1,
+ builder => '_build_proc_title',
documentation => 'Set the process title',
);
+sub _build_proc_title {
+ my ($self) = @_;
+ return sprintf 'perl-fcgi-pm [%s]', $self->application_name;
+}
+
+sub BUILD {
+ my ($self) = @_;
+ $self->proc_title;
+}
+
+# Munge the 'listen' arg so that Plack::Handler::FCGI will accept it.
+sub _listen {
+ my ($self) = @_;
+
+ if (defined (my $listen = $self->listen)) {
+ return [ $listen ];
+ } else {
+ return undef;
+ }
+}
+
+sub _plack_loader_args {
+ my ($self) = shift;
+
+ my $opts = Data::OptList::mkopt([
+ qw/manager nproc proc_title/,
+ pid => [ 'pidfile' ],
+ daemonize => [ 'daemon' ],
+ keep_stderr => [ 'keeperr' ],
+ listen => [ '_listen' ],
+ ]);
+
+ my %args = map { $_->[0] => $self->${ \($_->[1] ? $_->[1]->[0] : $_->[0]) } } @$opts;
+
+ # Plack::Handler::FCGI thinks manager => undef means "use no manager".
+ delete $args{'manager'} unless defined $args{'manager'};
+
+ return %args;
+}
+
sub _application_args {
my ($self) = shift;
return (
$self->listen,
{
- nproc => $self->nproc,
- pidfile => $self->pidfile,
- manager => $self->manager,
- detach => $self->daemon,
+ nproc => $self->nproc,
+ pidfile => $self->pidfile,
+ manager => $self->manager,
+ detach => $self->daemon,
keep_stderr => $self->keeperr,
- proc_title => $self->proc_title,
+ proc_title => $self->proc_title,
}
);
}
package Catalyst::Script::Server;
-
-BEGIN {
- $ENV{CATALYST_ENGINE} ||= 'HTTP';
- require Catalyst::Engine::HTTP;
-}
-
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;
with 'Catalyst::ScriptRole';
documentation => 'Specify a different listening port (to the default port 3000)',
);
+use Moose::Util::TypeConstraints;
+class_type 'MooseX::Daemonize::Pid::File';
+subtype 'Catalyst::Script::Server::Types::Pidfile',
+ as 'MooseX::Daemonize::Pid::File';
+
+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");
+ exit 1;
+ };
+ MooseX::Daemonize::Pid::File->new( file => $_ );
+};
+MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
+ 'Catalyst::Script::Server::Types::Pidfile' => '=s',
+);
has pidfile => (
traits => [qw(Getopt)],
cmd_aliases => 'pid',
- isa => Str,
+ isa => 'Catalyst::Script::Server::Types::Pidfile',
is => 'ro',
documentation => 'Specify a pidfile',
+ coerce => 1,
+ predicate => '_has_pidfile',
);
+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') }
+ catch {
+ warn("MooseX::Daemonize is needed for the --background option\n");
+ exit 1;
+ };
+ MooseX::Daemonize::Core->meta->apply($self);
+ }
+}
+
has keepalive => (
traits => [qw(Getopt)],
cmd_aliases => 'k',
{
use Moose::Util::TypeConstraints;
- my $tc = subtype as RegexpRef;
+ 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');
predicate => '_has_follow_symlinks',
);
+sub _plack_engine_name {
+ my $self = shift;
+ return $self->fork || $self->keepalive ? 'Starman' : 'Standalone';
+}
+
sub _restarter_args {
my $self = shift;
if ( $self->restart ) {
die "Cannot run in the background and also watch for changed files.\n"
if $self->background;
+ die "Cannot write out a pid file and fork for the restarter.\n"
+ if $self->_has_pidfile;
# If we load this here, then in the case of a restarter, it does not
# need to be reloaded for each restart.
$restarter->run_and_watch;
}
else {
+ if ($self->background) {
+ $self->daemon_fork;
+
+ return 1 unless $self->is_daemon;
+
+ Class::MOP::load_class($self->application_name);
+
+ $self->daemon_detach;
+ }
+
+ $self->pidfile->write
+ if $self->_has_pidfile;
+
$self->_run_application;
}
}
+sub _plack_loader_args {
+ my ($self) = shift;
+ return (
+ port => $self->port,
+ host => $self->host,
+ keepalive => $self->keepalive ? 100 : 1,
+ server_ready => sub {
+ my ($args) = @_;
+
+ my $name = $args->{server_software} || ref($args); # $args is $server
+ my $host = $args->{host} || 0;
+ my $proto = $args->{proto} || 'http';
+
+ print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n";
+ },
+ );
+}
+
sub _application_args {
my ($self) = shift;
return (
use MooseX::Types::Moose qw/Str Bool/;
use Pod::Usage;
use MooseX::Getopt;
+use Catalyst::EngineLoader;
+use MooseX::Types::LoadableClass qw/LoadableClass/;
use namespace::autoclean;
with 'MooseX::Getopt' => {
required => 1,
);
+has loader_class => (
+ isa => LoadableClass,
+ is => 'ro',
+ coerce => 1,
+ default => 'Catalyst::EngineLoader',
+ documentation => 'The class to use to detect and load the PSGI engine',
+);
+
+has _loader => (
+ isa => 'Plack::Loader',
+ default => sub {
+ my $self = shift;
+ $self->loader_class->new(application_name => $self->application_name);
+ },
+ handles => {
+ load_engine => 'load',
+ autoload_engine => 'auto',
+ },
+ lazy => 1,
+);
+
sub _getopt_spec_exception {}
sub _getopt_spec_warnings {
()
}
+sub _plack_loader_args {
+ my $self = shift;
+ my @app_args = $self->_application_args;
+ return (port => $app_args[0]);
+}
+
sub _run_application {
my $self = shift;
my $app = $self->application_name;
Class::MOP::load_class($app);
- $app->run($self->_application_args);
+ my $server;
+ if (my $e = $self->can('_plack_engine_name') ) {
+ $server = $self->load_engine($self->$e, $self->_plack_loader_args);
+ }
+ else {
+ $server = $self->autoload_engine($self->_plack_loader_args);
+ }
+ $app->run($self->_application_args, $server);
}
1;
use namespace::autoclean;
sub run {
- my ($self, $class, $scriptclass) = @_;
+ my ($self, $class, $scriptclass, %args) = @_;
my $classtoload = "${class}::Script::$scriptclass";
lib->import(File::Spec->catdir($FindBin::Bin, '..', 'lib'));
$classtoload = "Catalyst::Script::$scriptclass";
Class::MOP::load_class($classtoload);
}
- $classtoload->new_with_options( application_name => $class )->run;
+ $classtoload->new_with_options( application_name => $class, %args )->run;
}
__PACKAGE__->meta->make_immutable;
=head2 run ($application_class, $scriptclass)
-Called with two parameters, the application classs (e.g. MyApp)
+Called with two parameters, the application class (e.g. MyApp)
and the script class, (i.e. one of Server/FastCGI/CGI/Create/Test)
=head1 AUTHORS
__END__
+=for stopwords addChild getNodeValue mysub rollup setNodeValue
+
=head1 NAME
Catalyst::Stats - Catalyst Timing Statistics Class
use warnings;
use Test::More ();
+use Plack::Test;
use Catalyst::Exception;
use Catalyst::Utils;
use Class::MOP;
use Sub::Exporter;
+use Carp 'croak', 'carp';
-my $build_exports = sub {
- my ($self, $meth, $args, $defaults) = @_;
+sub _build_request_export {
+ my ($self, $args) = @_;
+
+ return sub { _remote_request(@_) }
+ if $args->{remote};
- my $request;
my $class = $args->{class};
- if ( $ENV{CATALYST_SERVER} ) {
- $request = sub { remote_request(@_) };
- } elsif (! $class) {
- $request = sub { Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test 'TestApp'") };
- } else {
- unless (Class::MOP::is_class_loaded($class)) {
- Class::MOP::load_class($class);
- }
- $class->import;
-
- $request = sub { local_request( $class, @_ ) };
- }
+ # Here we should be failing right away, but for some stupid backcompat thing
+ # I don't quite remember we fail lazily here. Needs a proper deprecation and
+ # then removal.
+ return sub { croak "Must specify a test app: use Catalyst::Test 'TestApp'" }
+ unless $class;
+
+ Class::MOP::load_class($class) unless Class::MOP::is_class_loaded($class);
+ $class->import;
+
+ return sub { _local_request( $class, @_ ) };
+}
+
+sub _build_get_export {
+ my ($self, $args) = @_;
+ my $request = $args->{request};
- my $get = sub { $request->(@_)->content };
+ return sub { $request->(@_)->content };
+}
+sub _build_ctx_request_export {
+ my ($self, $args) = @_;
+ my ($class, $request) = @{ $args }{qw(class request)};
- my $ctx_request = sub {
+ return sub {
my $me = ref $self || $self;
- ### throw an exception if ctx_request is being used against a remote
- ### server
+ # fail if ctx_request is being used against a remote server
Catalyst::Exception->throw("$me only works with local requests, not remote")
if $ENV{CATALYST_SERVER};
- ### check explicitly for the class here, or the Cat->meta call will blow
- ### up in our face
+ # check explicitly for the class here, or the Cat->meta call will blow
+ # up in our face
Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test 'TestApp'") unless $class;
- ### place holder for $c after the request finishes; reset every time
- ### requests are done.
+ # place holder for $c after the request finishes; reset every time
+ # requests are done.
my $ctx_closed_over;
- ### hook into 'dispatch' -- the function gets called after all plugins
- ### have done their work, and it's an easy place to capture $c.
-
+ # hook into 'dispatch' -- the function gets called after all plugins
+ # have done their work, and it's an easy place to capture $c.
my $meta = Class::MOP::get_metaclass_by_name($class);
$meta->make_mutable;
$meta->add_after_method_modifier( "dispatch", sub {
});
$meta->make_immutable( replace_constructor => 1 );
Class::C3::reinitialize(); # Fixes RT#46459, I've failed to write a test for how/why, but it does.
- ### do the request; C::T::request will know about the class name, and
- ### we've already stopped it from doing remote requests above.
- my $res = $request->( @_ );
+
+ # do the request; C::T::request will know about the class name, and
+ # we've already stopped it from doing remote requests above.
+ my $res = $args->{request}->( @_ );
# Make sure not to leave a reference $ctx hanging around.
# This means that the context will go out of scope as soon as the
my $ctx = $ctx_closed_over;
undef $ctx_closed_over;
- ### return both values
return ( $res, $ctx );
};
+}
+
+my $build_exports = sub {
+ my ($self, $meth, $args, $defaults) = @_;
+ my $class = $args->{class};
+
+ my $request = $self->_build_request_export({
+ class => $class,
+ remote => $ENV{CATALYST_SERVER},
+ });
+
+ my $get = $self->_build_get_export({ request => $request });
+
+ my $ctx_request = $self->_build_ctx_request_export({
+ class => $class,
+ request => $request,
+ });
return {
request => $request,
=head1 INLINE TESTS WILL NO LONGER WORK
-While it used to be possible to inline a whole testapp into a C<.t> file for a
-distribution, this will no longer work.
+While it used to be possible to inline a whole test app into a C<.t> file for
+a distribution, this will no longer work.
The convention is to place your L<Catalyst> test apps into C<t/lib> in your
distribution. E.g.: C<t/lib/TestApp.pm>, C<t/lib/TestApp/Controller/Root.pm>,
my $res = request('foo/bar?test=1');
my $virtual_res = request('foo/bar?test=1', {host => 'virtualhost.com'});
-=head1 FUNCTIONS
-
=head2 ($res, $c) = ctx_request( ... );
Works exactly like L<request|/"$res = request( ... );">, except it also returns the Catalyst context object,
C<$c>. Note that this only works for local requests.
-=head2 $res = Catalyst::Test::local_request( $AppClass, $url );
-
-Simulate a request using L<HTTP::Request::AsCGI>.
-
=cut
-sub local_request {
- my $class = shift;
-
- require HTTP::Request::AsCGI;
+sub _request {
+ my $args = shift;
- my $request = Catalyst::Utils::request( shift(@_) );
- _customize_request($request, @_);
- my $cgi = HTTP::Request::AsCGI->new( $request, %ENV )->setup;
+ my $request = Catalyst::Utils::request(shift);
- $class->handle_request( env => \%ENV );
+ my %extra_env;
+ _customize_request($request, \%extra_env, @_);
+ $args->{mangle_request}->($request) if $args->{mangle_request};
- my $response = $cgi->restore->response;
- $response->request( $request );
+ my $ret;
+ test_psgi
+ %{ $args },
+ app => sub { $args->{app}->({ %{ $_[0] }, %extra_env }) },
+ client => sub {
+ my ($psgi_app) = @_;
+ my $resp = $psgi_app->($request);
+ $args->{mangle_response}->($resp) if $args->{mangle_response};
+ $ret = $resp;
+ };
- # HTML head parsing based on LWP::UserAgent
-
- require HTML::HeadParser;
-
- my $parser = HTML::HeadParser->new();
- $parser->xml_mode(1) if $response->content_is_xhtml;
- $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40;
-
- $parser->parse( $response->content );
- my $h = $parser->header;
- for my $f ( $h->header_field_names ) {
- $response->init_header( $f, [ $h->header($f) ] );
- }
-
- return $response;
+ return $ret;
}
-my $agent;
-
-=head2 $res = Catalyst::Test::remote_request( $url );
-
-Do an actual remote request using LWP.
-
-=cut
-
-sub remote_request {
+sub _local_request {
+ my $class = shift;
- require LWP::UserAgent;
+ return _request({
+ app => ref($class) eq "CODE" ? $class : $class->_finalized_psgi_app,
+ mangle_response => sub {
+ my ($resp) = @_;
- my $request = Catalyst::Utils::request( shift(@_) );
- my $server = URI->new( $ENV{CATALYST_SERVER} );
+ # HTML head parsing based on LWP::UserAgent
+ #
+ # 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.
- _customize_request($request, @_);
+ require HTML::HeadParser;
- if ( $server->path =~ m|^(.+)?/$| ) {
- my $path = $1;
- $server->path("$path") if $path; # need to be quoted
- }
+ 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;
- # the request path needs to be sanitised if $server is using a
- # non-root path due to potential overlap between request path and
- # response path.
- if ($server->path) {
- # If request path is '/', we have to add a trailing slash to the
- # final request URI
- my $add_trailing = $request->uri->path eq '/';
-
- my @sp = split '/', $server->path;
- my @rp = split '/', $request->uri->path;
- shift @sp;shift @rp; # leading /
- if (@rp) {
- foreach my $sp (@sp) {
- $sp eq $rp[0] ? shift @rp : last
+ $parser->parse( $resp->content );
+ my $h = $parser->header;
+ for my $f ( $h->header_field_names ) {
+ $resp->init_header( $f, [ $h->header($f) ] );
}
- }
- $request->uri->path(join '/', @rp);
+ # Another horrible hack to make the response headers have a
+ # 'status' field. This is for back-compat, but you should
+ # call $resp->code instead!
+ $resp->init_header('status', [ $resp->code ]);
+ },
+ }, @_);
+}
- if ( $add_trailing ) {
- $request->uri->path( $request->uri->path . '/' );
- }
- }
+my $agent;
- $request->uri->scheme( $server->scheme );
- $request->uri->host( $server->host );
- $request->uri->port( $server->port );
- $request->uri->path( $server->path . $request->uri->path );
+sub _remote_request {
+ require LWP::UserAgent;
+ local $Plack::Test::Impl = 'ExternalServer';
unless ($agent) {
-
$agent = LWP::UserAgent->new(
keep_alive => 1,
max_redirect => 0,
$agent->env_proxy;
}
- return $agent->request($request);
+
+ my $server = URI->new($ENV{CATALYST_SERVER});
+ if ( $server->path =~ m|^(.+)?/$| ) {
+ my $path = $1;
+ $server->path("$path") if $path; # need to be quoted
+ }
+
+ return _request({
+ ua => $agent,
+ uri => $server,
+ mangle_request => sub {
+ my ($request) = @_;
+
+ # the request path needs to be sanitised if $server is using a
+ # non-root path due to potential overlap between request path and
+ # response path.
+ if ($server->path) {
+ # If request path is '/', we have to add a trailing slash to the
+ # final request URI
+ my $add_trailing = ($request->uri->path eq '/' || $request->uri->path eq '') ? 1 : 0;
+
+ my @sp = split '/', $server->path;
+ my @rp = split '/', $request->uri->path;
+ shift @sp; shift @rp; # leading /
+ if (@rp) {
+ foreach my $sp (@sp) {
+ $sp eq $rp[0] ? shift @rp : last
+ }
+ }
+ $request->uri->path(join '/', @rp);
+
+ if ( $add_trailing ) {
+ $request->uri->path( $request->uri->path . '/' );
+ }
+ }
+ },
+ }, @_);
+}
+
+for my $name (qw(local_request remote_request)) {
+ my $fun = sub {
+ carp <<"EOW";
+Calling Catalyst::Test::${name}() directly is deprecated.
+
+Please import Catalyst::Test into your namespace and use the provided request()
+function instead.
+EOW
+ return __PACKAGE__->can("_${name}")->(@_);
+ };
+
+ no strict 'refs';
+ *$name = $fun;
}
sub _customize_request {
my $request = shift;
+ my $extra_env = shift;
my $opts = pop(@_) || {};
$opts = {} unless ref($opts) eq 'HASH';
if ( my $host = exists $opts->{host} ? $opts->{host} : $default_host ) {
$request->header( 'Host' => $host );
}
+
+ if (my $extra = $opts->{extra_env}) {
+ @{ $extra_env }{keys %{ $extra }} = values %{ $extra };
+ }
}
=head2 action_ok($url [, $test_name ])
This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
+=begin Pod::Coverage
+
+local_request
+
+remote_request
+
+=end Pod::Coverage
+
=cut
1;
Catalyst::Upgrading - Instructions for upgrading to the latest Catalyst
+=head1 Upgrading to Catalyst 5.9
+
+The major change is that L<Plack>, a toolkit for using the L<PSGI>
+specification, now replaces most of the subclasses of L<Catalyst::Engine>. If
+you are using one of the standard subclasses of L<Catalyst::Engine> this
+should be a straightforward upgrade for you. It was a design goal for
+this release to preserve as much backwards compatibility as possible.
+However, since L<Plack> is different from L<Catalyst::Engine>, it is
+possible that differences exist for edge cases. Therefore, we recommend
+that care be taken with this upgrade and that testing should be greater
+than would be the case with a minor point update. Please inform the
+Catalyst developers of any problems so that we can fix them and
+incorporate tests.
+
+It is highly recommended that you become familiar with the L<Plack> ecosystem
+and documentation. Being able to take advantage of L<Plack> development and
+middleware is a major bonus to this upgrade. Documentation about how to
+take advantage of L<Plack::Middleware> by writing your own C<< .psgi >> file
+is contained in L<Catalyst::PSGI>.
+
+If you have created a custom subclass of L<Catalyst:Engine>, you will
+need to convert it to be a subclass of L<Plack::Handler>.
+
+If you are using the L<Plack> engine, L<Catalyst::Engine::PSGI>, this new
+release supersedes that code.
+
+If you are using a subclass of L<Catalyst::Engine> that is aimed at
+nonstandard or internal/testing uses, such as
+L<Catalyst::Engine::Embeddable>, you should still be able to continue
+using that engine.
+
+Advice for specific subclasses of L<Catalyst::Engine> follows:
+
+=head2 Upgrading the FastCGI Engine
+
+No upgrade is needed if your myapp_fastcgi.pl script is already upgraded
+to use L<Catalyst::Script::FastCGI>.
+
+=head2 Upgrading the mod_perl / Apache Engines
+
+The engines that are built upon the various iterations of mod_perl,
+L<Catalyst::Engine::Apache::MP13> (for mod_perl 1, and Apache 1.x) and
+L<Catalyst::Engine::Apache2::MP20> (for mod_perl 2, and Apache 2.x),
+should be seamless upgrades and will work using using L<Plack::Handler::Apache1>
+or L<Plack::Handler::Apache2> as required.
+
+L<Catalyst::Engine::Apache2::MP19>, however, is no longer supported, as
+Plack does not support mod_perl version 1.99. This is unlikely to be a
+problem for anyone, as 1.99 was a brief beta-test release for mod_perl
+2, and all users of mod_perl 1.99 are encouraged to upgrade to a
+supported release of Apache 2 and mod_perl 2.
+
+=head2 Upgrading the HTTP Engine
+
+The default development server that comes with the L<Catalyst> distribution
+should continue to work as expected with no changes as long as your C<myapp_server>
+script is upgraded to use L<Catalyst::Script::HTTP>.
+
+=head2 Upgrading the CGI Engine
+
+If you were using L<Catalyst::Engine::CGI> there is no upgrade needed if your
+myapp_cgi.pl script is already upgraded to use L<Catalyst::Script::CGI>.
+
+=head2 Upgrading Catalyst::Engine::HTTP::Prefork
+
+If you were using L<Catalyst::Engine::HTTP::Prefork> then L<Starman>
+is automatically loaded. You should (at least) change your C<Makefile.PL>
+to depend on Starman.
+
+You can regenerate your C<myapp_server.pl> script with C<catalyst.pl>
+and implement a C<MyApp::Script::Server> class that looks like this:
+
+ package MyApp::Script::Server;
+ use Moose;
+ use namespace::autoclean;
+
+ extends 'CatalystX::Script::Server::Starman';
+
+ 1;
+
+This takes advantage of the new script system, and will add a number of
+options to the standard server script as extra options are added by
+Starman.
+
+More information about these options can be seen at
+L<CatalystX::Script::Server::Starman/SYNOPSIS>.
+
+An alternate route to implement this functionality is to write a simple .psgi
+file for your application, and then use the L<plackup> utility to start the
+server.
+
+=head2 Upgrading the PSGI Engine
+
+If you were using L<Catalyst::Engine::PSGI>, this new release supersedes
+this engine in supporting L<Plack>. By default the Engine is now always
+L<Plack>. As a result, you can remove the dependency on
+L<Catalyst::Engine::PSGI> in your C<Makefile.PL>.
+
+Applications that were using L<Catalyst::Engine::PSGI>
+previously should entirely continue to work in this release with no changes.
+
+However, if you have an C<app.psgi> script, then you no longer need to
+specify the PSGI engine. Instead, the L<Catalyst> application class now
+has a new method C<psgi_app> which returns a L<PSGI> compatible coderef
+which you can wrap in the middleware of your choice.
+
+Catalyst will use the .psgi for your application if it is located in the C<home>
+directory of the application.
+
+For example, if you were using L<Catalyst::Engine::PSGI> in the past, you will
+have written (or generated) a C<script/myapp.psgi> file similar to this one:
+
+ use Plack::Builder;
+ use MyCatalytApp;
+
+ MyCatalystApp->setup_engine('PSGI');
+
+ builder {
+ enable ... # enable your desired middleware
+ sub { MyCatalystApp->run(@_) };
+ };
+
+Instead, you now say:
+
+ use Plack::Builder;
+ use MyCatalystApp;
+
+ builder {
+ enable ... #enable your desired middleware
+ MyCatalystApp->psgi_app;
+ };
+
+In the simplest case:
+
+ MyCatalystApp->setup_engine('PSGI');
+ my $app = sub { MyCatalystApp->run(@_) }
+
+becomes
+
+ my $app = MyCatalystApp->psgi_app(@_);
+
+B<NOT>:
+
+ my $app = sub { MyCatalystApp->psgi_app(@_) };
+ # If you make ^^ this mistake, your app won't work, and will confuse the hell out of you!
+
+You can now move C<< script/myapp.psgi >> to C<< myapp.psgi >>, and the built-in
+Catalyst scripts and your test suite will start using your .psgi file.
+
+B<NOTE:> If you rename your .psgi file without these modifications, then
+any tests run via L<Catalyst::Test> will not be compatible with the new
+release, and will result in the development server starting, rather than
+the expected test running.
+
+B<NOTE:> If you are directly accessing C<< $c->req->env >> to get the PSGI
+environment then this accessor is moved to C<< $c->engine->env >>,
+you will need to update your code.
+
+=head2 Engines which are known to be broken
+
+The following engines B<DO NOT> work as of Catalyst version 5.9. The
+core team will be happy to work with the developers and/or users of
+these engines to help them port to the new Plack/Engine system, but for
+now, applications which are currently using these engines B<WILL NOT>
+run without modification to the engine code.
+
+=over
+
+=item Catalyst::Engine::Wx
+
+=item Catalyst::Engine::Zeus
+
+=item Catalyst::Engine::JobQueue::POE
+
+=item Catalyst::Engine::XMPP2
+
+=item Catalyst::Engine::SCGI
+
+=back
+
+=head2 Engines with unknown status
+
+The following engines are untested or have unknown compatibility.
+Reports are highly encouraged:
+
+=over
+
+=item Catalyst::Engine::Mojo
+
+=item Catalyst::Engine::Server (marked as Deprecated)
+
+=item Catalyst::Engine::HTTP::POE (marked as Deprecated)
+
+=back
+
+=head2 Plack functionality
+
+See L<Catalyst::PSGI>.
+
+=head2 Tests in 5.9
+
+Tests should generally work the same in Catalyst 5.9, but there are
+some differences.
+
+Previously, if using L<Catalyst::Test> and doing local requests (against
+a local server), if the application threw an exception then this
+exception propagated into the test.
+
+This behavior has been removed, and now a 500 response will be returned
+to the test. This change standardizes behavior, so that local test
+requests behave similarly to remote requests.
+
=head1 Upgrading to Catalyst 5.80
Most applications and plugins should run unaltered on Catalyst 5.80.
is using deprecated code, or relying on side effects, then you could have
issues upgrading to this release.
-Most issues found with pre-existing components have been easy to
+Most issues found with existing components have been easy to
solve. This document provides a complete description of behavior changes
which may cause compatibility issues, and of new Catalyst warnings which
-be unclear.
+might be unclear.
If you think you have found an upgrade-related issue which is not covered in
this document, please email the Catalyst list to discuss the problem.
You can only apply method modifiers after the application's C<< ->setup >>
method has been called. This means that modifiers will not work with methods
-which run during the call to C<< ->setup >>.
+run during the call to C<< ->setup >>.
See L<Catalyst::Manual::ExtendingCatalyst> for more information about using
L<Moose> in your applications.
to resolve methods using C3, rather than the unpredictable dispatch
order of L<NEXT>.
-This issue is characterised by your application failing to start due to an
+This issue manifests itself by your application failing to start due to an
error message about having a non-linear @ISA.
The Catalyst plugin most often causing this is
use Test::More;
isnt(BaseClass->can('foo'), Child->can('foo'));
-=head2 Extending Catalyst::Request or other classes in an ad-hoc manner using mk_accessors
+=head2 Extending Catalyst::Request or other classes in an ad hoc manner using mk_accessors
Previously, it was possible to add additional accessors to Catalyst::Request
(or other classes) by calling the mk_accessors class method.
The first time one of these methods is called, a warning will be emitted:
Class $class is calling the deprecated method Catalyst::Dispatcher::$public_method_name,
- this will be removed in Catalyst 5.9X
+ this will be removed in Catalyst 5.9
You should B<NEVER> be calling any of these methods from application code.
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use TestApp;
+use Catalyst::Test ();
+
+{
+ like do {
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning = $_[0] };
+ isa_ok Catalyst::Test::local_request('TestApp', '/'), 'HTTP::Response';
+ $warning;
+ }, qr/deprecated/, 'local_request is deprecated';
+}
+
+done_testing;
'forward_to_uri_check request');
ok( $response->is_success, 'forward_to_uri_check successful');
- is( $response->content, '/action/forward/foo/bar',
+ is( $response->content, 'action/forward/foo/bar',
'forward_to_uri_check correct namespace');
}
TestApp::Controller::Root->index
TestApp::Controller::Root->end
];
-
+
my $expected = join( ", ", @expected );
ok( my $response = request('http://localhost/'), 'root index' );
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
is( $response->content, 'root index', 'root index ok' );
-
+
ok( $response = request('http://localhost'), 'root index no slash' );
is( $response->content, 'root index', 'root index no slash ok' );
}
-
+
# test first-level controller index
{
my @expected = qw[
TestApp::Controller::Index->index
TestApp::Controller::Root->end
];
-
+
my $expected = join( ", ", @expected );
-
+
ok( my $response = request('http://localhost/index/'), 'first-level controller index' );
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
is( $response->content, 'Index index', 'first-level controller index ok' );
-
+
ok( $response = request('http://localhost/index'), 'first-level controller index no slash' );
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
- is( $response->content, 'Index index', 'first-level controller index no slash ok' );
- }
-
+ is( $response->content, 'Index index', 'first-level controller index no slash ok' );
+ }
+
# test second-level controller index
{
my @expected = qw[
TestApp::Controller::Action::Index->index
TestApp::Controller::Root->end
];
-
+
my $expected = join( ", ", @expected );
-
+
ok( my $response = request('http://localhost/action/index/'), 'second-level controller index' );
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
is( $response->content, 'Action-Index index', 'second-level controller index ok' );
-
+
ok( $response = request('http://localhost/action/index'), 'second-level controller index no slash' );
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
- is( $response->content, 'Action-Index index', 'second-level controller index no slash ok' );
+ is( $response->content, 'Action-Index index', 'second-level controller index no slash ok' );
}
-
+
# test controller default when index is present
{
my @expected = qw[
TestApp::Controller::Action::Index->default
TestApp::Controller::Root->end
];
-
+
my $expected = join( ", ", @expected );
-
+
ok( my $response = request('http://localhost/action/index/foo'), 'default with index' );
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
'TestApp::Controller::Action::Regexp',
'Test Class'
);
- my $location = $response->header('location');
- $location =~ s/localhost(:\d+)?/localhost/;
is(
- $location,
- $url,
+ $response->header('location'),
+ $response->request->uri,
'Redirect URI is the same as the request URI'
);
}
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-use Test::More tests => 20*$iters;
+use Test::More;
use Catalyst::Test 'TestApp';
if ( $ENV{CAT_BENCHMARK} ) {
ok( my $response = request('http://localhost/streaming'), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
-
+
SKIP:
{
if ( $ENV{CATALYST_SERVER} ) {
skip "Using remote server", 1;
}
-
- # XXX: Length should be undef here, but HTTP::Request::AsCGI sets it
- is( $response->content_length, 12, 'Response Content-Length' );
+
+ ok(!defined $response->content_length, 'No Content-Length for streaming responses');
+ is(length $response->content, 12, 'Response content' );
}
-
+
is( $response->content,, <<'EOF', 'Content is a stream' );
foo
bar
is( $response->content, "\0" x $size, 'Content is read from filehandle' );
}
}
+
+done_testing;
BEGIN {
$EXPECTED_ENV_VAR = "CATALYSTTEST$$"; # has to be uppercase otherwise fails on Win32
- $EXPECTED_ENV_VAL = $ENV{$EXPECTED_ENV_VAR}
- = "Test env value " . rand(100000);
+ $EXPECTED_ENV_VAL = "Test env value " . rand(100000);
}
use Test::More tests => 7;
use HTTP::Request::Common;
{
- my $env;
+ my $response = request("http://localhost/dump/env", {
+ extra_env => { $EXPECTED_ENV_VAR => $EXPECTED_ENV_VAL },
+ });
- ok( my $response = request("http://localhost/dump/env"),
- 'Request' );
+ ok( $response, 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
+
+ my $env;
ok( eval '$env = ' . $response->content, 'Unserialize Catalyst::Request' );
is ref($env), 'HASH';
- ok exists($env->{PATH}), 'Have a PATH env var';
+ ok exists($env->{PATH_INFO}), 'Have a PATH_INFO env var';
SKIP:
{
use lib "$FindBin::Bin/../lib";
use Test::More tests => 6;
-use TestApp;
-use HTTP::Request::AsCGI;
-
-=pod
-
-This test exposes a problem in the handling of PATH_INFO in C::Engine::CGI (and
-other engines) where Catalyst does not un-escape the request correctly.
-If a request is URL-encoded then Catalyst fails to decode the request
-and thus will try and match actions using the URL-encoded value.
-
-Can NOT use Catalyst::Test as it uses HTTP::Request::AsCGI which does
-correctly unescape the path (by calling $uri = $uri->canonical).
-
-This will fix the problem for the CGI engine, but is probably the
-wrong place. And also does not fix $uri->base, either.
-
-Plus, the same issue is in Engine::Apache* and other engines.
-
-Index: lib/Catalyst/Engine/CGI.pm
-===================================================================
---- lib/Catalyst/Engine/CGI.pm (revision 7821)
-+++ lib/Catalyst/Engine/CGI.pm (working copy)
-@@ -157,6 +157,8 @@
- my $query = $ENV{QUERY_STRING} ? '?' . $ENV{QUERY_STRING} : '';
- my $uri = $scheme . '://' . $host . '/' . $path . $query;
-
-+ $uri = URI->new( $uri )->canonical;
-+
- $c->request->uri( bless \$uri, $uri_class );
-
- # set the base URI
-
-=cut
+use Catalyst::Test 'TestApp';
# test that un-escaped can be feteched.
{
- my $request = Catalyst::Utils::request( 'http://localhost/args/params/one/two' );
- my $cgi = HTTP::Request::AsCGI->new( $request, %ENV )->setup;
-
- TestApp->handle_request( env => \%ENV );
-
- ok( my $response = $cgi->restore->response );
+ ok( my $response = request('http://localhost/args/params/one/two') );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content, 'onetwo' );
}
# test that request with URL-escaped code works.
{
- my $request = Catalyst::Utils::request( 'http://localhost/args/param%73/one/two' );
- my $cgi = HTTP::Request::AsCGI->new( $request, %ENV )->setup;
-
- # Reset PATH_INFO because AsCGI calls $uri = $uri->canonical which
- # will unencode the path and hide the problem from the test.
- $ENV{PATH_INFO} = '/args/param%73/one/two';
-
-
- TestApp->handle_request( env => \%ENV );
-
- ok( my $response = $cgi->restore->response );
+ ok( my $response = request('http://localhost/args/param%73/one/two') );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content, 'onetwo' );
}
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' );
- ok( $creq->secure, 'Forwarded port sets securet' );
+ ok( $creq->secure, 'Forwarded port sets secure' );
isa_ok( $creq->headers, 'HTTP::Headers', 'Catalyst::Request->headers' );
is( $creq->header('X-Whats-Cool'), $request->header('X-Whats-Cool'), 'Catalyst::Request->header X-Whats-Cool' );
is( $creq->header('User-Agent'), $request->header('User-Agent'), 'Catalyst::Request->header User-Agent' );
- my $host = sprintf( '%s:%d', $request->uri->host, $request->uri->port );
+ my $host = sprintf( '%s:%d', $request->header('X-Forwarded-Host'), $request->header('X-Forwarded-Port') );
is( $creq->header('Host'), $host, 'Catalyst::Request->header Host' );
SKIP:
{
my $creq;
- local $ENV{REMOTE_USER} = 'dwc';
my $request = GET(
'http://localhost/dump/request',
);
- ok( my $response = request($request), 'Request' );
+ ok( my $response = request($request, { extra_env => { REMOTE_USER => 'dwc' } }), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
like( $response->content, qr/'Catalyst::Request'/,
use strict;
use warnings;
+no warnings 'once';
use FindBin;
use lib "$FindBin::Bin/../lib";
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use File::Temp qw/ tempdir /;
+use TestApp;
+use File::Spec;
+
+my $home = tempdir( CLEANUP => 1 );
+my $path = File::Spec->catfile($home, 'testapp.psgi');
+open(my $psgi, '>', $path)
+ or die;
+print $psgi q{
+use strict;
+use warnings;
+use TestApp;
+
+TestApp->psgi_app;
+};
+close($psgi);
+# Check we wrote out something that compiles
+system($^X, '-I', "$FindBin::Bin/../lib", '-c', $path)
+ ? fail('.psgi does not compile')
+ : pass('.psgi compiles');
+
+# NOTE - YOU *CANNOT* do something like:
+#my $psgi_ref = require $path;
+# otherwise this test passes!
+# I don't exactly know why that is yet, however, to be safe for future, that
+# is why this test writes out its own .psgi file in a temp directory - so that that
+# path has never been require'd before, and will never be require'd again..
+
+local TestApp->config->{home} = $home;
+
+my $failed = 0;
+eval {
+ # Catch infinite recursion (or anything else)
+ local $SIG{__WARN__} = sub { warn(@_); $failed = 1; die; };
+ TestApp->_finalized_psgi_app;
+};
+ok(!$@, 'No exception')
+ or diag $@;
+ok(!$failed, 'TestApp->_finalized_psgi_app works');
+
+done_testing;
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+use FindBin qw/ $Bin /;
+use lib "$Bin/../lib";
+
+use TestApp;
+
+is(TestApp->controller("Action::ConfigSmashArrayRefs")->config->{action}{foo}{CustomAttr}[0], 'Bar', 'Config un-mangled. RT#65463');
+
+done_testing;
+
use FindBin qw/$Bin/;
use lib "$Bin/../lib";
use TestApp;
-use Catalyst::Engine::CGI;
+use Catalyst::Engine;
# mod_rewrite to app root for non / based app
{
SCRIPT_NAME => '/comics/dispatch.cgi',
REQUEST_URI => '/comics/',
);
- is ''.$r->uri, 'http://www.foo.com/comics/', 'uri is correct';
- is ''.$r->base, 'http://www.foo.com/comics/', 'base is correct';
+ is ''.$r->uri, 'http://www.foo.com/comics/';
+ is ''.$r->base, 'http://www.foo.com/comics/';
}
# mod_rewrite to sub path under app root for non / based app
SCRIPT_NAME => '/~bobtfish/Gitalist/script/gitalist.cgi',
REQUEST_URI => '/~bobtfish/Gitalist/script/gitalist.cgi/%252F/%252F',
);
- is ''.$r->uri, 'http://www.foo.com/~bobtfish/Gitalist/script/gitalist.cgi/%252F/%252F', 'uri correct';
- is ''.$r->base, 'http://www.foo.com/~bobtfish/Gitalist/script/gitalist.cgi/', 'base correct';
+ is ''.$r->uri, 'http://www.foo.com/~bobtfish/Gitalist/script/gitalist.cgi/%252F/%252F';
+ is ''.$r->base, 'http://www.foo.com/~bobtfish/Gitalist/script/gitalist.cgi/';
}
# Using rewrite rules to ask for a sub-path in your app.
is ''.$r->uri, 'http://www.foo.com/oslobilder/%22foo%22', 'uri correct';
is ''.$r->base, 'http://www.foo.com/oslobilder/', 'base correct';
}
-
-# CGI hit on IIS for non / based app
-{
- my $r = get_req(0,
- SERVER_SOFTWARE => 'Microsoft-IIS/6.0',
- PATH_INFO => '/bobtfish/Gitalist/script/gitalist.cgi/static/css/blueprint/screen.css',
- SCRIPT_NAME => '/bobtfish/Gitalist/script/gitalist.cgi',
- PATH_TRANSLATED =>
-'C:\\Inetpub\\vhosts\\foo.com\\httpdocs\\bobtfish\\Gitalist\\script\\gitalist.cgi\\static\\css\\blueprint\\screen.css',
- );
- is ''.$r->uri, 'http://www.foo.com/bobtfish/Gitalist/script/gitalist.cgi/static/css/blueprint/screen.css';
- is ''.$r->base, 'http://www.foo.com/bobtfish/Gitalist/script/gitalist.cgi/';
-}
-
{
my $r = get_req (0,
PATH_INFO => '/auth/login',
is $r->base, 'http://www.foo.com/', 'Base is correct';
}
+
# FIXME - Test proxy logic
# - Test query string
# - Test non standard port numbers
PATH_INFO => '/',
);
- local %ENV = (%template, @_);
-
+ my $engine = Catalyst::Engine->new(
+ env => { %template, @_ },
+ );
my $i = TestApp->new;
$i->setup_finished(0);
$i->config(use_request_uri_for_path => $use_request_uri_for_path);
$i->setup_finished(1);
- $i->engine(Catalyst::Engine::CGI->new);
- $i->engine->prepare_path($i);
+ $engine->prepare_path($i);
return $i->req;
}
use Test::More;
-eval "use FCGI";
-plan skip_all => 'FCGI required' if $@;
-
-plan tests => 2;
-
-require Catalyst::Engine::FastCGI;
+use Catalyst;
my %env = (
'SCRIPT_NAME' => '/koo/blurb',
'HTTP_HOST' => '127.0.0.1:83'
);
-Catalyst::Engine::FastCGI->_fix_env(\%env);
+sub fix_env {
+ my (%input_env) = @_;
+
+ my $mangled_env;
+ my $app = Catalyst->apply_default_middlewares(sub {
+ my ($env) = @_;
+ $mangled_env = $env;
+ return [ 200, ['Content-Type' => 'text/plain'], [''] ];
+ });
+
+ $app->({ %input_env, 'psgi.url_scheme' => 'http' });
+ return %{ $mangled_env };
+}
+
+my %fixed_env = fix_env(%env);
-is($env{PATH_INFO}, '//blurb', 'check PATH_INFO');
-is($env{SCRIPT_NAME}, '/koo', 'check SCRIPT_NAME');
+is($fixed_env{PATH_INFO}, '//blurb', 'check PATH_INFO');
+is($fixed_env{SCRIPT_NAME}, '/koo', 'check SCRIPT_NAME');
+done_testing;
use Test::More;
-eval "use FCGI";
-plan skip_all => 'FCGI required' if $@;
-
-plan tests => 2;
-
-require Catalyst::Engine::FastCGI;
+use Catalyst ();
my %env = (
'SCRIPT_NAME' => '/bar',
'HTTP_HOST' => 'localhost:8000',
);
-Catalyst::Engine::FastCGI->_fix_env(\%env);
+sub fix_env {
+ my (%input_env) = @_;
+
+ my $mangled_env;
+ my $app = Catalyst->apply_default_middlewares(sub {
+ my ($env) = @_;
+ $mangled_env = $env;
+ return [ 200, ['Content-Type' => 'text/plain'], [''] ];
+ });
+
+ $app->({ %input_env, 'psgi.url_scheme' => 'http' });
+ return %{ $mangled_env };
+}
+
+my %fixed_env = fix_env(%env);
-is($env{PATH_INFO}, '/bar', 'check PATH_INFO');
-ok(!exists($env{SCRIPT_NAME}), 'check SCRIPT_NAME');
+is($fixed_env{PATH_INFO}, '/bar', 'check PATH_INFO');
+ok(!exists($fixed_env{SCRIPT_NAME}) || !length($fixed_env{SCRIPT_NAME}),
+ 'check SCRIPT_NAME');
+done_testing;
Catalyst::Script::CGI->new_with_options(application_name => 'TestAppToTestScripts')->run;
} "new_with_options";
shift @TestAppToTestScripts::RUN_ARGS;
+my $server = pop @TestAppToTestScripts::RUN_ARGS;
+like ref($server), qr/^Plack::Handler/, 'Is a Plack::Handler';
is_deeply \@TestAppToTestScripts::RUN_ARGS, [], "no args";
done_testing;
use Catalyst::Script::FastCGI;
-my $testopts;
+local our $fake_handler = \42;
+
+{
+ package TestFastCGIScript;
+ use Moose;
+ use namespace::autoclean;
+
+ extends 'Catalyst::Script::FastCGI';
+
+ # Avoid loading the real plack engine, as that will load FCGI and fail if
+ # it's not there. We don't really need a full engine anyway as the overriden
+ # MyApp->run will just capture its arguments and return without delegating
+ # to the engine to run things.
+ override load_engine => sub { $fake_handler };
+
+ __PACKAGE__->meta->make_immutable;
+}
+
+sub testOption {
+ my ($argstring, $resultarray) = @_;
+
+ local @ARGV = @$argstring;
+ local @TestAppToTestScripts::RUN_ARGS;
+ lives_ok {
+ TestFastCGIScript->new_with_options(application_name => 'TestAppToTestScripts')->run;
+ } "new_with_options";
+ # First element of RUN_ARGS will be the script name, which we don't care about
+ shift @TestAppToTestScripts::RUN_ARGS;
+ my $server = pop @TestAppToTestScripts::RUN_ARGS;
+ is $server, $fake_handler, 'Loaded Plack handler gets passed to the app';
+ is_deeply \@TestAppToTestScripts::RUN_ARGS, $resultarray, "is_deeply comparison";
+}
+
+# Returns the hash expected when no flags are passed
+sub opthash {
+ return {
+ (map { ($_ => undef) } qw(pidfile keep_stderr detach nproc manager)),
+ proc_title => 'perl-fcgi-pm [TestAppToTestScripts]',
+ @_,
+ };
+}
+
# Test default (no opts/args behaviour)
testOption( [ qw// ], [undef, opthash()] );
testOption( [ qw/--proc_title foo/ ], [undef, opthash(proc_title => 'foo')] );
done_testing;
-
-sub testOption {
- my ($argstring, $resultarray) = @_;
-
- local @ARGV = @$argstring;
- local @TestAppToTestScripts::RUN_ARGS;
- lives_ok {
- Catalyst::Script::FastCGI->new_with_options(application_name => 'TestAppToTestScripts')->run;
- } "new_with_options";
- # First element of RUN_ARGS will be the script name, which we don't care about
- shift @TestAppToTestScripts::RUN_ARGS;
- is_deeply \@TestAppToTestScripts::RUN_ARGS, $resultarray, "is_deeply comparison";
-}
-
-# Returns the hash expected when no flags are passed
-sub opthash {
- return {
- pidfile => undef,
- keep_stderr => undef,
- detach => undef,
- nproc => undef,
- manager => undef,
- proc_title => undef,
- @_,
- };
-}
--- /dev/null
+use strict;
+use warnings;
+use FindBin qw/$Bin/;
+use Test::More;
+use Try::Tiny;
+
+plan skip_all => "Need Test::Without::Module for this test"
+ unless try { require Test::Without::Module; 1 };
+
+Test::Without::Module->import(qw(
+ Starman
+ Plack::Handler::Starman
+ MooseX::Daemonize
+ MooseX::Daemonize::Pid::File
+ MooseX::Daemonize::Core
+));
+
+require "$Bin/../aggregate/unit_core_script_server.t";
+
+Test::Without::Module->unimport(qw(
+ Starman
+ Plack::Handler::Starman
+ MooseX::Daemonize
+ MooseX::Daemonize::Pid::File
+ MooseX::Daemonize::Core
+));
+
+1;
+
use FindBin qw/$Bin/;
use lib "$Bin/../lib";
+use File::Temp qw/ tempdir /;
+use Cwd;
use Test::More;
-use Test::Exception;
+use Try::Tiny;
use Catalyst::Script::Server;
+my $cwd = getcwd;
+chdir(tempdir(CLEANUP => 1));
+
my $testopts;
# Test default (no opts/args behaviour)
testOption( [ qw// ], [5000, undef, opthash()] );
}
-# fork -f -fork --fork -f --fork
-testOption( [ qw/--fork/ ], ['3000', undef, opthash(fork => 1)] );
-testOption( [ qw/-f/ ], ['3000', undef, opthash(fork => 1)] );
+if (try { require Starman; 1; }) {
+ # fork -f -fork --fork -f --fork
+ testOption( [ qw/--fork/ ], ['3000', undef, opthash(fork => 1)] );
+ testOption( [ qw/-f/ ], ['3000', undef, opthash(fork => 1)] );
+}
-# pidfile -pidfile --pid --pidfile
-testOption( [ qw/--pidfile cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] );
-testOption( [ qw/--pid cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] );
+if (try { require MooseX::Daemonize; 1; }) {
+ # pidfile -pidfile --pid --pidfile
+ testOption( [ qw/--pidfile cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] );
+ testOption( [ qw/--pid cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] );
+}
-# keepalive -k -keepalive --keepalive -k --keepalive
-testOption( [ qw/-k/ ], ['3000', undef, opthash(keepalive => 1)] );
-testOption( [ qw/--keepalive/ ], ['3000', undef, opthash(keepalive => 1)] );
+if (try { require Starman; 1; }) {
+ # keepalive -k -keepalive --keepalive -k --keepalive
+ testOption( [ qw/-k/ ], ['3000', undef, opthash(keepalive => 1)] );
+ testOption( [ qw/--keepalive/ ], ['3000', undef, opthash(keepalive => 1)] );
+}
# symlinks -follow_symlinks --sym --follow_symlinks
-testOption( [ qw/--follow_symlinks/ ], ['3000', undef, opthash(follow_symlinks => 1)] );
+#
testOption( [ qw/--sym/ ], ['3000', undef, opthash(follow_symlinks => 1)] );
+testOption( [ qw/--follow_symlinks/ ], ['3000', undef, opthash(follow_symlinks => 1)] );
-# background -background --bg --background
-testOption( [ qw/--background/ ], ['3000', undef, opthash(background => 1)] );
-testOption( [ qw/--bg/ ], ['3000', undef, opthash(background => 1)] );
+if (try { require MooseX::Daemonize; 1; }) {
+ # background -background --bg --background
+ testBackgroundOptionWithFork( [ qw/--background/ ]);
+ testBackgroundOptionWithFork( [ qw/--bg/ ]);
+}
# restart -r -restart --restart -R --restart
testRestart( ['-r'], restartopthash() );
sub testOption {
my ($argstring, $resultarray) = @_;
my $app = _build_testapp($argstring);
- lives_ok {
+ try {
$app->run;
+ }
+ catch {
+ fail $_;
};
# First element of RUN_ARGS will be the script name, which we don't care about
+
shift @TestAppToTestScripts::RUN_ARGS;
+ my $server = pop @TestAppToTestScripts::RUN_ARGS;
+ like ref($server), qr/^Plack::Handler/, 'Is a Plack::Handler';
+
+ my @run_args = @TestAppToTestScripts::RUN_ARGS;
+ $run_args[-1]->{pidfile} = $run_args[-1]->{pidfile}->file->stringify
+ if scalar(@run_args) && $run_args[-1]->{pidfile};
+
+
# Mangle argv into the options..
$resultarray->[-1]->{argv} = $argstring;
- is_deeply \@TestAppToTestScripts::RUN_ARGS, $resultarray, "is_deeply comparison " . join(' ', @$argstring);
+ is_deeply \@run_args, $resultarray, "is_deeply comparison " . join(' ', @$argstring);
+}
+
+sub testBackgroundOptionWithFork {
+ my ($argstring) = @_;
+
+ ## First, make sure we can get an app
+ my $app = _build_testapp($argstring);
+
+ ## Sorry, don't really fork since this cause trouble in Test::Aggregate
+ $app->meta->add_around_method_modifier('daemon_fork', sub { return; });
+
+ try {
+ $app->run;
+ }
+ catch {
+ fail $_;
+ };
+
+ ## Check a few args
+ is_deeply $app->{ARGV}, $argstring;
+ is $app->{port}, '3000';
+ is($app->{background}, 1);
}
sub testRestart {
local @ARGV = @$argstring;
local @TestAppToTestScripts::RUN_ARGS;
my $i;
- lives_ok {
+ try {
$i = Catalyst::Script::Server->new_with_options(application_name => 'TestAppToTestScripts');
- } "new_with_options " . join(' ', @$argstring);;
+ pass "new_with_options " . join(' ', @$argstring);
+ }
+ catch {
+ fail "new_with_options " . join(' ', @$argstring) . " " . $_;
+ };
ok $i;
return $i;
}
};
return $val;
}
+
+chdir($cwd);
+
+1;
+
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+use Catalyst::EngineLoader;
+
+my $cases = {
+ FastCGI => {
+ expected_catalyst_engine_class => 'Catalyst::Engine',
+ ENV => { CATALYST_ENGINE => 'FastCGI' },
+ },
+ CGI => {
+ expected_catalyst_engine_class => 'Catalyst::Engine',
+ ENV => { CATALYST_ENGINE => 'CGI' },
+ },
+ Apache1 => {
+ expected_catalyst_engine_class => 'Catalyst::Engine',
+ ENV => { CATALYST_ENGINE => 'Apache1' },
+ },
+};
+
+foreach my $name (keys %$cases) {
+ local %ENV = %{ $cases->{$name}->{ENV} };
+ my $loader = Catalyst::EngineLoader->new(application_name => "TestApp");
+ if (my $expected = $cases->{$name}->{expected_catalyst_engine_class}) {
+ is $loader->catalyst_engine_class, $expected, $name . " catalyst_engine_class";
+ }
+}
+
+done_testing;
# FIXME - These vhosts in tests tests should be somewhere else...
-sub customize { Catalyst::Test::_customize_request(@_) }
+sub customize { Catalyst::Test::_customize_request($_[0], {}, @_[1 .. $#_]) }
{
my $req = Catalyst::Utils::request('/dummy');
request(GET('/dummy'), []);
} 'array additional param to request method ignored';
+my $res = request(GET('/'));
+is $res->code, 200, 'Response code 200';
+is $res->headers->{status}, 200, 'Back compat "status" header present';
+
done_testing;
use File::Path;
use FindBin;
-use IPC::Open3;
-use IO::Socket;
+use Test::TCP;
+use Try::Tiny;
+use Plack::Builder;
use Catalyst::Devel 1.0;
use File::Copy::Recursive;
rmtree '../t/tmp/TestApp/t' or die;
# spawn the standalone HTTP server
-my $port = 30000 + int rand(1 + 10000);
-my @cmd = ($^X, "-I$FindBin::Bin/../../lib",
- "$FindBin::Bin/../../t/tmp/TestApp/script/testapp_server.pl", '--port', $port );
-my $pid = open3( undef, my $server, undef, @cmd)
- or die "Unable to spawn standalone HTTP server: $!";
-
-# wait for it to start
-print "Waiting for server to start...\n";
-my $timeout = 30;
-my $count = 0;
-while ( check_port( 'localhost', $port ) != 1 ) {
- sleep 1;
- die("Server did not start within $timeout seconds: " . join(' ', @cmd))
- if $count++ > $timeout;
+my $port = empty_port;
+
+my $pid = fork;
+if ($pid) {
+ # parent.
+ print "Waiting for server to start...\n";
+ wait_port_timeout($port, 30);
+} elsif ($pid == 0) {
+ # child process
+ unshift @INC, "$tmpdir/TestApp/lib", "$FindBin::Bin/../../lib";
+ require TestApp;
+
+ my $psgi_app = TestApp->apply_default_middlewares(TestApp->psgi_app);
+ Plack::Loader->auto(port => $port)->run(builder {
+ mount '/test_prefix' => $psgi_app;
+ mount '/' => sub {
+ return [501, ['Content-Type' => 'text/plain'], ['broken tests']];
+ };
+ });
+
+ exit 0;
+} else {
+ die "fork failed: $!";
}
# run the testsuite against the HTTP server
-$ENV{CATALYST_SERVER} = "http://localhost:$port";
+$ENV{CATALYST_SERVER} = "http://localhost:$port/test_prefix";
chdir '..';
# shut it down
kill 'INT', $pid;
-close $server;
# clean up
rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp";
is( $return, 0, 'live tests' );
-sub check_port {
- my ( $host, $port ) = @_;
-
- my $remote = IO::Socket::INET->new(
- Proto => "tcp",
- PeerAddr => $host,
- PeerPort => $port
- );
- if ($remote) {
- close $remote;
- return 1;
- }
- else {
- return 0;
+sub wait_port_timeout {
+ my ($port, $timeout) = @_;
+
+ # wait_port waits for 10 seconds
+ for (1 .. int($timeout / 10)) { # meh, good enough.
+ try { wait_port $port; 1 } and return;
}
+
+ die "Server did not start within $timeout seconds";
}
sub prove {
our @private = ( 'BUILD' );
foreach my $module (@modules) {
local @private = (@private, 'run') if $module =~ /^Catalyst::Script::/;
- pod_coverage_ok($module, { also_private => \@private });
+ pod_coverage_ok($module, {
+ also_private => \@private,
+ coverage_class => 'Pod::Coverage::TrustPod',
+ });
}
done_testing;
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+use Test::Spelling;
+
+add_stopwords(qw(
+ API CGI MVC PSGI Plack README SSI Starman XXXX URI htaccess middleware
+ mixins namespace psgi startup Deprecations catamoose cataplack linearize
+ subclasses subdirectories refactoring adaptors
+ undef env regex unary rethrow rethrows stringifies CPAN STDERR SIGCHLD baz
+ roadmap wishlist refactor refactored Runtime pluggable pluggability hoc apis
+ fastcgi nginx Lighttpd IIS middlewares backend IRC
+ ctx _application MyApp restarter httponly Utils stash's unescapes
+ dispatchtype dispatchtypes redispatch redispatching
+ CaptureArgs ChainedParent PathPart PathPrefix
+ BUILDARGS metaclass namespaces pre
+ filename tempname request's subdirectory ini uninstalled uppercased
+ wiki bitmask uri url urls dir hostname proxied http https IP SSL
+));
+set_spell_cmd('aspell list -l en');
+all_pod_files_spelling_ok();
+
+done_testing();
use Test::More tests => 1;
use Catalyst ();
-use Catalyst::Engine::HTTP;
eval {
require TestAppUnknownError;
};
--- /dev/null
+package TestApp::Controller::Action::ConfigSmashArrayRefs;
+
+use strict;
+use base 'Catalyst::Controller';
+
+ sub foo : Action {}
+
+# check configuration for an inherited action
+__PACKAGE__->config(
+ action => {
+ foo => { CustomAttr => [ 'Bar' ] }
+ }
+);
+
+sub _parse_CustomAttr_attr {
+ my ($self, $app, $name, $value) = @_;
+ return CustomAttr => "PoopInYourShoes";
+}
+
+
+1;
+
sub uri_check : Private {
my ( $self, $c ) = @_;
- $c->res->body( $c->uri_for('foo/bar')->path );
+ $c->res->body( $c->uri_for('foo/bar')->rel($c->req->base)->path );
}
1;
$c->res->body('Body');
}
+
+sub test_redirect :Global {
+ my ($self, $c) = @_;
+ # Don't set content_type
+ # Don't set body
+ $c->res->redirect('/go_here');
+}
+
+sub test_redirect_with_contenttype :Global {
+ my ($self, $c) = @_;
+ # set content_type but don't set body
+ $c->res->content_type('image/jpeg');
+ $c->res->redirect('/go_here');
+}
+
+sub test_redirect_with_content :Global {
+ my ($self, $c) = @_;
+ $c->res->content_type('text/plain');
+ $c->res->body('Please kind sir, I beg you to go to /go_here.');
+ $c->res->redirect('/go_here');
+}
+
sub end : Private {
my ($self,$c) = @_;
}
sub process {
my ( $self, $c ) = @_;
- return $self->SUPER::process( $c, $c->engine->env );
+ my $env = $c->engine->env;
+ return $self->SUPER::process($c, {
+ map { ($_ => $env->{$_}) }
+ grep { $_ ne 'psgi.input' }
+ keys %{ $env },
+ });
+}
+
+## We override Data::Dumper here since its not reliably outputting
+## something that is roundtrip-able.
+
+sub dump {
+ my ( $self, $reference ) = @_;
+ use Data::Dump ();
+ return Data::Dump::dump($reference);
}
1;
+use strict;
+use warnings;
+
use FindBin;
use lib "$FindBin::Bin/lib";
use Catalyst::Test 'TestApp', {default_host => 'default.com'};
plan skip_all => 'Skipping fork tests: no /bin/ls'
if !-e '/bin/ls'; # see if /bin/ls exists
-plan tests => 13; # otherwise
-
{
ok(my $result = get('/fork/system/%2Fbin%2Fls'), 'system');
- my @result = split /$/m, $result;
- $result = join q{}, @result[-4..-1];
- my $result_ref = eval { Load($result) };
- ok($result_ref, 'is YAML');
- is($result_ref->{result}, 0, 'exited OK');
+ if (my $result_ref = result_ok($result)) {
+ ok($result_ref, 'is YAML');
+ is($result_ref->{result}, 0, 'exited OK');
+ }
}
{
ok(my $result = get('/fork/backticks/%2Fbin%2Fls'), '`backticks`');
- my @result = split /$/m, $result;
- $result = join q{}, @result[-4..-1];
-
- my $result_ref = eval { Load($result) };
- ok($result_ref, 'is YAML');
- is($result_ref->{code}, 0, 'exited successfully');
- like($result_ref->{result}, qr{^/bin/ls[^:]}, 'contains ^/bin/ls$');
- like($result_ref->{result}, qr{\n.*\n}m, 'contains two newlines');
+
+ if (my $result_ref = result_ok($result)) {
+ ok($result_ref, 'is YAML');
+ is($result_ref->{code}, 0, 'exited successfully');
+ like($result_ref->{result}, qr{^/bin/ls[^:]}, 'contains ^/bin/ls$');
+ like($result_ref->{result}, qr{\n.*\n}m, 'contains two newlines');
+ }
}
+
{
ok(my $result = get('/fork/fork'), 'fork');
- my @result = split /$/m, $result;
- $result = join q{}, @result[-4..-1];
-
- my $result_ref = eval { Load($result) };
- ok($result_ref, 'is YAML');
- isnt($result_ref->{pid}, 0, q{fork's "pid" wasn't 0});
- isnt($result_ref->{pid}, $$, 'fork got a new pid');
- is($result_ref->{result}, 'ok', 'fork was effective');
+
+ if (my $result_ref = result_ok($result)) {
+ ok($result_ref, 'is YAML');
+ isnt($result_ref->{pid}, 0, q{fork's "pid" wasn't 0});
+ isnt($result_ref->{pid}, $$, 'fork got a new pid');
+ is($result_ref->{result}, 'ok', 'fork was effective');
+ }
+}
+
+sub result_ok {
+ my $result = shift;
+
+ unlike( $result, qr/FATAL/, 'result is not an error' )
+ or return;
+
+ $result =~ s/\r\n|\r/\n/g;
+
+ return eval { Load($result) };
}
+
+done_testing;
--- /dev/null
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Catalyst::Test 'TestApp', {default_host => 'default.com'};
+use Catalyst::Request;
+
+use Test::More;
+
+# test redirect
+{
+ my $request =
+ HTTP::Request->new( GET => 'http://localhost:3000/test_redirect' );
+
+ 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' );
+}
+
+# test redirect without a body and but with a content_type set explicitly by the developer
+{
+ my $request =
+ HTTP::Request->new( GET => 'http://localhost:3000/test_redirect_with_contenttype' );
+
+ ok( my $response = request($request), 'Request' );
+ is( $response->code, 302, 'Response Code' );
+
+ # When the developer has not set content body, we set it. The content type must always match the body, so it should be overwritten.
+ is( $response->header( 'Content-Type' ), 'text/html; charset=utf-8', 'Content Type' );
+ like( $response->content, qr/<body>/, 'Content contains HTML body' );
+}
+
+# test redirect without a body and but with a content_type set explicitly by the developer
+{
+ my $request =
+ HTTP::Request->new( GET => 'http://localhost:3000/test_redirect_with_content' );
+
+ ok( my $response = request($request), 'Request' );
+ is( $response->code, 302, 'Response Code' );
+
+ # When the developer sets both the content body and content type, the set content body and content_type should get through.
+ is( $response->header( 'Content-Type' ), 'text/plain', 'Content Type' );
+ like( $response->content, qr/kind sir/, 'Content contains content set by the Controller' );
+}
+
+done_testing;
+
--- /dev/null
+use strict;
+use warnings;
+no warnings 'once';
+use FindBin qw/$Bin/;
+use lib "$Bin/lib";
+
+use Test::More;
+
+use File::Spec;
+use File::Temp qw/ tempdir /;
+
+my $temp;
+BEGIN {
+ $temp = tempdir( CLEANUP => 1 );
+
+ $ENV{CATALYST_HOME} = $temp;
+ open(my $psgi, '>', File::Spec->catdir($temp, 'testapp.psgi')) or die;
+ print $psgi q{
+ use strict;
+ use TestApp;
+
+ $main::have_loaded_psgi = 1;
+ my $app = TestApp->psgi_app;
+ };
+ close($psgi);
+}
+use Catalyst::Test qw/ TestApp /;
+
+ok request('/');
+ok $main::have_loaded_psgi;
+
+done_testing;
+
--- /dev/null
+use strict;
+use warnings;
+use FindBin qw/$Bin/;
+use lib "$Bin/lib";
+
+use Test::More;
+use Test::Exception;
+use Plack::Test;
+use TestApp;
+use HTTP::Request::Common;
+
+plan skip_all => "Catalyst::Engine::PSGI required for this test"
+ unless eval { require Catalyst::Engine::PSGI; 1; };
+
+my $warning;
+local $SIG{__WARN__} = sub { $warning = $_[0] };
+
+TestApp->setup_engine('PSGI');
+my $app = sub { TestApp->run(@_) };
+
+like $warning, qr/You are running Catalyst\:\:Engine\:\:PSGI/,
+ 'got deprecation alert warning';
+
+test_psgi $app, sub {
+ my $cb = shift;
+ lives_ok {
+ my $TIMEOUT_IN_SECONDS = 5;
+ local $SIG{ALRM} = sub { die "alarm\n" };
+ alarm($TIMEOUT_IN_SECONDS);
+
+ my $res = $cb->(GET "/");
+ is $res->content, "root index", 'got expected content';
+ like $warning, qr/env as a writer/, 'got deprecation alert warning';
+
+ alarm(0);
+ 1
+ } q{app didn't die or timeout};
+};
+
+done_testing;
+
--- /dev/null
+use strict;
+use warnings;
+no warnings 'once';
+use FindBin qw/$Bin/;
+use lib "$Bin/lib";
+
+use Test::More;
+
+use File::Spec;
+use File::Temp qw/ tempdir /;
+
+my $temp;
+BEGIN {
+ $temp = tempdir( CLEANUP => 1 );
+
+ $ENV{CATALYST_HOME} = $temp;
+ open(my $psgi, '>', File::Spec->catdir($temp, 'testapp.psgi')) or die;
+ print $psgi q{
+ use strict;
+ use TestApp;
+
+ $main::have_loaded_psgi = 1;
+ TestApp->setup_engine('PSGI');
+ my $app = sub { TestApp->run(@_) };
+ };
+ close($psgi);
+}
+use Catalyst::Test qw/ TestApp /;
+
+ok !$main::have_loaded_psgi, 'legacy psgi file got ignored';
+
+like do {
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning = $_[0] };
+ ok request('/');
+ $warning;
+}, qr/ignored/, 'legacy psgi files raise a warning';
+
+done_testing;
+