--- /dev/null
+language: perl
+perl:
+ - "5.16"
+ - "5.14"
+ - "5.12"
+ - "5.10"
+
+install:
+ # git bits sometimes needed...
+ - git config user.name 'Travis-CI'
+ - git config user.email 'travis@nowhere.dne'
+
+ # ensure we have the latest cpanm
+ - echo y | perlbrew install-cpanm
+
+ # see if we can't speed things up a bit
+ - rm -rf ~/.cpanm
+ - mkdir ~/.cpanm
+ - sudo mount tmpfs -t tmpfs ~/.cpanm
+
+ # these fail on parallel test runs
+ # Net::Server: https://rt.cpan.org/Ticket/Display.html?id=84126
+ - cpanm --metacpan --skip-satisfied Net::Server Template File::Remove Filesys::Notify::Simple Config::Any CGI::Simple Plack
+
+ # for testing
+ - cpanm --metacpan --skip-satisfied YAML
+
+ # enable various test options, including parallel testing
+ - export AUTOMATED_TESTING=1 HARNESS_OPTIONS=j10:c HARNESS_TIMER=1
+
+ # M::I deps
+ - cpanm --metacpan --skip-satisfied Module::Install Module::Install::AuthorRequires Module::Install::CheckConflicts Module::Install::AuthorTests Module::Install::Authority
+
+ # author deps -- wish there was a better way
+ - cpanm --metacpan --skip-satisfied CatalystX::LeakChecker Catalyst::Devel Catalyst::Engine::PSGI Starman MooseX::Daemonize
+ - cpanm --metacpan --skip-satisfied Test::Without::Module Test::NoTabs Test::Pod Test::Pod::Coverage Test::Spelling Pod::Coverage::TrustPod
+ - cpanm --metacpan --skip-satisfied --installdeps .
+
+ # we want these for our tests, but not for any others
+ - export AUTHOR_TESTING=1
+ - export RELEASE_TESTING=1
+
+ - make manifest
+
+script:
+ - make disttest
# This file documents the revision history for Perl extension Catalyst.
5.90021 - TBA
+ - make $app->uri_for and related methods return something sane, when called
+ as an application method, instead of a context method. Now if you call
+ MyApp::Web->uri_for(...) you will get a generic URI object that you need to
+ resolve manually.
+ - documentation updates around forwarding to chained actions
+ - Fixed bug when a PSGI engine need to use psgix logger
+ - Added cpanfile as a way to notice we are a dev checkout
- Added 'x-tunneled-method' HTTP Header method override to match features in
Catalyst::Action::REST and in other similar systems on CPAN
requires 'Plack::Middleware::ReverseProxy' => '0.04';
requires 'Plack::Test::ExternalServer';
+# Install the standalone Regex dispatch modules in order to ease the
+# depreciation transition
+requires 'Catalyst::DispatchType::Regex' => '5.90021';
+
test_requires 'Class::Data::Inheritable';
test_requires 'Test::Exception';
test_requires 'Test::More' => '0.88';
If none of these are set, Catalyst will attempt to automatically detect the
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
+will try and find the directory containing either Makefile.PL, Build.PL,
+dist.ini, or cpanfile. 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 (e.g., /foo/MyApp if your
application was installed at /foo/MyApp.pm)
my $args = join('/', grep { defined($_) } @args);
$args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
$args =~ s!^/+!!;
- my $base = $c->req->base;
- my $class = ref($base);
- $base =~ s{(?<!/)$}{/};
+
+ my ($base, $class) = ('/', 'URI::_generic');
+ if(blessed($c)) {
+ $base = $c->req->base;
+ $class = ref($base);
+ $base =~ s{(?<!/)$}{/};
+ }
my $query = '';
miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
+mgrimes: Mark Grimes <mgrimes@cpan.org>
+
mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
mugwump: Sam Vilain
}
}
-sub _parse_Regex_attr {
- my ( $self, $c, $name, $value ) = @_;
- return ( 'Regex', $value );
-}
-
-sub _parse_Regexp_attr { shift->_parse_Regex_attr(@_); }
-
-sub _parse_LocalRegex_attr {
- my ( $self, $c, $name, $value ) = @_;
- unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
-
- my $prefix = $self->path_prefix( $c );
- $prefix .= '/' if length( $prefix );
-
- return ( 'Regex', "^${prefix}${value}" );
-}
-
-sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
-
sub _parse_Chained_attr {
my ($self, $c, $name, $value) = @_;
=head2 $self->path_prefix($c)
-Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
+Returns the default path prefix for :PathPrefix, :Local and
relative :Path actions in this component. Defaults to the action_namespace or
can be overridden from the "path" config key.
=head2 Regexp
-Status: Deprecated. Use Chained methods or other techniques
+B<Status: Deprecated.> Use Chained methods or other techniques.
+If you really depend on this, install the standalone
+L<Catalyst::DispatchType::Regex> distribution.
A global way to match a give regular expression in the incoming request path.
=head2 LocalRegexp
+B<Status: Deprecated.> Use Chained methods or other techniques.
+If you really depend on this, install the standalone
+L<Catalyst::DispatchType::Regex> distribution.
+
Like L</Regex> but scoped under the namespace of the containing controller
=head2 Chained
C<auto> actions will be run before the chain dispatching begins. In
every other aspect, C<auto> actions behave as documented.
-The C<forward>ing to other actions does just what you would expect. But if
-you C<detach> out of a chain, the rest of the chain will not get called
-after the C<detach>.
+The C<forward>ing to other actions does just what you would expect. i.e.
+only the target action is run. The actions that that action is chained
+to are not run.
+If you C<detach> out of a chain, the rest of the chain will not get
+called after the C<detach>.
=head2 match_captures
+++ /dev/null
-package Catalyst::DispatchType::Regex;
-
-use Moose;
-extends 'Catalyst::DispatchType::Path';
-
-use Text::SimpleTable;
-use Catalyst::Utils;
-use Text::Balanced ();
-
-has _compiled => (
- is => 'rw',
- isa => 'ArrayRef',
- required => 1,
- default => sub{ [] },
- );
-
-no Moose;
-
-=head1 NAME
-
-Catalyst::DispatchType::Regex - Regex DispatchType
-
-=head1 SYNOPSIS
-
-See L<Catalyst::DispatchType>.
-
-=head1 DESCRIPTION
-
-Dispatch type managing path-matching behaviour using regexes. For
-more information on dispatch types, see:
-
-=over 4
-
-=item * L<Catalyst::Manual::Intro> for how they affect application authors
-
-=item * L<Catalyst::DispatchType> for implementation information.
-
-=back
-
-=head1 METHODS
-
-=head2 $self->list($c)
-
-Output a table of all regex actions, and their private equivalent.
-
-=cut
-
-sub list {
- my ( $self, $c ) = @_;
- my $avail_width = Catalyst::Utils::term_width() - 9;
- my $col1_width = ($avail_width * .50) < 35 ? 35 : int($avail_width * .50);
- my $col2_width = $avail_width - $col1_width;
- my $re = Text::SimpleTable->new(
- [ $col1_width, 'Regex' ], [ $col2_width, 'Private' ]
- );
- for my $regex ( @{ $self->_compiled } ) {
- my $action = $regex->{action};
- $re->row( $regex->{path}, "/$action" );
- }
- $c->log->debug( "Loaded Regex actions:\n" . $re->draw . "\n" )
- if ( @{ $self->_compiled } );
-}
-
-=head2 $self->match( $c, $path )
-
-Checks path against every compiled regex, and offers the action for any regex
-which matches a chance to match the request. If it succeeds, sets action,
-match and captures on $c->req and returns 1. If not, returns 0 without
-altering $c.
-
-=cut
-
-sub match {
- my ( $self, $c, $path ) = @_;
-
- return if $self->SUPER::match( $c, $path );
-
- # Check path against plain text first
-
- foreach my $compiled ( @{ $self->_compiled } ) {
- if ( my @captures = ( $path =~ $compiled->{re} ) ) {
- next unless $compiled->{action}->match($c);
- $c->req->action( $compiled->{path} );
- $c->req->match($path);
- $c->req->captures( \@captures );
- $c->action( $compiled->{action} );
- $c->namespace( $compiled->{action}->namespace );
- return 1;
- }
- }
-
- return 0;
-}
-
-=head2 $self->register( $c, $action )
-
-Registers one or more regex actions for an action object.
-Also registers them as literal paths.
-
-Returns 1 if any regexps were registered.
-
-=cut
-
-sub register {
- my ( $self, $c, $action ) = @_;
- my $attrs = $action->attributes;
- my @register = @{ $attrs->{'Regex'} || [] };
-
- foreach my $r (@register) {
- $self->register_path( $c, $r, $action );
- $self->register_regex( $c, $r, $action );
- }
-
- return 1 if @register;
- return 0;
-}
-
-=head2 $self->register_regex($c, $re, $action)
-
-Register an individual regex on the action. Usually called from the
-register method.
-
-=cut
-
-sub register_regex {
- my ( $self, $c, $re, $action ) = @_;
- push(
- @{ $self->_compiled }, # and compiled regex for us
- {
- re => qr#$re#,
- action => $action,
- path => $re,
- }
- );
-}
-
-=head2 $self->uri_for_action($action, $captures)
-
-returns a URI for this action if it can find a regex attributes that contains
-the correct number of () captures. Note that this may function incorrectly
-in the case of nested captures - if your regex does (...(..))..(..) you'll
-need to pass the first and third captures only.
-
-=cut
-
-sub uri_for_action {
- my ( $self, $action, $captures ) = @_;
-
- if (my $regexes = $action->attributes->{Regex}) {
- REGEX: foreach my $orig (@$regexes) {
- my $re = "$orig";
- $re =~ s/^\^//;
- $re =~ s/\$$//;
- $re =~ s/\\([^\\])/$1/g;
- my $final = '/';
- my @captures = @$captures;
- while (my ($front, $rest) = split(/\(/, $re, 2)) {
- last unless defined $rest;
- ($rest, $re) =
- Text::Balanced::extract_bracketed("(${rest}", '(');
- next REGEX unless @captures;
- $final .= $front.shift(@captures);
- }
- $final .= $re;
- next REGEX if @captures;
- return $final;
- }
- }
- return undef;
-}
-
-=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
-
-__PACKAGE__->meta->make_immutable;
-
-1;
# See Catalyst-Plugin-Server for them being added to, which should be much less ugly.
# Preload these action types
-our @PRELOAD = qw/Index Path Regex/;
+our @PRELOAD = qw/Index Path/;
# Postload these action types
our @POSTLOAD = qw/Default/;
# FIXME - Some error checking and re-throwing needed here, as
# we eat exceptions loading dispatch types.
eval { Class::MOP::load_class($class) };
- push( @{ $self->dispatch_types }, $class->new ) unless $@;
+ my $load_failed = $@;
+ $self->_check_depreciated_dispatch_type( $key, $load_failed );
+ push( @{ $self->dispatch_types }, $class->new ) unless $load_failed;
$registered->{$class} = 1;
}
}
return undef;
}
+sub _check_depreciated_dispatch_type {
+ my ($self, $key, $load_failed) = @_;
+
+ return unless $key =~ /^(Local)?Regexp?/;
+
+ # TODO: Should these throw an exception rather than just warning?
+ if ($load_failed) {
+ warn( "Attempt to use deprecated $key dispatch type.\n"
+ . " Use Chained methods or install the standalone\n"
+ . " Catalyst::DispatchType::Regex if necessary.\n" );
+ } elsif ( !defined $Catalyst::DispatchType::Regex::VERSION
+ || $Catalyst::DispatchType::Regex::VERSION le '5.90020' ) {
+ # We loaded the old core version of the Regex module this will break
+ warn( "The $key DispatchType has been removed from Catalyst core.\n"
+ . " An old version of the core Catalyst::DispatchType::Regex\n"
+ . " has been loaded and will likely fail. Please remove\n"
+ . " $INC{'Catalyst/DispatchType/Regex.pm'}\n"
+ . " and use Chained methods or install the standalone\n"
+ . " Catalyst::DispatchType::Regex if necessary.\n" );
+ }
+}
+
use Moose;
# 5.70 backwards compatibility hacks.
sub prepare_request {
my ($self, $ctx, %args) = @_;
+ $ctx->log->psgienv($args{env}) if $ctx->log->can('psgienv');
$ctx->request->_set_env($args{env});
$self->_set_env($args{env}); # Nasty back compat!
$ctx->response->_set_response_cb($args{response_cb});
has level => (is => 'rw');
has _body => (is => 'rw');
has abort => (is => 'rw');
+has _psgi_logger => (is => 'rw', predicate => '_has_psgi_logger', clearer => '_clear_psgi_logger');
+has _psgi_errors => (is => 'rw', predicate => '_has_psgi_errors', clearer => '_clear_psgi_errors');
+
+sub clear_psgi {
+ my $self = shift;
+ $self->_clear_psgi_logger;
+ $self->_clear_psgi_errors;
+}
+
+sub psgienv {
+ my ($self, $env) = @_;
+
+ $self->_psgi_logger($env->{'psgix.logger'}) if $env->{'psgix.logger'};
+ $self->_psgi_errors($env->{'psgi.errors'}) if $env->{'psgi.errors'};
+}
+
{
my @levels = qw[ debug info warn error fatal ];
my $self = shift;
my $level = shift;
my $message = join( "\n", @_ );
- $message .= "\n" unless $message =~ /\n$/;
- my $body = $self->_body;
- $body .= sprintf( "[%s] %s", $level, $message );
- $self->_body($body);
+ if ($self->can('_has_psgi_logger') and $self->_has_psgi_logger) {
+ $self->_psgi_logger->({
+ level => $level,
+ message => $message,
+ });
+ } else {
+ $message .= "\n" unless $message =~ /\n$/;
+ my $body = $self->_body;
+ $body .= sprintf( "[%s] %s", $level, $message );
+ $self->_body($body);
+ }
}
sub _flush {
sub _send_to_log {
my $self = shift;
- print STDERR @_;
+ if ($self->can('_has_psgi_errors') and $self->_has_psgi_errors) {
+ $self->_psgi_errors->print(@_);
+ } else {
+ print STDERR @_;
+ }
}
# 5.7 compat code.
__END__
+=for stopwords psgienv
+
=head1 NAME
Catalyst::Log - Catalyst Log Class
You may subclass this module and override this method to get finer control
over the log output.
+=head2 psgienv $env
+
+ $log->psgienv($env);
+
+NOTE: This is not meant for public consumption.
+
+Set the PSGI environment for this request. This ensures logs will be sent to
+the right place. If the environment has a C<psgix.logger>, it will be used. If
+not, we will send logs to C<psgi.errors> if that exists. As a last fallback, we
+will send to STDERR as before.
+
+=head2 clear_psgi
+
+Clears the PSGI environment attributes set by L</psgienv>.
+
=head2 meta
=head1 SEE ALSO
=item dist.ini
+=item L<cpanfile>
+
=back
=cut
sub dist_indicator_file_list {
- qw{Makefile.PL Build.PL dist.ini};
+ qw{Makefile.PL Build.PL dist.ini cpanfile};
}
sub home {
+++ /dev/null
-#!perl
-
-use strict;
-use warnings;
-
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-
-our $iters;
-
-BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-
-use Test::More tests => 38*$iters;
-use Catalyst::Test 'TestApp';
-
-use Catalyst::Request;
-
-if ( $ENV{CAT_BENCHMARK} ) {
- require Benchmark;
- Benchmark::timethis( $iters, \&run_tests );
-}
-else {
- for ( 1 .. $iters ) {
- run_tests();
- }
-}
-
-sub run_tests {
- {
- ok( my $response = request('http://localhost/action/regexp/10/hello'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- '^action/regexp/(\d+)/(\w+)$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Regexp',
- 'Test Class'
- );
- like(
- $response->content,
- qr/^bless\( .* 'Catalyst::Request' \)$/s,
- 'Content is a serialized Catalyst::Request'
- );
- }
-
- {
- ok( my $response = request('http://localhost/action/regexp/hello/10'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- '^action/regexp/(\w+)/(\d+)$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Regexp',
- 'Test Class'
- );
- like(
- $response->content,
- qr/^bless\( .* 'Catalyst::Request' \)$/s,
- 'Content is a serialized Catalyst::Request'
- );
- }
-
- {
- ok( my $response = request('http://localhost/action/regexp/mandatory'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- '^action/regexp/(mandatory)(/optional)?$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Regexp',
- 'Test Class'
- );
- my $content = $response->content;
- my $req = eval $content;
-
- is( scalar @{ $req->captures }, 2, 'number of captures' );
- is( $req->captures->[ 0 ], 'mandatory', 'mandatory capture' );
- ok( !defined $req->captures->[ 1 ], 'optional capture' );
- }
-
- {
- ok( my $response = request('http://localhost/action/regexp/mandatory/optional'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- '^action/regexp/(mandatory)(/optional)?$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Regexp',
- 'Test Class'
- );
- my $content = $response->content;
- my $req = eval $content;
-
- is( scalar @{ $req->captures }, 2, 'number of captures' );
- is( $req->captures->[ 0 ], 'mandatory', 'mandatory capture' );
- is( $req->captures->[ 1 ], '/optional', 'optional capture' );
- }
-
- # test localregex in the root controller
- {
- ok( my $response = request('http://localhost/localregex'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- '^localregex$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Root',
- 'Test Class'
- );
- }
-
- {
- my $url = 'http://localhost/action/regexp/redirect/life/universe/42/everything';
- ok( my $response = request($url),
- 'Request' );
- ok( $response->is_redirect, 'Response is redirect' );
- is( $response->header('X-Catalyst-Action'),
- '^action/regexp/redirect/(\w+)/universe/(\d+)/everything$', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Regexp',
- 'Test Class'
- );
- is(
- $response->header('location'),
- $response->request->uri,
- 'Redirect URI is the same as the request URI'
- );
- }
-}
-
use FindBin;
use lib "$FindBin::Bin/../lib";
-use Test::More tests => 28;
+use Test::More tests => 14;
use Catalyst::Test 'TestApp';
local $^W = 0;
my @tests = (
# Simple
- 'Regex vs. Local', { path => '/re_vs_loc', expect => 'local' },
- 'Regex vs. LocalRegex', { path => '/re_vs_locre', expect => 'regex' },
- 'Regex vs. Path', { path => '/re_vs_path', expect => 'path' },
- 'Local vs. LocalRegex', { path => '/loc_vs_locre', expect => 'local' },
'Local vs. Path 1', { path => '/loc_vs_path1', expect => 'local' },
'Local vs. Path 2', { path => '/loc_vs_path2', expect => 'path' },
- 'Path vs. LocalRegex', { path => '/path_vs_locre', expect => 'path' },
# index
- 'index vs. Regex', { path => '/re_vs_index', expect => 'index' },
'index vs. Local', { path => '/loc_vs_index', expect => 'index' },
- 'index vs. LocalRegex', { path => '/locre_vs_index', expect => 'index' },
'index vs. Path', { path => '/path_vs_index', expect => 'index' },
'multimethod zero', { path => '/multimethod', expect => 'zero' },
"no URI returned for Path action when snippets are given");
#
-# Regex Action
-#
-my $regex_action = $dispatcher->get_action_by_path(
- '/action/regexp/one'
- );
-
-ok(!defined($dispatcher->uri_for_action($regex_action)),
- "Regex action without captures returns undef");
-
-ok(!defined($dispatcher->uri_for_action($regex_action, [ 1, 2, 3 ])),
- "Regex action with too many captures returns undef");
-
-is($dispatcher->uri_for_action($regex_action, [ 'foo', 123 ]),
- "/action/regexp/foo/123",
- "Regex action interpolates captures correctly");
-
-my $regex_action_bs = $dispatcher->get_action_by_path(
- '/action/regexp/one_backslashes'
- );
-
-ok(!defined($dispatcher->uri_for_action($regex_action_bs)),
- "Regex action without captures returns undef");
-
-ok(!defined($dispatcher->uri_for_action($regex_action_bs, [ 1, 2, 3 ])),
- "Regex action with too many captures returns undef");
-
-is($dispatcher->uri_for_action($regex_action_bs, [ 'foo', 123 ]),
- "/action/regexp/foo/123.html",
- "Regex action interpolates captures correctly");
-
-
-#
# Index Action
#
my $index_action = $dispatcher->get_action_by_path(
ok(!defined($context->uri_for($path_action, [ 'blah' ])),
"no URI returned by uri_for for Path action with snippets");
-is($context->uri_for($regex_action, [ 'foo', 123 ], qw/bar baz/, { q => 1 }),
- "http://127.0.0.1/foo/action/regexp/foo/123/bar/baz?q=1",
- "uri_for correct for regex with captures, args and query");
-
is($context->uri_for($chained_action, [ 1 ], 2, { q => 1 }),
"http://127.0.0.1/foo/chained/foo/1/end/2?q=1",
"uri_for correct for chained with captures, args and query");
use Cwd qw/ cwd /;
my @dists = Catalyst::Utils::dist_indicator_file_list();
-is(scalar(@dists), 3, 'Makefile.PL Build.PL dist.ini');
+is(scalar(@dists), 4, 'Makefile.PL Build.PL dist.ini cpanfile');
my $cwd = cwd();
foreach my $inc ('', 'lib', 'blib'){
BUILDARGS metaclass namespaces pre ARGV ReverseProxy
filename tempname request's subdirectory ini uninstalled uppercased
wiki bitmask uri url urls dir hostname proxied http https IP SSL
- inline INLINE plugins
+ inline INLINE plugins cpanfile
FastCGI Stringifies Rethrows DispatchType Wishlist Refactor ROADMAP HTTPS Unescapes Restarter Nginx Refactored
ActionClass LocalRegex LocalRegexp MyAction metadata
Andreas
jon
konobi
marcus
+ mgrimes
miyagawa
mst
naughton
+++ /dev/null
-package TestApp::Controller::Action::Regexp;
-
-use strict;
-use base 'TestApp::Controller::Action';
-
-sub one : Action Regex('^action/regexp/(\w+)/(\d+)$') {
- my ( $self, $c ) = @_;
- $c->forward('TestApp::View::Dump::Request');
-}
-
-sub two : Action LocalRegexp('^(\d+)/(\w+)$') {
- my ( $self, $c ) = @_;
- $c->forward('TestApp::View::Dump::Request');
-}
-
-sub three : Action LocalRegex('^(mandatory)(/optional)?$'){
- my ( $self, $c ) = @_;
- $c->forward('TestApp::View::Dump::Request');
-}
-
-sub four : Action Regex('^action/regexp/redirect/(\w+)/universe/(\d+)/everything$') {
- my ( $self, $c ) = @_;
- $c->res->redirect(
- $c->uri_for($c->action, $c->req->captures,
- @{$c->req->arguments}, $c->req->params
- )
- );
-}
-
-sub one_backslashes : Action Regex('^action/regexp/(\w+)/(\d+)\.html$') {
- my ( $self, $c ) = @_;
- $c->forward('TestApp::View::Dump::Request');
-}
-
-1;
--- /dev/null
+package TestApp::Controller::Log;
+
+use strict;
+use base 'Catalyst::Controller';
+
+sub debug :Local {
+ my ( $self, $c ) = @_;
+ $c->log->debug('debug');
+ $c->res->body( 'logged' );
+}
+
+
+1;
+
use base 'Catalyst::Controller';
#
-# Regex vs. Local
-#
-
-sub re_vs_loc_re :Regex('/priorities/re_vs_loc') { $_[1]->res->body( 'regex' ) }
-sub re_vs_loc :Local { $_[1]->res->body( 'local' ) }
-
-#
-# Regex vs. LocalRegex
-#
-
-sub re_vs_locre_locre :LocalRegex('re_vs_(locre)') { $_[1]->res->body( 'local_regex' ) }
-sub re_vs_locre_re :Regex('/priorities/re_vs_locre') { $_[1]->res->body( 'regex' ) }
-
-#
-# Regex vs. Path
-#
-
-sub re_vs_path_path :Path('/priorities/re_vs_path') { $_[1]->res->body( 'path' ) }
-sub re_vs_path_re :Regex('/priorities/re_vs_path') { $_[1]->res->body( 'regex' ) }
-
-#
-# Local vs. LocalRegex
-#
-
-sub loc_vs_locre_locre :LocalRegex('loc_vs_locre') { $_[1]->res->body( 'local_regex' ) }
-sub loc_vs_locre :Local { $_[1]->res->body( 'local' ) }
-
-#
# Local vs. Path (depends on definition order)
#
sub loc_vs_path2_loc :Path('/priorities/loc_vs_path2') { $_[1]->res->body( 'path' ) }
#
-# Path vs. LocalRegex
-#
-
-sub path_vs_locre_locre :LocalRegex('path_vs_(locre)') { $_[1]->res->body( 'local_regex' ) }
-sub path_vs_locre_path :Path('/priorities/path_vs_locre') { $_[1]->res->body( 'path' ) }
-
-#
-# Regex vs. index (has sub controller)
-#
-
-sub re_vs_idx :Regex('/priorities/re_vs_index') { $_[1]->res->body( 'regex' ) }
-
-#
# Local vs. index (has sub controller)
#
sub loc_vs_index :Local { $_[1]->res->body( 'local' ) }
#
-# LocalRegex vs. index (has sub controller)
-#
-
-sub locre_vs_idx :LocalRegex('locre_vs_index') { $_[1]->res->body( 'local_regex' ) }
-
-#
# Path vs. index (has sub controller)
#
+++ /dev/null
-package TestApp::Controller::Priorities::re_vs_index;
-
-use strict;
-use base 'Catalyst::Controller';
-
-sub index :Private { $_[1]->res->body( 'index' ) }
-
-1;
$c->res->body('');
}
-sub localregex : LocalRegex('^localregex$') {
- my ( $self, $c ) = @_;
- $c->res->header( 'X-Test-Class' => ref($self) );
- $c->response->content_type('text/plain; charset=utf-8');
- $c->forward('TestApp::View::Dump::Request');
-}
-
sub index : Private {
my ( $self, $c ) = @_;
$c->res->body('root index');
# Remove context from reference if needed
my $context = delete $reference->{_context};
+ if (my $log = $reference->{_log}) {
+ $log->clear_psgi if ($log->can('psgienv'));
+ }
+
if ( my $output =
$self->dump( $reference, $purity ) )
{
--- /dev/null
+=head1 PROBLEM
+
+In https://github.com/plack/Plack/commit/cafa5db84921f020183a9c834fd6a4541e5a6b84
+chansen made a change to the FCGI handler in Plack, in which he replaced
+STDERR, STDOUT and STDIN with proper IO::Handle objects.
+
+The side effect of that change is that catalyst outputing logs on STDERR will
+no longer end up by default in the error log of the webserver when running
+under FCGI. This test tries to make sure we use the propper parts of the psgi
+environment when we output things from Catalyst::Log.
+
+There is one more "regression", and that is warnings. By using
+Catalyst::Plugin::LogWarnings, you also get those in the right place if this
+test passes :)
+
+=cut
+
+use strict;
+use warnings;
+no warnings 'once';
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More;
+
+use File::Spec;
+use File::Temp qw/ tempdir /;
+
+use TestApp;
+
+use Plack::Builder;
+use Plack::Test;
+use HTTP::Request::Common;
+
+{
+ package MockHandle;
+ use Moose;
+
+ has 'log' => (is => 'ro', isa => 'ArrayRef', traits => ['Array'], default => sub { [] },
+ handles => {
+ 'logs' => 'elements',
+ 'print' => 'push',
+ }
+ );
+
+ no Moose;
+}
+
+#subtest "psgi.errors" => sub
+{
+
+ my $handle = MockHandle->new();
+ my $app = builder {
+
+ enable sub {
+ my $app = shift;
+ sub {
+ my $env = shift;
+ $env->{'psgi.errors'} = $handle;
+ my $res = $app->($env);
+ return $res;
+ };
+ };
+ TestApp->psgi_app;
+ };
+
+
+ test_psgi $app, sub {
+ my $cb = shift;
+ my $res = $cb->(GET "/log/debug");
+ my @logs = $handle->logs;
+ is(scalar(@logs), 1, "psgi.errors: one event output");
+ like($logs[0], qr/debug$/, "psgi.errors: event matches test data");
+ };
+};
+
+#subtest "psgix.logger" => sub
+{
+
+ my @logs;
+ my $logger = sub {
+ push(@logs, @_);
+ };
+ my $app = builder {
+ enable sub {
+ my $app = shift;
+ sub {
+ my $env = shift;
+ $env->{'psgix.logger'} = $logger;
+ $app->($env);
+ };
+ };
+ TestApp->psgi_app;
+ };
+
+ test_psgi $app, sub {
+ my $cb = shift;
+ my $res = $cb->(GET "/log/debug");
+ is(scalar(@logs), 1, "psgix.logger: one event logged");
+ is_deeply($logs[0], { level => 'debug', message => "debug" }, "psgix.logger: right stuff");
+ };
+};
+
+
+
+done_testing;
projects / catagits/Catalyst-Runtime.git / commitdiff