From: Florian Ragwitz Date: Fri, 3 Dec 2010 12:20:35 +0000 (+0000) Subject: Merge branch 'master' into psgi X-Git-Tag: 5.89000~18 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=9c74923de2304b8c8f0a7a2faa0854ad9b4d3a92;hp=fb34eb9c063c53abd061d260a30f0ca7c57a0833 Merge branch 'master' into psgi master: (44 commits) Fixed chained action order resolution to pass t/aggregate/live__component_controller_action_chained2.t and without break any other test. Clarify end action after forward / detach Fix passing file GLOBs to $c->res->body Clarify docs Added a --title parameter to fastcgi script, sets process title for FCGI::ProcManager update MooseX module version due to deprecated warning typo in docs fixed Version 5.80029 Patch from the mailing list to clarify view warning Avoid issues when just using CMOP::Class Need to use _add_meta_method from new Moose onwards to avoid warnings Actually bump versions, ACTUAL 5.80028, sorry Version 5.80028 Bug fix for ctx_request, via matso++ Don't rely on qw() providing PAREN tokens We use Class::MOP in Catalyst::Utils, so load it Version 5.80027 Fix bug in the tests Version 5.80026 Add doc patch for go and captures. ... Conflicts: lib/Catalyst/Engine/FastCGI.pm lib/Catalyst/Script/FastCGI.pm lib/Catalyst/ScriptRole.pm lib/Catalyst/Test.pm t/aggregate/live_component_controller_action_streaming.t --- diff --git a/Changes b/Changes index f17bba2..0496c4b 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,70 @@ # This file documents the revision history for Perl extension Catalyst. + Documentation: + - Clarify that when forwarding or detaching, the end action associated + with the original dispatched action will be run afterwards (fallen) + +5.80029 2010-10-03 16:39:00 + + New features: + - Add a warning when $c->view is called and cannot locate a default_view + or current_view. This clarifies the logging when ::RenderView gets + confused. + + Warning fixes: + - Deal warning in with Moose >= 1.15 if you add a method called 'meta' to a + class which already has one by using _add_meta_method. + +5.80028 2010-09-28 20:49:00 + + Bug fixes: + - use Class::MOP in Catalyst::Utils. + + - Do not keep a reference to a closed over context in ctx_request, allowing + the caller to dispose of the request context at their leisure. + + - Changes to be compatible with bleadperl + +5.80027 2010-09-01 22:14:00 + + Bug fixes: + - Fix an issue with newly added test cases which depended on Catalyst::Action::RenderView + +5.80026 2010-09-01 15:14:00 + + Bug fixes: + - Fix so that CATALYST_EXCEPTION_CLASS in MyApp is always respected by + not loading Catalyst::Exception in Utils.pm BEGIN, because some Scripts::* + load Utils before MyApp.pm + + - Fix warnings with new Moose versions about "excludes" during role + application + + - Fix warning from MooseX::Getopt regarding duplicate "help" aliases. + + - parse_on_demand fixed when used in conjunction with debug mode. + A regression was introduced in 5.80022 which would cause the body + to always be parsed for logging at the end of the request when in + debug mode. This has been fixed so that if the body has not been parsed + by the time the request is logged, then the body is omitted. + + - Fix show_internal_actions config setting producing warnings in debug + mode (RT#59738) + + - Make Catalyst::Test::local_request() set the response base from base href + in the returned document so that links can be resolved correctly by + Test::WWW::Mechanize::Catalyst + + Refactoring: + - moved component name sort that happens in setup_components to + locate_components to allow methods to wrap around locate_components + + Documentation: + - Fix some typos + + - Advertise Catalyst::Plugin::SmartURI + + 5.80025 2010-07-29 01:50:00 New features: @@ -14,6 +79,8 @@ - Fix controllers with no method attributes (where the action definitions are entirely contained in config). RT#58057 - Fix running as a CGI under IIS at non-root locations. + - Fix warning about "excludes" during role application + - Fix warning from MooseX::Getopt regarding duplicate "help" aliases Documentation: - Fix missing - in the docs when describing the --mechanize option at one diff --git a/Makefile.PL b/Makefile.PL index 2b1fdae..cb27dfe 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -21,7 +21,7 @@ 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.19'; +requires 'MooseX::MethodAttributes::Inheritable' => '0.24'; requires 'MooseX::Role::WithOverloading' => '0.05'; requires 'MooseX::Types::LoadableClass' => '0.003'; requires 'Carp'; @@ -30,6 +30,7 @@ requires 'CGI::Simple::Cookie' => '1.109'; requires 'Data::Dump'; requires 'Data::OptList'; requires 'HTML::Entities'; +requires 'HTML::HeadParser'; requires 'HTTP::Body' => '1.06'; # ->cleanup(1) requires 'HTTP::Headers' => '1.64'; requires 'HTTP::Request' => '5.814'; @@ -49,7 +50,7 @@ requires 'URI' => '1.35'; requires 'Task::Weaken'; requires 'Text::Balanced'; # core in 5.8.x but mentioned for completeness requires 'MRO::Compat'; -requires 'MooseX::Getopt' => '0.25'; +requires 'MooseX::Getopt' => '0.30'; requires 'MooseX::Types'; requires 'MooseX::Types::Common::Numeric'; requires 'String::RewritePrefix' => '0.004'; # Catalyst::Utils::resolve_namespace @@ -71,7 +72,7 @@ else { grep { $_ ne 't/aggregate.t' } map { glob } qw[t/*.t t/aggregate/*.t]; } -author_requires 'CatalystX::LeakChecker', '0.05'; # Skipped if this isn't installed +author_requires 'CatalystX::LeakChecker', '0.05'; author_requires 'File::Copy::Recursive'; # For http server test author_tests 't/author'; diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index b9cf01c..f91eb26 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -81,7 +81,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.80025'; +our $VERSION = '5.80029'; sub import { my ( $class, @arguments ) = @_; @@ -102,7 +102,12 @@ sub import { $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses); unless( $meta->has_method('meta') ){ - $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } ); + if ($Moose::VERSION >= 1.15) { + $meta->_add_meta_method('meta'); + } + else { + $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } ); + } } $caller->arguments( [@arguments] ); @@ -367,6 +372,8 @@ or stash it like so: and access it from the stash. +Keep in mind that the C method used is that of the caller action. So a C<$c-Edetach> inside a forwarded action would run the C method from the original action requested. + =cut sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) } @@ -430,6 +437,10 @@ with localized C<< $c->action >> and C<< $c->namespace >>. Like C, C escapes the processing of the current request chain on completion, and does not return to its caller. +@arguments are arguments to the final destination of $action. @captures are +arguments to the intermediate steps, if any, on the way to the final sub of +$action. + =cut sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) } @@ -743,7 +754,12 @@ sub view { unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps my $comps = $c->components; my $check = $appclass."::View::".$name; - return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; + if( exists $comps->{$check} ) { + return $c->_filter_component( $comps->{$check}, @args ); + } + else { + $c->log->warn( "Attempted to use view '$check', but does not exist" ); + } } my @result = $c->_comp_search_prefixes( $name, qw/View V/ ); return map { $c->_filter_component( $_, @args ) } @result if ref $name; @@ -913,12 +929,18 @@ on the receiving component to access the config value. use Moose; # this attr will receive 'baz' at construction time - has 'bar' => ( + has 'bar' => ( is => 'rw', isa => 'Str', ); You can then get the value 'baz' by calling $c->model('Foo')->bar +(or $self->bar inside code in the model). + +B you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >> +as a way of reading config within your code, as this B give you the +correctly merged config back. You B take the config values supplied to +the constructor and use those instead. =cut @@ -1703,7 +1725,7 @@ sub _stats_start_execute { my $parent = $c->stack->[-1]; # forward, locate the caller - if ( exists $c->counter->{"$parent"} ) { + if ( defined $parent && exists $c->counter->{"$parent"} ) { $c->stats->profile( begin => $action, parent => "$parent" . $c->counter->{"$parent"}, @@ -1840,7 +1862,7 @@ sub finalize_headers { if ( $response->body && !$response->content_length ) { # get the length from a filehandle - if ( blessed( $response->body ) && $response->body->can('read') ) + if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' ) { my $stat = stat $response->body; if ( $stat && $stat->size > 0 ) { @@ -2161,7 +2183,7 @@ sub log_request { $c->log->debug("Query keywords are: $keywords"); } - $c->log_request_parameters( query => $request->query_parameters, body => $request->body_parameters ); + $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () ); $c->log_request_uploads($request); } diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm index be76915..7d0d42a 100644 --- a/lib/Catalyst/DispatchType/Chained.pm +++ b/lib/Catalyst/DispatchType/Chained.pm @@ -187,6 +187,7 @@ sub recurse_match { return () unless $children; my $best_action; my @captures; + my $found=0; TRY: foreach my $try_part (sort { length($b) <=> length($a) } keys %$children) { # $b then $a to try longest part first @@ -197,6 +198,7 @@ sub recurse_match { splice( # and strip them off @parts as well @parts, 0, scalar(@{[split('/', $try_part)]}) ))); # @{[]} to avoid split to @_ + $found=1; } my @try_actions = @{$children->{$try_part}}; TRY_ACTION: foreach my $action (@try_actions) { @@ -212,7 +214,7 @@ sub recurse_match { push(@captures, splice(@parts, 0, $capture_attr->[0])); # try the remaining parts against children of this action - my ($actions, $captures, $action_parts) = $self->recurse_match( + my ($actions, $captures, $action_parts, $found) = $self->recurse_match( $c, '/'.$action->reverse, \@parts ); # No best action currently @@ -220,13 +222,15 @@ sub recurse_match { # OR The action has equal parts but less captured data (ergo more defined) if ($actions && (!$best_action || - $#$action_parts < $#{$best_action->{parts}} || + $#$action_parts < $#{$best_action->{parts}} || ($#$action_parts == $#{$best_action->{parts}} && - $#$captures < $#{$best_action->{captures}}))){ + $#$captures < $#{$best_action->{captures}} && ($found > $best_action->{found}) + ))) { $best_action = { actions => [ $action, @$actions ], captures=> [ @captures, @$captures ], - parts => $action_parts + parts => $action_parts, + found=>$found }; } } @@ -250,13 +254,14 @@ sub recurse_match { $best_action = { actions => [ $action ], captures=> [], - parts => \@parts + parts => \@parts, + found=>$found, } } } } } - return @$best_action{qw/actions captures parts/} if $best_action; + return @$best_action{qw/actions captures parts found/} if $best_action; return (); } diff --git a/lib/Catalyst/Exception/Interface.pm b/lib/Catalyst/Exception/Interface.pm index 371bfa3..aae67f2 100644 --- a/lib/Catalyst/Exception/Interface.pm +++ b/lib/Catalyst/Exception/Interface.pm @@ -27,8 +27,8 @@ Catalyst::Exception::Interface - Role defining the interface for Catalyst except # This comprises the required interface. sub as_string { 'the exception text for stringification' } - sub die { shift; die @_ } - sub die { shift; die @_ } + sub throw { shift; die @_ } + sub rethrow { shift; die @_ } =head1 DESCRIPTION diff --git a/lib/Catalyst/Runtime.pm b/lib/Catalyst/Runtime.pm index 3925404..4ea2826 100644 --- a/lib/Catalyst/Runtime.pm +++ b/lib/Catalyst/Runtime.pm @@ -7,7 +7,7 @@ BEGIN { require 5.008004; } # Remember to update this in Catalyst as well! -our $VERSION = '5.80025'; +our $VERSION = '5.80029'; =head1 NAME diff --git a/lib/Catalyst/Script/CGI.pm b/lib/Catalyst/Script/CGI.pm index 7e53ba5..dc7f20f 100644 --- a/lib/Catalyst/Script/CGI.pm +++ b/lib/Catalyst/Script/CGI.pm @@ -17,7 +17,7 @@ Catalyst::Script::CGI - The CGI Catalyst Script myapp_cgi.pl [options] Options: - -h --help display this help and exits + -? --help display this help and exits =head1 DESCRIPTION diff --git a/lib/Catalyst/Script/FastCGI.pm b/lib/Catalyst/Script/FastCGI.pm index 47f1e1b..02ff9bd 100644 --- a/lib/Catalyst/Script/FastCGI.pm +++ b/lib/Catalyst/Script/FastCGI.pm @@ -56,13 +56,34 @@ has nproc => ( documentation => 'Specify a number of child processes', ); +has title => ( + traits => [qw(Getopt)], + cmd_aliases => 't', + 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->title; +} + sub _plack_loader_args { my ($self) = shift; return ( map { $_->[0] => $self->${ \($_->[1] ? $_->[1]->[0] : $_->[0]) } } Data::OptList::mkopt([ qw/pidfile listen manager nproc keep_stderr/, - detach => [ 'daemon'], + detach => [ 'daemon' ], + proc_title => [ 'title' ], ]) ); } @@ -72,11 +93,12 @@ sub _application_args { 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, + title => $self->title, } ); } @@ -108,6 +130,7 @@ Catalyst::Script::FastCGI - The FastCGI Catalyst Script or empty string to disable -e --keeperr send error messages to STDOUT, not to the webserver + -t --title set the process title =head1 DESCRIPTION diff --git a/lib/Catalyst/Script/Server.pm b/lib/Catalyst/Script/Server.pm index 22ed5b6..1ec97a3 100644 --- a/lib/Catalyst/Script/Server.pm +++ b/lib/Catalyst/Script/Server.pm @@ -9,8 +9,6 @@ sub _plack_engine_name { 'Standalone' } with 'Catalyst::ScriptRole'; -__PACKAGE__->meta->get_attribute('help')->cmd_aliases('?'); - has debug => ( traits => [qw(Getopt)], cmd_aliases => 'd', diff --git a/lib/Catalyst/ScriptRole.pm b/lib/Catalyst/ScriptRole.pm index 6bea8c1..af8c636 100644 --- a/lib/Catalyst/ScriptRole.pm +++ b/lib/Catalyst/ScriptRole.pm @@ -8,7 +8,7 @@ use MooseX::Types::LoadableClass qw/LoadableClass/; use namespace::autoclean; with 'MooseX::Getopt' => { - excludes => [qw/ + -excludes => [qw/ _getopt_spec_warnings _getopt_spec_exception _getopt_full_usage @@ -22,14 +22,6 @@ has application_name => ( required => 1, ); -has help => ( - traits => ['Getopt'], - isa => Bool, - is => 'ro', - documentation => 'Display this help and exit', - cmd_aliases => ['?', 'h'], -); - has loader_class => ( isa => LoadableClass, is => 'ro', @@ -63,11 +55,6 @@ sub _getopt_full_usage { exit 0; } -before run => sub { - my $self = shift; - $self->_getopt_full_usage if $self->help; -}; - sub run { my $self = shift; $self->_run_application; diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index 1a15f9f..e524840 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -48,7 +48,7 @@ my $build_exports = sub { ### place holder for $c after the request finishes; reset every time ### requests are done. - my $c; + 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. @@ -56,7 +56,7 @@ my $build_exports = sub { my $meta = Class::MOP::get_metaclass_by_name($class); $meta->make_mutable; $meta->add_after_method_modifier( "dispatch", sub { - $c = shift; + $ctx_closed_over = shift; }); $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. @@ -64,8 +64,18 @@ my $build_exports = sub { ### we've already stopped it from doing remote requests above. my $res = $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 + # caller disposes of it, rather than waiting till the next time + # that ctx_request is called. This can be important if your $ctx + # ends up with a reference to a shared resource or lock (for example) + # which you want to clean up in test teardown - if the $ctx is still + # closed over then you're stuffed... + my $ctx = $ctx_closed_over; + undef $ctx_closed_over; + ### return both values - return ( $res, $c ); + return ( $res, $ctx ); }; return { @@ -240,7 +250,30 @@ sub local_request { my $ret; test_psgi app => sub { $app->({ %{ $_[0] }, %extra_env }) }, - client => sub { $ret = shift->($request) }; + client => sub { + my $resp = shift->($request); + + # 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. + + require HTML::HeadParser; + + my $parser = HTML::HeadParser->new(); + $parser->xml_mode(1) if $resp->content_is_xhtml; + $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40; + + $parser->parse( $resp->content ); + my $h = $parser->header; + for my $f ( $h->header_field_names ) { + $resp->init_header( $f, [ $h->header($f) ] ); + } + + $ret = $resp; + }; return $ret; } diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm index d72441e..45f52e4 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -7,7 +7,7 @@ use Path::Class; use URI; use Carp qw/croak/; use Cwd; - +use Class::MOP; use String::RewritePrefix; use namespace::clean; diff --git a/t/aggregate/live__component_controller_action_chained2.t b/t/aggregate/live__component_controller_action_chained2.t new file mode 100644 index 0000000..64caeea --- /dev/null +++ b/t/aggregate/live__component_controller_action_chained2.t @@ -0,0 +1,22 @@ +use strict; +use warnings; +use FindBin qw/$Bin/; +use lib "$Bin/../lib"; +use Catalyst::Test 'ChainedActionsApp'; +use Test::More; + +plan 'skip_all' if $ENV{CATALYST_SERVER}; # This is not TestApp + +content_like('/', qr/Application Home Page/, 'Application home'); +content_like('/15/GoldFinger', qr/List project GoldFinger pages/, 'GoldFinger Project Index'); +content_like('/15/GoldFinger/4/007', qr/This is 007 page of GoldFinger project/, '007 page in GoldFinger Project'); +TODO: { + local $TODO="Bug on precedence of dispatch order of chained actions."; + content_like('/account', qr/New account o login/, 'no account'); + content_like('/account/ferz', qr/This is account ferz/, 'account'); + content_like('/account/123', qr/This is account 123/, 'account'); +} +action_notfound('/c'); + +done_testing; + diff --git a/t/aggregate/live_component_controller_action_streaming.t b/t/aggregate/live_component_controller_action_streaming.t index 95ffda1..1bc9cbf 100644 --- a/t/aggregate/live_component_controller_action_streaming.t +++ b/t/aggregate/live_component_controller_action_streaming.t @@ -51,14 +51,14 @@ EOF SKIP: { if ( $ENV{CATALYST_SERVER} ) { - skip "Using remote server", 5; + skip "Using remote server", 10; } my $file = "$FindBin::Bin/../lib/TestApp/Controller/Action/Streaming.pm"; my $fh = IO::File->new( $file, 'r' ); my $buffer; if ( defined $fh ) { - $fh->read( $buffer, 1024 ); + $fh->read( $buffer, 2048 ); $fh->close; } @@ -68,6 +68,13 @@ EOF is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->content_length, -s $file, 'Response Content-Length' ); is( $response->content, $buffer, 'Content is read from filehandle' ); + + ok( $response = request('http://localhost/action/streaming/body_glob'), + 'Request' ); + ok( $response->is_success, 'Response Successful 2xx' ); + is( $response->content_type, 'text/plain', 'Response Content-Type' ); + is( $response->content_length, -s $file, 'Response Content-Length' ); + is( $response->content, $buffer, 'Content is read from filehandle' ); } { diff --git a/t/aggregate/live_engine_response_headers.t b/t/aggregate/live_engine_response_headers.t index 123b125..0e153cf 100644 --- a/t/aggregate/live_engine_response_headers.t +++ b/t/aggregate/live_engine_response_headers.t @@ -12,7 +12,7 @@ use HTTP::Request::Common; my $content_length; -foreach my $method qw(HEAD GET) { +foreach my $method (qw(HEAD GET)) { my $expected = join( ', ', 1 .. 10 ); my $request = HTTP::Request::Common->can($method) diff --git a/t/aggregate/live_view_warnings.t b/t/aggregate/live_view_warnings.t new file mode 100644 index 0000000..1387c1b --- /dev/null +++ b/t/aggregate/live_view_warnings.t @@ -0,0 +1,23 @@ +#!perl + +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Test::More; +use Catalyst::Test 'TestAppViewWarnings'; + +if ( $ENV{CATALYST_SERVER} ) { + plan skip_all => 'Using remote server'; +} + +{ + ok( my $response = request('http://localhost/'), 'Request' ); + like($TestAppViewWarnings::log_messages[0], qr/Attempted to use view/s, 'View failure warning received'); + +} + +done_testing; + diff --git a/t/aggregate/unit_core_script_fastcgi.t b/t/aggregate/unit_core_script_fastcgi.t index ef3d007..06300f5 100644 --- a/t/aggregate/unit_core_script_fastcgi.t +++ b/t/aggregate/unit_core_script_fastcgi.t @@ -39,6 +39,10 @@ testOption( [ qw/-e/ ], [undef, opthash(keep_stderr => 1)] ); testOption( [ qw/--nproc 6/ ], [undef, opthash(nproc => 6)] ); testOption( [ qw/--n 6/ ], [undef, opthash(nproc => 6)] ); +# title +testOption( [ qw/--title foo/ ], [undef, opthash(title => 'foo')] ); +testOption( [ qw/-t foo/ ], [undef, opthash(title => 'foo')] ); + done_testing; sub testOption { @@ -59,11 +63,8 @@ sub testOption { # Returns the hash expected when no flags are passed sub opthash { return { - pidfile => undef, - keep_stderr => undef, - detach => undef, - nproc => undef, - manager => undef, + (map { ($_ => undef) } qw(pidfile keep_stderr detach nproc manager)), + title => 'perl-fcgi-pm [TestAppToTestScripts]', @_, }; } diff --git a/t/aggregate/unit_core_script_help.t b/t/aggregate/unit_core_script_help.t index 0287990..d3a6fab 100644 --- a/t/aggregate/unit_core_script_help.t +++ b/t/aggregate/unit_core_script_help.t @@ -15,7 +15,6 @@ use lib "$Bin/../lib"; sub _getopt_full_usage { $help++ } } -test('-h'); test('--help'); test('-?'); diff --git a/t/aggregate/unit_core_script_test.t b/t/aggregate/unit_core_script_test.t index 71d0e4b..e475651 100644 --- a/t/aggregate/unit_core_script_test.t +++ b/t/aggregate/unit_core_script_test.t @@ -33,8 +33,8 @@ sub run_test { } "new_with_options"; ok $i; my $saved; - open( $saved, '<&'. STDIN->fileno ) - or croak("Can't dup stdin: $!"); + open( $saved, '>&'. STDOUT->fileno ) + or croak("Can't dup stdout: $!"); open( STDOUT, '>&='. $fh->fileno ) or croak("Can't open stdout: $!"); eval { $i->run }; diff --git a/t/aggregate/unit_core_setup.t b/t/aggregate/unit_core_setup.t index cbc5aac..c0e6230 100644 --- a/t/aggregate/unit_core_setup.t +++ b/t/aggregate/unit_core_setup.t @@ -1,6 +1,6 @@ use strict; use warnings; -use Class::MOP::Class; +use Class::MOP; use Catalyst::Runtime; use Test::More tests => 29; diff --git a/t/aggregate/unit_core_setup_stats.t b/t/aggregate/unit_core_setup_stats.t index 9aca059..d8e1ff2 100644 --- a/t/aggregate/unit_core_setup_stats.t +++ b/t/aggregate/unit_core_setup_stats.t @@ -2,7 +2,7 @@ use strict; use warnings; use Test::More tests => 5; -use Class::MOP::Class; +use Class::MOP; use Catalyst (); diff --git a/t/author/podcoverage.t b/t/author/podcoverage.t index e8730de..f8868b6 100644 --- a/t/author/podcoverage.t +++ b/t/author/podcoverage.t @@ -5,9 +5,12 @@ use Test::More; use Pod::Coverage 0.19; use Test::Pod::Coverage 1.04; -all_pod_coverage_ok( - { - also_private => ['BUILD'] - } -); +my @modules = all_modules; +our @private = ( 'BUILD' ); +foreach my $module (@modules) { + local @private = (@private, 'run') if $module =~ /^Catalyst::Script::/; + pod_coverage_ok($module, { also_private => \@private }); +} + +done_testing; diff --git a/t/lib/ChainedActionsApp.pm b/t/lib/ChainedActionsApp.pm new file mode 100644 index 0000000..375ce10 --- /dev/null +++ b/t/lib/ChainedActionsApp.pm @@ -0,0 +1,21 @@ +package ChainedActionsApp; +use Moose; +use namespace::autoclean; + +use Catalyst::Runtime 5.80; + +use Catalyst qw//; + +extends 'Catalyst'; + +our $VERSION = "0.01"; +$VERSION = eval $VERSION; + +__PACKAGE__->config( + name => 'ChainedActionsApp', + disable_component_regex_fallback => 1, +); + +__PACKAGE__->setup; + +1; diff --git a/t/lib/ChainedActionsApp/Controller/Root.pm b/t/lib/ChainedActionsApp/Controller/Root.pm new file mode 100644 index 0000000..a50faa1 --- /dev/null +++ b/t/lib/ChainedActionsApp/Controller/Root.pm @@ -0,0 +1,63 @@ +package ChainedActionsApp::Controller::Root; +use Moose; +use namespace::autoclean; + +BEGIN { extends 'Catalyst::Controller' } + +# +# Sets the actions in this controller to be registered with no prefix +# so they function identically to actions created in MyApp.pm +# +__PACKAGE__->config(namespace => ''); + +sub setup : Chained('/') PathPart('') CaptureArgs(0) { + my ( $self, $c ) = @_; + # Common things here are to check for ACL and setup global contexts +} + +sub home : Chained('setup') PathPart('') Args(0) { + my($self,$c) = @_; + $c->response->body( "Application Home Page" ); +} + +sub home_base : Chained('setup') PathPart('') CaptureArgs(2) { + my($self,$c,$proj_id,$title) = @_; + $c->stash({project_id=>$proj_id, project_title=>$title}); +} + +sub hpages : Chained('home_base') PathPart('') Args(0) { + my($self,$c) = @_; + $c->response->body( "List project " . $c->stash->{project_title} . " pages"); +} + +sub hpage : Chained('home_base') PathPart('') Args(2) { + my($self,$c,$page_id, $pagetitle) = @_; + $c->response->body( "This is $pagetitle page of " . $c->stash->{project_title} . " project" ); +} + +sub no_account : Chained('setup') PathPart('account') Args(0) { + my($self,$c) = @_; + $c->response->body( "New account o login" ); +} + +sub account_base : Chained('setup') PathPart('account') CaptureArgs(1) { + my($self,$c,$acc_id) = @_; + $c->stash({account_id=>$acc_id}); +} + +sub account : Chained('account_base') PathPart('') Args(0) { + my($self,$c,$acc) = @_; + $c->response->body( "This is account " . $c->stash->{account_id} ); +} + +sub default : Chained('setup') PathPart('') Args() { + my ( $self, $c ) = @_; + $c->response->body( 'Page not found' ); + $c->response->status(404); +} + +sub end : Action {} + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/t/lib/TestApp/Controller/Action/Streaming.pm b/t/lib/TestApp/Controller/Action/Streaming.pm index 08c7c65..a5b2c81 100644 --- a/t/lib/TestApp/Controller/Action/Streaming.pm +++ b/t/lib/TestApp/Controller/Action/Streaming.pm @@ -27,6 +27,19 @@ sub body : Local { } } +sub body_glob : Local { + my ( $self, $c ) = @_; + + my $file = "$FindBin::Bin/../lib/TestApp/Controller/Action/Streaming.pm"; + open my $fh, '<', $file; + if ( defined $fh ) { + $c->res->body( $fh ); + } + else { + $c->res->body( "Unable to read $file" ); + } +} + sub body_large : Local { my ($self, $c) = @_; diff --git a/t/lib/TestApp/Controller/Anon.pm b/t/lib/TestApp/Controller/Anon.pm index 68b4fd6..1bc3698 100644 --- a/t/lib/TestApp/Controller/Anon.pm +++ b/t/lib/TestApp/Controller/Anon.pm @@ -25,7 +25,6 @@ sub COMPONENT { # Don't do this yourself, use CatalystX::Component::Traits! # Special move as the methodattributes trait has changed our metaclass.. $meta = find_meta($meta->name); - $meta->add_method('meta' => sub { $meta }); $class = $meta->name; $class->new($app, $args); } diff --git a/t/lib/TestApp/Controller/Root.pm b/t/lib/TestApp/Controller/Root.pm index 5b29201..18c6db8 100644 --- a/t/lib/TestApp/Controller/Root.pm +++ b/t/lib/TestApp/Controller/Root.pm @@ -49,6 +49,22 @@ sub recursion_test : Local { $c->forward( 'recursion_test' ); } +sub base_href_test : Local { + my ( $self, $c ) = @_; + + my $body = <<"EndOfBody"; + + + + + + + +EndOfBody + + $c->response->body($body); +} + sub end : Private { my ($self,$c) = @_; } diff --git a/t/lib/TestAppShowInternalActions.pm b/t/lib/TestAppShowInternalActions.pm new file mode 100644 index 0000000..250730f --- /dev/null +++ b/t/lib/TestAppShowInternalActions.pm @@ -0,0 +1,20 @@ +package TestAppShowInternalActions; +use Moose; +use namespace::autoclean; + +use Catalyst::Runtime 5.80; + +use Catalyst qw/ -Debug /; # Debug must remain on for + # t/live_show_internal_actions_warnings.t + +extends 'Catalyst'; + +__PACKAGE__->config( + name => 'TestAppShowInternalActions', + disable_component_resolution_regex_fallback => 1, + show_internal_actions => 1, +); + +__PACKAGE__->setup(); + +1; diff --git a/t/lib/TestAppShowInternalActions/Controller/Root.pm b/t/lib/TestAppShowInternalActions/Controller/Root.pm new file mode 100644 index 0000000..c36df9c --- /dev/null +++ b/t/lib/TestAppShowInternalActions/Controller/Root.pm @@ -0,0 +1,19 @@ +package TestAppShowInternalActions::Controller::Root; +use Moose; +use namespace::autoclean; + +BEGIN { extends 'Catalyst::Controller' } + +__PACKAGE__->config(namespace => ''); + +sub index :Path :Args(0) { + my ( $self, $c ) = @_; + + $c->response->body( 'hello world' ); +} + +sub end : Action {} + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/t/lib/TestAppViewWarnings.pm b/t/lib/TestAppViewWarnings.pm new file mode 100644 index 0000000..3a9102c --- /dev/null +++ b/t/lib/TestAppViewWarnings.pm @@ -0,0 +1,22 @@ +use strict; +use warnings; + +package TestAppViewWarnings; + +use Catalyst; + +our @log_messages; + +__PACKAGE__->config( name => 'TestAppWarnings', root => '/some/dir', default_view => "DoesNotExist" ); + +__PACKAGE__->log(TestAppViewWarnings::Log->new); + +__PACKAGE__->setup; + +package TestAppViewWarnings::Log; + +use base qw/Catalyst::Log/; +sub warn { push(@TestAppViewWarnings::log_messages, @_[1..$#_]); } + +1; + diff --git a/t/lib/TestAppViewWarnings/Controller/Root.pm b/t/lib/TestAppViewWarnings/Controller/Root.pm new file mode 100644 index 0000000..6d252f8 --- /dev/null +++ b/t/lib/TestAppViewWarnings/Controller/Root.pm @@ -0,0 +1,17 @@ +package TestAppViewWarnings::Controller::Root; +use strict; +use warnings; +use base 'Catalyst::Controller'; + +__PACKAGE__->config->{namespace} = ''; + +# Return log messages from previous request +sub index :Path Args() {} + +sub end : Action { + my ($self, $c) = @_; + $c->view; # Cause view lookup and ergo warning we are testing. + $c->res->body('foo'); +} + +1; diff --git a/t/live_catalyst_test.t b/t/live_catalyst_test.t index f4f695e..1adecbb 100644 --- a/t/live_catalyst_test.t +++ b/t/live_catalyst_test.t @@ -3,7 +3,7 @@ use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestApp', {default_host => 'default.com'}; use Catalyst::Request; -use Test::More tests => 8; +use Test::More tests => 9; content_like('/',qr/root/,'content check'); action_ok('/','Action ok ok','normal action ok'); @@ -11,6 +11,12 @@ action_redirect('/engine/response/redirect/one','redirect check'); action_notfound('/engine/response/status/s404','notfound check'); contenttype_is('/action/local/one','text/plain','Contenttype check'); +### local_request() was not setting response base from base href +{ + my $response = request('/base_href_test'); + is( $response->base, 'http://www.example.com/', 'response base set from base href'); +} + my $creq; my $req = '/dump/request'; diff --git a/t/live_show_internal_actions_warnings.t b/t/live_show_internal_actions_warnings.t new file mode 100644 index 0000000..0fe6ea3 --- /dev/null +++ b/t/live_show_internal_actions_warnings.t @@ -0,0 +1,25 @@ +use strict; +use warnings; +use FindBin '$Bin'; +use lib "$Bin/lib"; +use Test::More; +use File::Spec; +BEGIN { # Shut up debug output, app needs debug on for the issue to + # appear, but we don't want the spraff to the screen + + my $devnull = File::Spec->devnull; + open my $fh, '>', $devnull or die "Cannot write to $devnull: $!"; + + *STDERR = $fh; +} + +use Catalyst::Test 'TestAppShowInternalActions'; + +my $last_warning; +{ + local $SIG{__WARN__} = sub { $last_warning = shift }; + my $res = get('/'); +} +is( $last_warning, undef, 'there should be no warnings about uninitialized value' ); + +done_testing; diff --git a/t/optional_http-server-restart.t b/t/optional_http-server-restart.t index 3d3cb3f..9d58e08 100644 --- a/t/optional_http-server-restart.t +++ b/t/optional_http-server-restart.t @@ -13,17 +13,14 @@ use FindBin; use LWP::Simple; use IO::Socket; use IPC::Open3; -use Catalyst::Engine::HTTP::Restarter::Watcher; use Time::HiRes qw/sleep/; -eval "use Catalyst::Devel 1.0;"; +eval {require Catalyst::Devel; Catalyst::Devel->VERSION(1.0);}; plan skip_all => 'Catalyst::Devel required' if $@; plan skip_all => 'Catalyst::Devel >= 1.04 required' if $Catalyst::Devel::VERSION <= 1.03; eval "use File::Copy::Recursive"; plan skip_all => 'File::Copy::Recursive required' if $@; -plan tests => 120; - my $tmpdir = "$FindBin::Bin/../t/tmp"; # clean up @@ -33,7 +30,7 @@ rmtree $tmpdir if -d $tmpdir; mkdir $tmpdir; chdir $tmpdir; -system( $^X, "-I$FindBin::Bin/../lib", "$FindBin::Bin/../script/catalyst.pl", 'TestApp' ); +system( $^X, "-I$FindBin::Bin/../lib", '-MFile::Spec', '-e', "\@ARGV=('TestApp'); my \$devnull = File::Spec->devnull; open my \$fh, '>', \$devnull or die \"Cannot write to \$devnull: \$!\"; *STDOUT = \$fh; do \"$FindBin::Bin/../script/catalyst.pl\""); chdir "$FindBin::Bin/.."; File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); @@ -46,8 +43,8 @@ my $port = 30000 + int rand( 1 + 10000 ); my( $server, $pid ); my @cmd = ($^X, "-I$FindBin::Bin/../lib", "-I$FindBin::Bin/lib", - "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port', - $port, '-restart'); + "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '--port', + $port, '--restart'); $pid = open3( undef, $server, undef, @cmd ) or die "Unable to spawn standalone HTTP server: $!"; @@ -83,7 +80,7 @@ for ( 1 .. 20 ) { # give the server time to notice the change and restart my $count = 0; my $line; - while ( ( $line || '' ) !~ /can connect/ ) { + while ( ( $line || '' ) !~ /ttempting to restart the server/ ) { # wait for restart message $line = $server->getline; sleep 0.1; @@ -110,45 +107,6 @@ for ( 1 .. 20 ) { sleep 1; } -# add errors to the file and make sure server does not die or restart -NO_RESTART_ON_ERROR: -for ( 1 .. 20 ) { - my $index = rand @files; - open my $pm, '>>', $files[$index] - or die "Unable to open $files[$index] for writing: $!"; - print $pm "bleh"; - close $pm; - - my $count = 0; - my $line; - - while ( ( $line || '' ) !~ /failed/ ) { - # wait for restart message - $line = $server->getline; - sleep 0.1; - if ( $count++ > 100 ) { - fail "Server restarted"; - SKIP: { - skip "Server didn't restart, no sense in checking response", 1; - } - next NO_RESTART_ON_ERROR; - } - }; - - pass "Server refused to restart"; - - if ( check_port( 'localhost', $port ) != 1 ) { - die "Server appears to have died"; - } - my $response = get("http://localhost:$port/action/default"); - like( $response, qr/Catalyst::Request/, - 'Syntax error, no restart, request OK' ); - - # give the server some time to reindex its files - sleep 1; - -} - # multiple restart directories # we need different options so we have to rebuild most @@ -157,87 +115,11 @@ for ( 1 .. 20 ) { kill 'KILL', $pid; close $server; -# pick next port because the last one might still be blocked from -# previous server. This might fail if this port is unavailable -# but picking the first one has the same problem so this is acceptable - -$port += 1; - -{ no warnings 'once'; $File::Copy::Recursive::RMTrgFil = 1; } -File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); - -# change various files -@files = ( - "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm", - "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Engine/Request/URI.pm", -); - -my $app_root = "$FindBin::Bin/../t/tmp/TestApp"; -my $restartdirs = join ' ', map{ - "-restartdirectory $app_root/lib/TestApp/Controller/$_" -} qw/Action Engine/; - -$pid = open3( undef, $server, undef, - $^X, "-I$FindBin::Bin/../lib", - "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port', - $port, '-restart', $restartdirs ) - or die "Unable to spawn standalone HTTP server: $!"; -$server->blocking( 0 ); - - -# wait for it to start -print "Waiting for server to start...\n"; -while ( check_port( 'localhost', $port ) != 1 ) { - sleep 1; -} - -MULTI_DIR_RESTART: -for ( 1 .. 20 ) { - my $index = rand @files; - open my $pm, '>>', $files[$index] - or die "Unable to open $files[$index] for writing: $!"; - print $pm "\n"; - close $pm; - - # give the server time to notice the change and restart - my $count = 0; - my $line; - - while ( ( $line || '' ) !~ /can connect/ ) { - # wait for restart message - $line = $server->getline; - sleep 0.1; - if ( $count++ > 100 ) { - fail "Server restarted"; - SKIP: { - skip "Server didn't restart, no sense in checking response", 1; - } - next MULTI_DIR_RESTART; - } - }; - pass "Server restarted with multiple restartdirs"; - - $count = 0; - while ( check_port( 'localhost', $port ) != 1 ) { - # wait for it to restart - sleep 0.1; - die "Server appears to have died" if $count++ > 100; - } - my $response = get("http://localhost:$port/action/default"); - like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' ); - - # give the server some time to reindex its files - sleep 1; -} - -# shut it down again - -kill 'KILL', $pid; -close $server; - # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; +done_testing; + sub check_port { my ( $host, $port ) = @_; diff --git a/t/optional_threads.t b/t/optional_threads.t index baa4089..9ed878f 100644 --- a/t/optional_threads.t +++ b/t/optional_threads.t @@ -44,7 +44,7 @@ sub request { TestApp::Controller::Action::Default->begin TestApp::Controller::Action::Default->default TestApp::View::Dump::Request->process - TestApp->end + TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); diff --git a/t/unit_core_methodattributes_method_metaclass_on_subclasses.t b/t/unit_core_methodattributes_method_metaclass_on_subclasses.t index b6f5054..8b8b659 100644 --- a/t/unit_core_methodattributes_method_metaclass_on_subclasses.t +++ b/t/unit_core_methodattributes_method_metaclass_on_subclasses.t @@ -15,13 +15,13 @@ use Test::More; sub test {} } - +my $c = 0; foreach my $class (qw/ CT RT /) { my $class_name = 'NoAttributes::' . $class; my $meta = $class_name->meta; my $meth = $meta->find_method_by_name('test'); { - local $TODO = "Known MX::MethodAttributes issue"; + local $TODO = "Known MX::MethodAttributes issue" if $c++; ok $meth->can('attributes'), 'method metaclass has ->attributes method for ' . $class;; } }