From: Tomas Doran Date: Thu, 12 Nov 2009 01:39:56 +0000 (+0000) Subject: Patch up changes to tests into new location. This merges parts of the following commi... X-Git-Tag: 5.80014~15^2~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=02fee6c690aa8c2a8ccd2d862928ec4c64e63712;hp=9427c0579e74d599eb45a062b10a36ef60d2aed0;p=catagits%2FCatalyst-Runtime.git Patch up changes to tests into new location. This merges parts of the following commits which were missed by svk: -r11456:11457 http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/5.80/trunk -r11467:11468 http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/5.80/trunk --- diff --git a/Changes b/Changes index 4c16b16..9af16b5 100644 --- a/Changes +++ b/Changes @@ -7,11 +7,47 @@ - Catalyst::Dispatcher::dispatch_types no longer throws deprecated warnings as there is no recommended alternative. - Improved the suggested fix warning when component resolution uses regex - fallback for fully qualified component names. (abraxxa) + fallback for fully qualified component names. + - Catalyst::Test::local_request sets ->request on the response. + - Require HTTP::Request 5.814 and HTTP::Response 5.813 from LWP 5.814 + to avoid test fails. + - Log flush moved to the end of setup so that roles and plugins which + hook setup_finalize can log things and have them appear in application + startup, rather than with the first hit. + - Require a newer version of LWP to avoid failing tests. + - Stop warnings when actions are forwarded to during dispatch. + - Remove warnings for using Catalyst::Dispatcher->dispatch_types as this is a + valid method to publicly call on the dispatcher. + + Documentation: + - Document no-args call to $c->uri_for. + - Document all top level application configuration parameters. + - Clarify how to fix actions in your application class (which is + deprecated and causes warnings). + - Pod fixes for ContextClosure. + - Fix documentation for go/visit to reference captures and arguments + in the correct order. + - Update $c->forward and $c->state documentation to address scalar + context. New features: - Added disable_component_resolution_regex_fallback config option to - switch off regex fallback for component resolution. (abraxxa) + switch off (deprecated) regex fallback for component resolution. + - Added an nginx-specific behavior to the FastCGI engine to allow + proper PATH_INFO and SCRIPT_NAME processing for non-root applications + - Enable Catalyst::Utils::home() to find home within Dist::Zilla built + distributions + - Enable Catalyst::Utils::home() to find home within Dist::Zilla built + dists + + Refactoring / cleanups: + - Remove documentation for the case_sensitive setting + - Warning is now emitted at application startup if the case_sensitive + setting is turned on. This setting is not used by anyone, not + believed to be useful and adds unnecessary complexity to controllers + and the dispatcher. If you are using this setting and have good reasons + why it should stay then you need to be shouting, now. + - Writing to $c->req->body now fails as doing this never makes sense. 5.80013 2009-09-17 11:07:04 diff --git a/Makefile.PL b/Makefile.PL index 7283506..be08062 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,13 +1,15 @@ use strict; use warnings; use inc::Module::Install 0.87; -BEGIN { # Make it easy for newbies - if ($Module::Install::AUTHOR) { - require Module::Install::AuthorRequires; - require Module::Install::CheckConflicts; - require Module::Install::AuthorTests; - } +{ # Ensure that these get used - yes, M::I loads them for us, but if you're + # in author mode and don't have them installed, then the error is tres + # cryptic. + no warnings 'redefine'; + use Module::Install::AuthorRequires; + use Module::Install::CheckConflicts; + use Module::Install::AuthorTests; } + perl_version '5.008004'; name 'Catalyst-Runtime'; @@ -28,8 +30,8 @@ requires 'Data::Dump'; requires 'HTML::Entities'; requires 'HTTP::Body' => '1.04'; # makes uploadtmp work requires 'HTTP::Headers' => '1.64'; -requires 'HTTP::Request'; -requires 'HTTP::Response'; +requires 'HTTP::Request' => '5.814'; +requires 'HTTP::Response' => '5.813'; requires 'HTTP::Request::AsCGI' => '0.8'; requires 'LWP::UserAgent'; requires 'Module::Pluggable' => '3.9'; @@ -147,8 +149,8 @@ sub darwin_check_no_resource_forks { # TAR on 10.4 wants COPY_EXTENDED_ATTRIBUTES_DISABLE # On 10.5 (Leopard) it wants COPYFILE_DISABLE - die("Oh, you got Snow Lepoard, snazzy. Please read the man page for tar to find out if Apple renamed COPYFILE_DISABLE again and fix this Makefile.PL please?\n") if $osx_ver =~ /^10.6/; - my $attr = $osx_ver =~ /^10.5/ ? 'COPYFILE_DISABLE' : 'COPY_EXTENDED_ATTRIBUTES_DISABLE'; + die("Oh, you got Ceiling Cat, snazzy. Please read the man page for tar or Google to find out if Apple renamed COPYFILE_DISABLE (it was COPY_EXTENDED_ATTRIBUTES_DISABLE originally) again and fix this Makefile.PL please?\n") if $osx_ver =~ /^10.7/; + my $attr = $osx_ver =~ /^10.(5|6)/ ? 'COPYFILE_DISABLE' : 'COPY_EXTENDED_ATTRIBUTES_DISABLE'; makemaker_args(dist => { PREOP => qq{\@if [ "\$\$$attr" != "true" ]; then}. qq{ echo "You must set the ENV variable $attr to true,"; }. diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 12697bc..d681c90 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -803,8 +803,8 @@ component name will be returned. If Catalyst can't find a component by name, it will fallback to regex matching by default. To disable this behaviour set disable_component_resolution_regex_fallback to a true value. - - __PACKAGE__->config( { disable_component_resolution_regex_fallback => 1 } ); + + __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 ); =cut @@ -1145,7 +1145,6 @@ EOF my $name = $class->config->{name} || 'Application'; $class->log->info("$name powered by Catalyst $Catalyst::VERSION"); } - $class->log->_flush() if $class->log->can('_flush'); # Make sure that the application class becomes immutable at this point, B::Hooks::EndOfScope::on_scope_end { @@ -1170,7 +1169,16 @@ EOF ) unless $meta->is_immutable; }; + if ($class->config->{case_sensitive}) { + $class->log->warn($class . "->config->{case_sensitive} is set."); + $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81."); + } + $class->setup_finalize; + # Should be the last thing we do so that user things hooking + # setup_finalize can log.. + $class->log->_flush() if $class->log->can('_flush'); + return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE. } @@ -1198,7 +1206,7 @@ sub setup_finalize { $class->setup_finished(1); } -=head2 $c->uri_for( $path, @args?, \%query_values? ) +=head2 $c->uri_for( $path?, @args?, \%query_values? ) =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? ) @@ -1206,6 +1214,10 @@ Constructs an absolute L object based on the application root, the provided path, and the additional arguments and query parameters provided. When used as a string, provides a textual URI. +If no arguments are provided, the URI for the current action is returned. +To return the current action and also provide @args, use +C<< $c->uri_for( $c->action, @args ) >>. + If the first argument is a string, it is taken as a public URI path relative to C<< $c->namespace >> (if it doesn't begin with a forward slash) or relative to the application root (if it does). It is then merged with @@ -1629,9 +1641,10 @@ sub _stats_start_execute { # is this a root-level call or a forwarded call? if ( $callsub =~ /forward$/ ) { + my $parent = $c->stack->[-1]; # forward, locate the caller - if ( my $parent = $c->stack->[-1] ) { + if ( exists $c->counter->{"$parent"} ) { $c->stats->profile( begin => $action, parent => "$parent" . $c->counter->{"$parent"}, @@ -2663,6 +2676,73 @@ messages in template systems. sub version { return $Catalyst::VERSION } +=head1 CONFIGURATION + +There are a number of 'base' config variables which can be set: + +=over + +=item * + +C - The default model picked if you say C<< $c->model >>. See Lmodel($name)>. + +=item * + +C - The default view to be rendered or returned when C<< $c->view >>. See Lview($name)>. +is called. + +=item * + +C - Turns +off the deprecated component resolution functionality so +that if any of the component methods (e.g. C<< $c->controller('Foo') >>) +are called then regex search will not be attempted on string values and +instead C will be returned. + +=item * + +C - The application home directory. In an uninstalled application, +this is the top level application directory. In an installed application, +this will be the directory containing C<< MyApp.pm >>. + +=item * + +C - See L + +=item * + +C - The name of the application in debug messages and the debug and +welcome screens + +=item * + +C - 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 + +=item * + +C - The root directory for templates. Usually this is just a +subdirectory of the home directory, but you can set it to change the +templates to a different directory. + +=item * + +C - Array reference passed to Module::Pluggable to for additional +namespaces from which components will be loaded (and constructed and stored in +C<< $c->components >>). + +=item * + +C - If true, causes internal actions such as C<< _DISPATCH >> +to be shown in hit debug tables in the test server. + +=item * + +C - See L. + +=back + =head1 INTERNAL ACTIONS Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>, @@ -2671,16 +2751,6 @@ action table, but you can make them visible with a config parameter. MyApp->config(show_internal_actions => 1); -=head1 CASE SENSITIVITY - -By default Catalyst is not case sensitive, so C is -mapped to C. You can activate case sensitivity with a config -parameter. - - MyApp->config(case_sensitive => 1); - -This causes C to map to C. - =head1 ON-DEMAND PARSER The request body is usually parsed at the beginning of a request, @@ -2790,6 +2860,8 @@ abw: Andy Wardley acme: Leon Brocard +abraxxa: Alexander Hartmaier + Andrew Bramble Andrew Ford EA.Ford@ford-mason.co.ukE diff --git a/lib/Catalyst/Engine/FastCGI.pm b/lib/Catalyst/Engine/FastCGI.pm index 280fee1..a6e9688 100644 --- a/lib/Catalyst/Engine/FastCGI.pm +++ b/lib/Catalyst/Engine/FastCGI.pm @@ -234,7 +234,12 @@ sub _fix_env if ( $env->{SERVER_SOFTWARE} =~ /lighttpd/ ) { $env->{PATH_INFO} ||= delete $env->{SCRIPT_NAME}; } - # Fix the environment variables PATH_INFO and SCRIPT_NAME when running under IIS + 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}); @@ -433,6 +438,76 @@ above modes. Note the required mod_rewrite rule. For more information on using FastCGI under Lighttpd, visit L +=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 PATH_INFO $fastcgi_script_name; + fastcgi_param SCRIPT_NAME $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) 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 PATH_INFO /myapp/; + fastcgi_param SCRIPT_NAME $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 + =head2 Microsoft IIS It is possible to run Catalyst under IIS with FastCGI, but only on IIS 6.0 diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index 3383fc6..9c9705e 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -110,7 +110,7 @@ has _body => ( sub body { my $self = shift; $self->_context->prepare_body(); - $self->_body(@_) if scalar @_; + croak 'body is a reader' if scalar @_; return blessed $self->_body ? $self->_body->body : $self->_body; } @@ -570,7 +570,7 @@ L objects. =head2 $req->uri -Returns a URI object for the current request. Stringifies to the URI text. +Returns a L object for the current request. Stringifies to the URI text. =head2 $req->mangle_params( { key => 'value' }, $appendmode); @@ -676,7 +676,10 @@ sub uri_with { =head2 $req->user Returns the currently logged in user. B, do not call, -this will be removed in version 5.81. +this will be removed in version 5.81. To retrieve the currently authenticated +user, see C<< $c->user >> and C<< $c->user_exists >> in +L. For the C provided by the +webserver, see C<< $req->remote_user >> below. =head2 $req->remote_user diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index 92fe12b..8776803 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -228,7 +228,9 @@ sub local_request { $class->handle_request( env => \%ENV ); - return $cgi->restore->response; + my $response = $cgi->restore->response; + $response->request( $request ); + return $response; } my $agent; diff --git a/lib/Catalyst/Upgrading.pod b/lib/Catalyst/Upgrading.pod index 98f2d9d..4fd14d8 100644 --- a/lib/Catalyst/Upgrading.pod +++ b/lib/Catalyst/Upgrading.pod @@ -32,7 +32,8 @@ L in your applications. =head2 Controller actions in Moose roles -Declaring actions in Roles is currently unsupported. +You can use L if you want to declare actions +inside Moose roles. =head2 Using Moose in Components @@ -309,7 +310,26 @@ COMPONENT method in your @ISA. Having actions in your application class will now emit a warning at application startup as this is deprecated. It is highly recommended that these actions are moved into a MyApp::Controller::Root (as demonstrated by the scaffold application -generated by catalyst.pl) +generated by catalyst.pl). + +This warning, also affects tests. You should move actions in your test, +creating a myTest::Controller::Root, like the following example: + + package MyTest::Controller::Root; + + use strict; + use warnings; + + use parent 'Catalyst::Controller'; + + __PACKAGE__->config(namespace => ''); + + sub action : Local { + my ( $self, $c ) = @_; + $c->do_something; + } + + 1; =head2 ::[MVC]:: naming scheme @@ -381,7 +401,7 @@ to B of the packages defined within that component. Calling the plugin method is deprecated, and calling it at run time is B. -Instead you are recommended to use L< Catalyst::Model::Adaptor > or similar to +Instead you are recommended to use L or similar to compose the functionality you need outside of the main application name space. Calling the plugin method will not be supported past Catalyst 5.81. diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm index 05248fc..cc3f326 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -172,8 +172,9 @@ sub home { # pop off /lib and /blib if they're there $home = $home->parent while $home =~ /b?lib$/; - # only return the dir if it has a Makefile.PL or Build.PL - if (-f $home->file("Makefile.PL") or -f $home->file("Build.PL")) { + # only return the dir if it has a Makefile.PL or Build.PL or dist.ini + if (-f $home->file("Makefile.PL") or -f $home->file("Build.PL") + or -f $home->file("dist.ini")) { # clean up relative path: # MyApp/script/.. -> MyApp diff --git a/t/c3_appclass_bug.t b/t/aggregate/c3_appclass_bug.t similarity index 100% rename from t/c3_appclass_bug.t rename to t/aggregate/c3_appclass_bug.t diff --git a/t/c3_mro.t b/t/aggregate/c3_mro.t similarity index 98% rename from t/c3_mro.t rename to t/aggregate/c3_mro.t index d987544..99057c8 100644 --- a/t/c3_mro.t +++ b/t/aggregate/c3_mro.t @@ -15,7 +15,7 @@ my @cat_mods; local @INC = grep {/blib/} @INC; @cat_mods = ( - 'Catalyst', + 'Catalyst', Module::Pluggable::Object->new(search_path => ['Catalyst'])->plugins, ); } diff --git a/t/caf_backcompat.t b/t/aggregate/caf_backcompat.t similarity index 100% rename from t/caf_backcompat.t rename to t/aggregate/caf_backcompat.t diff --git a/t/custom_live_component_controller_action_auto_doublebug.t b/t/aggregate/custom_live_component_controller_action_auto_doublebug.t similarity index 95% rename from t/custom_live_component_controller_action_auto_doublebug.t rename to t/aggregate/custom_live_component_controller_action_auto_doublebug.t index b1417a0..1b657e6 100644 --- a/t/custom_live_component_controller_action_auto_doublebug.t +++ b/t/aggregate/custom_live_component_controller_action_auto_doublebug.t @@ -4,7 +4,7 @@ use strict; use warnings; use FindBin; -use lib "$FindBin::Bin/lib"; +use lib "$FindBin::Bin/../lib"; our $iters; @@ -22,23 +22,23 @@ else { run_tests(); } } - + sub run_tests { SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 3; } - + { my @expected = qw[ TestAppDoubleAutoBug::Controller::Root->auto TestAppDoubleAutoBug::Controller::Root->default TestAppDoubleAutoBug::Controller::Root->end ]; - + my $expected = join( ", ", @expected ); - + ok( my $response = request('http://localhost/action/auto/one'), 'auto + local' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); diff --git a/t/custom_live_path_bug.t b/t/aggregate/custom_live_path_bug.t similarity index 94% rename from t/custom_live_path_bug.t rename to t/aggregate/custom_live_path_bug.t index 9bbbd55..a6081c4 100644 --- a/t/custom_live_path_bug.t +++ b/t/aggregate/custom_live_path_bug.t @@ -4,7 +4,7 @@ use strict; use warnings; use FindBin; -use lib "$FindBin::Bin/lib"; +use lib "$FindBin::Bin/../lib"; our $iters; @@ -22,14 +22,14 @@ else { run_tests(); } } - + sub run_tests { SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 2; } - + { my $expected = 'This is the foo method.'; ok( my $response = request('http://localhost/'), 'response ok' ); diff --git a/t/meta_method_unneeded.t b/t/aggregate/meta_method_unneeded.t similarity index 95% rename from t/meta_method_unneeded.t rename to t/aggregate/meta_method_unneeded.t index aa43472..f52a9b4 100644 --- a/t/meta_method_unneeded.t +++ b/t/aggregate/meta_method_unneeded.t @@ -1,7 +1,7 @@ use strict; use warnings; use FindBin qw/$Bin/; -use lib "$Bin/lib"; +use lib "$Bin/../lib"; use Test::More tests => 1; use Test::Exception; use Carp (); diff --git a/t/unit_controller_actions.t b/t/aggregate/unit_controller_actions.t similarity index 100% rename from t/unit_controller_actions.t rename to t/aggregate/unit_controller_actions.t diff --git a/t/unit_controller_config.t b/t/aggregate/unit_controller_config.t similarity index 100% rename from t/unit_controller_config.t rename to t/aggregate/unit_controller_config.t diff --git a/t/unit_controller_namespace.t b/t/aggregate/unit_controller_namespace.t similarity index 100% rename from t/unit_controller_namespace.t rename to t/aggregate/unit_controller_namespace.t diff --git a/t/unit_core_action.t b/t/aggregate/unit_core_action.t similarity index 100% rename from t/unit_core_action.t rename to t/aggregate/unit_core_action.t diff --git a/t/unit_core_classdata.t b/t/aggregate/unit_core_classdata.t similarity index 100% rename from t/unit_core_classdata.t rename to t/aggregate/unit_core_classdata.t diff --git a/t/unit_core_component.t b/t/aggregate/unit_core_component.t similarity index 99% rename from t/unit_core_component.t rename to t/aggregate/unit_core_component.t index 53d6567..69ac6c0 100644 --- a/t/unit_core_component.t +++ b/t/aggregate/unit_core_component.t @@ -89,5 +89,5 @@ is_deeply([ MyApp->comp('Foo') ], \@complist, 'Fallthrough return ok'); $c->component('Mode', qw/foo3 bar3/); is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok'); -} +} diff --git a/t/unit_core_component_loading.t b/t/aggregate/unit_core_component_loading.t similarity index 94% rename from t/unit_core_component_loading.t rename to t/aggregate/unit_core_component_loading.t index 1944ab6..2c53144 100644 --- a/t/unit_core_component_loading.t +++ b/t/aggregate/unit_core_component_loading.t @@ -11,6 +11,7 @@ use File::Spec; use File::Path; my $libdir = 'test_trash'; +local @INC = @INC; unshift(@INC, $libdir); my $appclass = 'TestComponents'; @@ -41,7 +42,7 @@ my @components = ( { type => 'View', prefix => 'View', name => 'Foo' }, ); -sub write_component_file { +sub write_component_file { my ($dir_list, $module_name, $content) = @_; my $dir = File::Spec->catdir(@$dir_list); @@ -54,7 +55,7 @@ sub write_component_file { } sub make_component_file { - my ($type, $prefix, $name) = @_; + my ($libdir, $appclass, $type, $prefix, $name) = @_; my $compbase = "Catalyst::${type}"; my $fullname = "${appclass}::${prefix}::${name}"; @@ -78,9 +79,13 @@ EOF } foreach my $component (@components) { - make_component_file($component->{type}, - $component->{prefix}, - $component->{name}); + make_component_file( + $libdir, + $appclass, + $component->{type}, + $component->{prefix}, + $component->{name}, + ); } my $shut_up_deprecated_warnings = q{ @@ -138,9 +143,13 @@ $appclass = 'ExtraOptions'; push @components, { type => 'View', prefix => 'Extra', name => 'Foo' }; foreach my $component (@components) { - make_component_file($component->{type}, - $component->{prefix}, - $component->{name}); + make_component_file( + $libdir, + $appclass, + $component->{type}, + $component->{prefix}, + $component->{name}, + ); } eval qq( @@ -171,7 +180,7 @@ write_component_file([$libdir, $appclass, 'Model'], 'TopLevel', <next::method(\@_); no strict 'refs'; *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; }; diff --git a/t/unit_core_component_mro.t b/t/aggregate/unit_core_component_mro.t similarity index 81% rename from t/unit_core_component_mro.t rename to t/aggregate/unit_core_component_mro.t index a8699c3..8e9a064 100644 --- a/t/unit_core_component_mro.t +++ b/t/aggregate/unit_core_component_mro.t @@ -17,13 +17,13 @@ use warnings; } my $warn = ''; -{ +{ local $SIG{__WARN__} = sub { - $warn .= $_[0]; + $warn .= $_[0]; }; MyApp::MyComponent->COMPONENT('MyApp'); } -like($warn, qr/after Catalyst::Component in MyApp::Component/, +like($warn, qr/after Catalyst::Component in MyApp::Component/, 'correct warning thrown'); diff --git a/t/unit_core_engine_fixenv-iis6.t b/t/aggregate/unit_core_engine_fixenv-iis6.t similarity index 100% rename from t/unit_core_engine_fixenv-iis6.t rename to t/aggregate/unit_core_engine_fixenv-iis6.t diff --git a/t/unit_core_engine_fixenv-lighttpd.t b/t/aggregate/unit_core_engine_fixenv-lighttpd.t similarity index 100% rename from t/unit_core_engine_fixenv-lighttpd.t rename to t/aggregate/unit_core_engine_fixenv-lighttpd.t diff --git a/t/unit_core_log.t b/t/aggregate/unit_core_log.t similarity index 91% rename from t/unit_core_log.t rename to t/aggregate/unit_core_log.t index 26a52d3..f488d48 100644 --- a/t/unit_core_log.t +++ b/t/aggregate/unit_core_log.t @@ -1,17 +1,12 @@ use strict; use warnings; -use Test::More tests => 23; +use Test::More tests => 22; -my $LOG; +use Catalyst::Log; -BEGIN { - chdir 't' if -d 't'; - use lib '../lib'; - $LOG = 'Catalyst::Log'; - use_ok $LOG or die; -} -my @MESSAGES; +local *Catalyst::Log::_send_to_log; +local our @MESSAGES; { no warnings 'redefine'; *Catalyst::Log::_send_to_log = sub { @@ -20,6 +15,8 @@ my @MESSAGES; }; } +my $LOG = 'Catalyst::Log'; + can_ok $LOG, 'new'; ok my $log = $LOG->new, '... and creating a new log object should succeed'; isa_ok $log, $LOG, '... and the object it returns'; diff --git a/t/unit_core_merge_config_hashes.t b/t/aggregate/unit_core_merge_config_hashes.t similarity index 84% rename from t/unit_core_merge_config_hashes.t rename to t/aggregate/unit_core_merge_config_hashes.t index 53f8be2..1ac737b 100644 --- a/t/unit_core_merge_config_hashes.t +++ b/t/aggregate/unit_core_merge_config_hashes.t @@ -34,10 +34,10 @@ my @tests = ( }, ); -plan tests => scalar @tests + 1; +plan tests => scalar @tests; -use_ok('Catalyst'); +use Catalyst::Component; for my $test ( @ tests ) { - is_deeply( Catalyst->merge_config_hashes( @{ $test->{ given } } ), $test->{ expects } ); + is_deeply( Catalyst::Component->merge_config_hashes( @{ $test->{ given } } ), $test->{ expects } ); } diff --git a/t/aggregate/unit_core_mvc.t b/t/aggregate/unit_core_mvc.t new file mode 100644 index 0000000..b04c3a3 --- /dev/null +++ b/t/aggregate/unit_core_mvc.t @@ -0,0 +1,227 @@ +use Test::More tests => 51; +use strict; +use warnings; + +use_ok('Catalyst'); + +my @complist = + map { "MyMVCTestApp::$_"; } + qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/; + +{ + + package MyMVCTestApp; + + use base qw/Catalyst/; + + __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @complist } ); + + my $thingie={}; + bless $thingie, 'Some::Test::Object'; + __PACKAGE__->components->{'MyMVCTestApp::Model::Test::Object'} = $thingie; + + # allow $c->log->warn to work + __PACKAGE__->setup_log; +} + +is( MyMVCTestApp->view('View'), 'MyMVCTestApp::V::View', 'V::View ok' ); + +is( MyMVCTestApp->controller('Controller'), + 'MyMVCTestApp::C::Controller', 'C::Controller ok' ); + +is( MyMVCTestApp->model('Model'), 'MyMVCTestApp::M::Model', 'M::Model ok' ); + +is( MyMVCTestApp->model('Dummy::Model'), 'MyMVCTestApp::Model::Dummy::Model', 'Model::Dummy::Model ok' ); + +isa_ok( MyMVCTestApp->model('Test::Object'), 'Some::Test::Object', 'Test::Object ok' ); + +is( MyMVCTestApp->controller('Model::Dummy::Model'), 'MyMVCTestApp::Controller::Model::Dummy::Model', 'Controller::Model::Dummy::Model ok' ); + +is( MyMVCTestApp->view('V'), 'MyMVCTestApp::View::V', 'View::V ok' ); + +is( MyMVCTestApp->controller('C'), 'MyMVCTestApp::Controller::C', 'Controller::C ok' ); + +is( MyMVCTestApp->model('M'), 'MyMVCTestApp::Model::M', 'Model::M ok' ); + +# failed search +{ + is( MyMVCTestApp->model('DNE'), undef, 'undef for invalid search' ); +} + +is_deeply( [ sort MyMVCTestApp->views ], + [ qw/V View/ ], + 'views ok' ); + +is_deeply( [ sort MyMVCTestApp->controllers ], + [ qw/C Controller Model::Dummy::Model/ ], + 'controllers ok'); + +is_deeply( [ sort MyMVCTestApp->models ], + [ qw/Dummy::Model M Model Test::Object/ ], + 'models ok'); + +{ + my $warnings = 0; + no warnings 'redefine'; + local *Catalyst::Log::warn = sub { $warnings++ }; + + like (MyMVCTestApp->view , qr/^MyMVCTestApp\::(V|View)\::/ , 'view() with no defaults returns *something*'); + ok( $warnings, 'view() w/o a default is random, warnings thrown' ); +} + +is ( bless ({stash=>{current_view=>'V'}}, 'MyMVCTestApp')->view , 'MyMVCTestApp::View::V', 'current_view ok'); + +my $view = bless {} , 'MyMVCTestApp::View::V'; +is ( bless ({stash=>{current_view_instance=> $view }}, 'MyMVCTestApp')->view , $view, 'current_view_instance ok'); + +is ( bless ({stash=>{current_view_instance=> $view, current_view=>'MyMVCTestApp::V::View' }}, 'MyMVCTestApp')->view , $view, + 'current_view_instance precedes current_view ok'); + +{ + my $warnings = 0; + no warnings 'redefine'; + local *Catalyst::Log::warn = sub { $warnings++ }; + + ok( my $model = MyMVCTestApp->model ); + + ok( (($model =~ /^MyMVCTestApp\::(M|Model)\::/) || + $model->isa('Some::Test::Object')), + 'model() with no defaults returns *something*' ); + + ok( $warnings, 'model() w/o a default is random, warnings thrown' ); +} + +is ( bless ({stash=>{current_model=>'M'}}, 'MyMVCTestApp')->model , 'MyMVCTestApp::Model::M', 'current_model ok'); + +my $model = bless {} , 'MyMVCTestApp::Model::M'; +is ( bless ({stash=>{current_model_instance=> $model }}, 'MyMVCTestApp')->model , $model, 'current_model_instance ok'); + +is ( bless ({stash=>{current_model_instance=> $model, current_model=>'MyMVCTestApp::M::Model' }}, 'MyMVCTestApp')->model , $model, + 'current_model_instance precedes current_model ok'); + +MyMVCTestApp->config->{default_view} = 'V'; +is ( bless ({stash=>{}}, 'MyMVCTestApp')->view , 'MyMVCTestApp::View::V', 'default_view ok'); +is ( MyMVCTestApp->view , 'MyMVCTestApp::View::V', 'default_view in class method ok'); + +MyMVCTestApp->config->{default_model} = 'M'; +is ( bless ({stash=>{}}, 'MyMVCTestApp')->model , 'MyMVCTestApp::Model::M', 'default_model ok'); +is ( MyMVCTestApp->model , 'MyMVCTestApp::Model::M', 'default_model in class method ok'); + +# regexp behavior tests +{ + # is_deeply is used because regexp behavior means list context + is_deeply( [ MyMVCTestApp->view( qr{^V[ie]+w$} ) ], [ 'MyMVCTestApp::V::View' ], 'regexp view ok' ); + is_deeply( [ MyMVCTestApp->controller( qr{Dummy\::Model$} ) ], [ 'MyMVCTestApp::Controller::Model::Dummy::Model' ], 'regexp controller ok' ); + is_deeply( [ MyMVCTestApp->model( qr{Dum{2}y} ) ], [ 'MyMVCTestApp::Model::Dummy::Model' ], 'regexp model ok' ); + + # object w/ qr{} + is_deeply( [ MyMVCTestApp->model( qr{Test} ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' ); + + { + my $warnings = 0; + no warnings 'redefine'; + local *Catalyst::Log::warn = sub { $warnings++ }; + + # object w/ regexp fallback + is_deeply( [ MyMVCTestApp->model( 'Test' ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' ); + ok( $warnings, 'regexp fallback warnings' ); + } + + is_deeply( [ MyMVCTestApp->view('MyMVCTestApp::V::View$') ], [ 'MyMVCTestApp::V::View' ], 'Explicit return ok'); + is_deeply( [ MyMVCTestApp->controller('MyMVCTestApp::C::Controller$') ], [ 'MyMVCTestApp::C::Controller' ], 'Explicit return ok'); + is_deeply( [ MyMVCTestApp->model('MyMVCTestApp::M::Model$') ], [ 'MyMVCTestApp::M::Model' ], 'Explicit return ok'); +} + +{ + my @expected = qw( MyMVCTestApp::C::Controller MyMVCTestApp::Controller::C ); + is_deeply( [ sort MyMVCTestApp->controller( qr{^C} ) ], \@expected, 'multiple controller returns from regexp search' ); +} + +{ + my @expected = qw( MyMVCTestApp::V::View MyMVCTestApp::View::V ); + is_deeply( [ sort MyMVCTestApp->view( qr{^V} ) ], \@expected, 'multiple view returns from regexp search' ); +} + +{ + my @expected = qw( MyMVCTestApp::M::Model MyMVCTestApp::Model::M ); + is_deeply( [ sort MyMVCTestApp->model( qr{^M} ) ], \@expected, 'multiple model returns from regexp search' ); +} + +# failed search +{ + is( scalar MyMVCTestApp->controller( qr{DNE} ), 0, '0 results for failed search' ); +} + +#checking @args passed to ACCEPT_CONTEXT +{ + my $args; + + { + no warnings 'once'; + *MyMVCTestApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args}; + *MyMVCTestApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args}; + } + + my $c = bless {}, 'MyMVCTestApp'; + + # test accept-context with class rather than instance + MyMVCTestApp->model('M', qw/foo bar/); + is_deeply($args, [qw/foo bar/], 'MyMVCTestApp->model args passed to ACCEPT_CONTEXT ok'); + + + $c->model('M', qw/foo bar/); + is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok'); + + my $x = $c->view('V', qw/foo2 bar2/); + is_deeply($args, [qw/foo2 bar2/], '$c->view args passed to ACCEPT_CONTEXT ok'); + + # regexp fallback + $c->view('::View::V', qw/foo3 bar3/); + is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok'); + + +} + +{ + my $warn = ''; + no warnings 'redefine'; + local *Catalyst::Log::warn = sub { $warn .= $_[1] }; + + is_deeply (MyMVCTestApp->controller('MyMVCTestApp::Controller::C'), + MyMVCTestApp->components->{'MyMVCTestApp::Controller::C'}, + 'controller by fully qualified name ok'); + + # You probably meant $c->controller('C') instead of $c->controller({'MyMVCTestApp::Controller::C'}) + my ($suggested_comp_name, $orig_comp_name) = $warn =~ /You probably meant (.*) instead of (.*) /; + isnt($suggested_comp_name, $orig_comp_name, 'suggested fix in warning for fully qualified component names makes sense' ); +} + +{ + package MyApp::WithoutRegexFallback; + + use base qw/Catalyst/; + + __PACKAGE__->config( { disable_component_resolution_regex_fallback => 1 } ); + + __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } + qw/MyApp::WithoutRegexFallback::Controller::Another::Foo/ } ); + + # allow $c->log->warn to work + __PACKAGE__->setup_log; +} + +{ + # test if non-regex component retrieval still works + is( MyApp::WithoutRegexFallback->controller('Another::Foo'), + 'MyApp::WithoutRegexFallback::Controller::Another::Foo', 'controller Another::Foo found'); +} + +{ + my $warnings = 0; + no warnings 'redefine'; + local *Catalyst::Log::warn = sub { $warnings++ }; + + # try to get nonexisting object w/o regexp fallback + is( MyApp::WithoutRegexFallback->controller('Foo'), undef, 'no controller Foo found'); + ok( !$warnings, 'no regexp fallback warnings' ); +} diff --git a/t/unit_core_path_to.t b/t/aggregate/unit_core_path_to.t similarity index 100% rename from t/unit_core_path_to.t rename to t/aggregate/unit_core_path_to.t diff --git a/t/unit_core_plugin.t b/t/aggregate/unit_core_plugin.t similarity index 94% rename from t/unit_core_plugin.t rename to t/aggregate/unit_core_plugin.t index 03d16f6..11cef84 100644 --- a/t/unit_core_plugin.t +++ b/t/aggregate/unit_core_plugin.t @@ -11,9 +11,8 @@ use lib 't/lib'; package Faux::Plugin; - sub new { bless {}, shift } - my $count = 1; - sub count { $count++ } + sub new { bless { count => 1 }, shift } + sub count { shift->{count}++ } } my $warnings = 0; diff --git a/t/unit_core_setup.t b/t/aggregate/unit_core_setup.t similarity index 100% rename from t/unit_core_setup.t rename to t/aggregate/unit_core_setup.t diff --git a/t/unit_core_setup_log.t b/t/aggregate/unit_core_setup_log.t similarity index 100% rename from t/unit_core_setup_log.t rename to t/aggregate/unit_core_setup_log.t diff --git a/t/unit_core_setup_stats.t b/t/aggregate/unit_core_setup_stats.t similarity index 77% rename from t/unit_core_setup_stats.t rename to t/aggregate/unit_core_setup_stats.t index 11ef840..9aca059 100644 --- a/t/unit_core_setup_stats.t +++ b/t/aggregate/unit_core_setup_stats.t @@ -6,7 +6,7 @@ use Class::MOP::Class; use Catalyst (); -my %log_messages; # TODO - Test log messages as expected. +local our %log_messages; # TODO - Test log messages as expected. my $mock_log = Class::MOP::Class->create_anon_class( methods => { map { my $level = $_; @@ -21,10 +21,11 @@ my $mock_log = Class::MOP::Class->create_anon_class( sub mock_app { my $name = shift; + my $mock_log = shift; %log_messages = (); # Flatten log messages. my $meta = Moose->init_meta( for_class => $name ); $meta->superclasses('Catalyst'); - $meta->add_method('log', sub { $mock_log }); + $meta->add_method('log', sub { $mock_log }); return $meta->name; } @@ -36,17 +37,17 @@ foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) { } { - my $app = mock_app('TestAppNoStats'); + my $app = mock_app('TestAppNoStats', $mock_log); $app->setup_stats(); ok !$app->use_stats, 'stats off by default'; } { - my $app = mock_app('TestAppStats'); + my $app = mock_app('TestAppStats', $mock_log); $app->setup_stats(1); ok $app->use_stats, 'stats on if you say >setup_stats(1)'; } { - my $app = mock_app('TestAppStatsDebugTurnsStatsOn'); + my $app = mock_app('TestAppStatsDebugTurnsStatsOn', $mock_log); $app->meta->add_method('debug' => sub { 1 }); $app->setup_stats(); ok $app->use_stats, 'debug on turns stats on'; @@ -54,14 +55,14 @@ foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) { { local %ENV = %ENV; $ENV{CATALYST_STATS} = 1; - my $app = mock_app('TestAppStatsEnvSet'); + my $app = mock_app('TestAppStatsEnvSet', $mock_log); $app->setup_stats(); ok $app->use_stats, 'ENV turns stats on'; } { local %ENV = %ENV; $ENV{CATALYST_STATS} = 0; - my $app = mock_app('TestAppStatsEnvUnset'); + my $app = mock_app('TestAppStatsEnvUnset', $mock_log); $app->meta->add_method('debug' => sub { 1 }); $app->setup_stats(1); ok !$app->use_stats, 'ENV turns stats off, even when debug on and ->setup_stats(1)'; diff --git a/t/unit_core_uri_for.t b/t/aggregate/unit_core_uri_for.t similarity index 99% rename from t/unit_core_uri_for.t rename to t/aggregate/unit_core_uri_for.t index 3dd3a69..170e91b 100644 --- a/t/unit_core_uri_for.t +++ b/t/aggregate/unit_core_uri_for.t @@ -46,7 +46,7 @@ is( is (Catalyst::uri_for( $context, '/bar/wibble?' )->as_string, 'http://127.0.0.1/foo/bar/wibble%3F', 'Question Mark gets encoded' ); - + is( Catalyst::uri_for( $context, qw/bar wibble?/, 'with space' )->as_string, 'http://127.0.0.1/foo/yada/bar/wibble%3F/with%20space', 'Space gets encoded' ); diff --git a/t/unit_core_uri_with.t b/t/aggregate/unit_core_uri_with.t similarity index 100% rename from t/unit_core_uri_with.t rename to t/aggregate/unit_core_uri_with.t diff --git a/t/unit_dispatcher_requestargs_restore.t b/t/aggregate/unit_dispatcher_requestargs_restore.t similarity index 91% rename from t/unit_dispatcher_requestargs_restore.t rename to t/aggregate/unit_dispatcher_requestargs_restore.t index 1ffff9c..9c4b7fa 100644 --- a/t/unit_dispatcher_requestargs_restore.t +++ b/t/aggregate/unit_dispatcher_requestargs_restore.t @@ -1,6 +1,6 @@ # Insane test case for the behavior needed by Plugin::Auhorization::ACL -# We have to localise $c->request->{arguments} in +# We have to localise $c->request->{arguments} in # Catalyst::Dispatcher::_do_forward, rather than using save and restore, # as otherwise, the calling $c->detach on an action which says # die $Catalyst:DETACH causes the request arguments to not get restored, @@ -14,7 +14,7 @@ use strict; use warnings; use FindBin qw/$Bin/; -use lib "$Bin/lib"; +use lib "$Bin/../lib"; use Catalyst::Test 'ACLTestApp'; use Test::More tests => 1; diff --git a/t/unit_load_catalyst_test.t b/t/aggregate/unit_load_catalyst_test.t similarity index 94% rename from t/unit_load_catalyst_test.t rename to t/aggregate/unit_load_catalyst_test.t index ffa5655..fa8144c 100644 --- a/t/unit_load_catalyst_test.t +++ b/t/aggregate/unit_load_catalyst_test.t @@ -4,10 +4,10 @@ use strict; use warnings; use FindBin; -use lib "$FindBin::Bin/lib"; -use Test::More tests => 59; +use lib "$FindBin::Bin/../lib"; +use Test::More tests => 61; use FindBin qw/$Bin/; -use lib "$Bin/lib"; +use lib "$Bin/../lib"; use Catalyst::Utils; use HTTP::Request::Common; use Test::Exception; @@ -89,6 +89,9 @@ use_ok( $Class ); " Content recorded in response" ); ok( $c->stash, " Stash accessible" ); ok( $c->action, " Action object accessible" ); + ok( $res->request, " Response has request object" ); + lives_and { is( $res->request->uri, $Url) } + " Request object has correct url"; } } } diff --git a/t/unit_metaclass_compat_extend_non_moose_controller.t b/t/aggregate/unit_metaclass_compat_extend_non_moose_controller.t similarity index 100% rename from t/unit_metaclass_compat_extend_non_moose_controller.t rename to t/aggregate/unit_metaclass_compat_extend_non_moose_controller.t diff --git a/t/unit_metaclass_compat_non_moose.t b/t/aggregate/unit_metaclass_compat_non_moose.t similarity index 100% rename from t/unit_metaclass_compat_non_moose.t rename to t/aggregate/unit_metaclass_compat_non_moose.t diff --git a/t/unit_metaclass_compat_non_moose_controller.t b/t/aggregate/unit_metaclass_compat_non_moose_controller.t similarity index 93% rename from t/unit_metaclass_compat_non_moose_controller.t rename to t/aggregate/unit_metaclass_compat_non_moose_controller.t index 3b91ef2..1672a18 100644 --- a/t/unit_metaclass_compat_non_moose_controller.t +++ b/t/aggregate/unit_metaclass_compat_non_moose_controller.t @@ -2,7 +2,7 @@ use strict; use warnings; use FindBin; -use lib "$FindBin::Bin/lib"; +use lib "$FindBin::Bin/../lib"; use Test::More tests => 1; use Test::Exception; diff --git a/t/unit_response.t b/t/aggregate/unit_response.t similarity index 100% rename from t/unit_response.t rename to t/aggregate/unit_response.t diff --git a/t/unit_utils_env_value.t b/t/aggregate/unit_utils_env_value.t similarity index 95% rename from t/unit_utils_env_value.t rename to t/aggregate/unit_utils_env_value.t index 015b455..5dd92cf 100644 --- a/t/unit_utils_env_value.t +++ b/t/aggregate/unit_utils_env_value.t @@ -1,9 +1,9 @@ use strict; use warnings; -use Test::More tests => 5; +use Test::More tests => 4; -BEGIN { use_ok("Catalyst::Utils") } +use Catalyst::Utils; ############################################################################## ### No env vars defined diff --git a/t/unit_utils_prefix.t b/t/aggregate/unit_utils_prefix.t similarity index 93% rename from t/unit_utils_prefix.t rename to t/aggregate/unit_utils_prefix.t index a1b7efa..506fbc2 100644 --- a/t/unit_utils_prefix.t +++ b/t/aggregate/unit_utils_prefix.t @@ -3,11 +3,11 @@ use strict; use warnings; -use Test::More tests => 9; +use Test::More tests => 8; use lib "t/lib"; -BEGIN { use_ok("Catalyst::Utils") }; +use Catalyst::Utils; is( Catalyst::Utils::class2prefix('MyApp::V::Foo::Bar'), 'foo/bar', 'class2prefix works with M/V/C' ); diff --git a/t/unit_utils_request.t b/t/aggregate/unit_utils_request.t similarity index 90% rename from t/unit_utils_request.t rename to t/aggregate/unit_utils_request.t index ce74d55..e02791b 100644 --- a/t/unit_utils_request.t +++ b/t/aggregate/unit_utils_request.t @@ -1,9 +1,9 @@ use strict; use warnings; -use Test::More tests => 5; +use Test::More tests => 4; -use_ok('Catalyst::Utils'); +use Catalyst::Utils; { my $url = "/dump"; diff --git a/t/lib/TestApp/Controller/Action/Private.pm b/t/lib/TestApp/Controller/Action/Private.pm index d067223..9d384ed 100644 --- a/t/lib/TestApp/Controller/Action/Private.pm +++ b/t/lib/TestApp/Controller/Action/Private.pm @@ -8,27 +8,27 @@ sub default : Private { $c->res->output('access denied'); } -sub one : Private { +sub one : Private { my ( $self, $c ) = @_; $c->res->output('access allowed'); } -sub two : Private Relative { +sub two : Private { my ( $self, $c ) = @_; $c->res->output('access allowed'); } -sub three : Private Absolute { +sub three : Private { my ( $self, $c ) = @_; $c->res->output('access allowed'); } -sub four : Private Path('/action/private/four') { +sub four : Private { my ( $self, $c ) = @_; $c->res->output('access allowed'); } -sub five : Private Path('five') { +sub five : Private { my ( $self, $c ) = @_; $c->res->output('access allowed'); } diff --git a/t/lib/TestApp/Controller/Dump.pm b/t/lib/TestApp/Controller/Dump.pm index fcbdc5e..69431b3 100644 --- a/t/lib/TestApp/Controller/Dump.pm +++ b/t/lib/TestApp/Controller/Dump.pm @@ -3,7 +3,7 @@ package TestApp::Controller::Dump; use strict; use base 'Catalyst::Controller'; -sub default : Action Private { +sub default : Action { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump'); } diff --git a/t/lib/TestAppDoubleAutoBug.pm b/t/lib/TestAppDoubleAutoBug.pm index 82a5e07..524ed8b 100644 --- a/t/lib/TestAppDoubleAutoBug.pm +++ b/t/lib/TestAppDoubleAutoBug.pm @@ -44,3 +44,6 @@ sub execute { return $c->SUPER::execute(@_); } + +1; + diff --git a/t/lib/TestAppStats.pm b/t/lib/TestAppStats.pm index 6e3b320..84cc85c 100644 --- a/t/lib/TestAppStats.pm +++ b/t/lib/TestAppStats.pm @@ -21,3 +21,6 @@ use base qw/Catalyst::Log/; sub info { push(@TestAppStats::log_messages, @_); } sub debug { push(@TestAppStats::log_messages, @_); } + +1; + diff --git a/t/unit_core_mvc.t b/t/unit_core_mvc.t deleted file mode 100644 index b5bbd8b..0000000 --- a/t/unit_core_mvc.t +++ /dev/null @@ -1,227 +0,0 @@ -use Test::More tests => 51; -use strict; -use warnings; - -use_ok('Catalyst'); - -my @complist = - map { "MyApp::$_"; } - qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/; - -{ - - package MyApp; - - use base qw/Catalyst/; - - __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @complist } ); - - my $thingie={}; - bless $thingie, 'Some::Test::Object'; - __PACKAGE__->components->{'MyApp::Model::Test::Object'} = $thingie; - - # allow $c->log->warn to work - __PACKAGE__->setup_log; -} - -is( MyApp->view('View'), 'MyApp::V::View', 'V::View ok' ); - -is( MyApp->controller('Controller'), - 'MyApp::C::Controller', 'C::Controller ok' ); - -is( MyApp->model('Model'), 'MyApp::M::Model', 'M::Model ok' ); - -is( MyApp->model('Dummy::Model'), 'MyApp::Model::Dummy::Model', 'Model::Dummy::Model ok' ); - -isa_ok( MyApp->model('Test::Object'), 'Some::Test::Object', 'Test::Object ok' ); - -is( MyApp->controller('Model::Dummy::Model'), 'MyApp::Controller::Model::Dummy::Model', 'Controller::Model::Dummy::Model ok' ); - -is( MyApp->view('V'), 'MyApp::View::V', 'View::V ok' ); - -is( MyApp->controller('C'), 'MyApp::Controller::C', 'Controller::C ok' ); - -is( MyApp->model('M'), 'MyApp::Model::M', 'Model::M ok' ); - -# failed search -{ - is( MyApp->model('DNE'), undef, 'undef for invalid search' ); -} - -is_deeply( [ sort MyApp->views ], - [ qw/V View/ ], - 'views ok' ); - -is_deeply( [ sort MyApp->controllers ], - [ qw/C Controller Model::Dummy::Model/ ], - 'controllers ok'); - -is_deeply( [ sort MyApp->models ], - [ qw/Dummy::Model M Model Test::Object/ ], - 'models ok'); - -{ - my $warnings = 0; - no warnings 'redefine'; - local *Catalyst::Log::warn = sub { $warnings++ }; - - like (MyApp->view , qr/^MyApp\::(V|View)\::/ , 'view() with no defaults returns *something*'); - ok( $warnings, 'view() w/o a default is random, warnings thrown' ); -} - -is ( bless ({stash=>{current_view=>'V'}}, 'MyApp')->view , 'MyApp::View::V', 'current_view ok'); - -my $view = bless {} , 'MyApp::View::V'; -is ( bless ({stash=>{current_view_instance=> $view }}, 'MyApp')->view , $view, 'current_view_instance ok'); - -is ( bless ({stash=>{current_view_instance=> $view, current_view=>'MyApp::V::View' }}, 'MyApp')->view , $view, - 'current_view_instance precedes current_view ok'); - -{ - my $warnings = 0; - no warnings 'redefine'; - local *Catalyst::Log::warn = sub { $warnings++ }; - - ok( my $model = MyApp->model ); - - ok( (($model =~ /^MyApp\::(M|Model)\::/) || - $model->isa('Some::Test::Object')), - 'model() with no defaults returns *something*' ); - - ok( $warnings, 'model() w/o a default is random, warnings thrown' ); -} - -is ( bless ({stash=>{current_model=>'M'}}, 'MyApp')->model , 'MyApp::Model::M', 'current_model ok'); - -my $model = bless {} , 'MyApp::Model::M'; -is ( bless ({stash=>{current_model_instance=> $model }}, 'MyApp')->model , $model, 'current_model_instance ok'); - -is ( bless ({stash=>{current_model_instance=> $model, current_model=>'MyApp::M::Model' }}, 'MyApp')->model , $model, - 'current_model_instance precedes current_model ok'); - -MyApp->config->{default_view} = 'V'; -is ( bless ({stash=>{}}, 'MyApp')->view , 'MyApp::View::V', 'default_view ok'); -is ( MyApp->view , 'MyApp::View::V', 'default_view in class method ok'); - -MyApp->config->{default_model} = 'M'; -is ( bless ({stash=>{}}, 'MyApp')->model , 'MyApp::Model::M', 'default_model ok'); -is ( MyApp->model , 'MyApp::Model::M', 'default_model in class method ok'); - -# regexp behavior tests -{ - # is_deeply is used because regexp behavior means list context - is_deeply( [ MyApp->view( qr{^V[ie]+w$} ) ], [ 'MyApp::V::View' ], 'regexp view ok' ); - is_deeply( [ MyApp->controller( qr{Dummy\::Model$} ) ], [ 'MyApp::Controller::Model::Dummy::Model' ], 'regexp controller ok' ); - is_deeply( [ MyApp->model( qr{Dum{2}y} ) ], [ 'MyApp::Model::Dummy::Model' ], 'regexp model ok' ); - - # object w/ qr{} - is_deeply( [ MyApp->model( qr{Test} ) ], [ MyApp->components->{'MyApp::Model::Test::Object'} ], 'Object returned' ); - - { - my $warnings = 0; - no warnings 'redefine'; - local *Catalyst::Log::warn = sub { $warnings++ }; - - # object w/ regexp fallback - is_deeply( [ MyApp->model( 'Test' ) ], [ MyApp->components->{'MyApp::Model::Test::Object'} ], 'Object returned' ); - ok( $warnings, 'regexp fallback warnings' ); - } - - is_deeply( [ MyApp->view('MyApp::V::View$') ], [ 'MyApp::V::View' ], 'Explicit return ok'); - is_deeply( [ MyApp->controller('MyApp::C::Controller$') ], [ 'MyApp::C::Controller' ], 'Explicit return ok'); - is_deeply( [ MyApp->model('MyApp::M::Model$') ], [ 'MyApp::M::Model' ], 'Explicit return ok'); -} - -{ - my @expected = qw( MyApp::C::Controller MyApp::Controller::C ); - is_deeply( [ sort MyApp->controller( qr{^C} ) ], \@expected, 'multiple controller returns from regexp search' ); -} - -{ - my @expected = qw( MyApp::V::View MyApp::View::V ); - is_deeply( [ sort MyApp->view( qr{^V} ) ], \@expected, 'multiple view returns from regexp search' ); -} - -{ - my @expected = qw( MyApp::M::Model MyApp::Model::M ); - is_deeply( [ sort MyApp->model( qr{^M} ) ], \@expected, 'multiple model returns from regexp search' ); -} - -# failed search -{ - is( scalar MyApp->controller( qr{DNE} ), 0, '0 results for failed search' ); -} - -#checking @args passed to ACCEPT_CONTEXT -{ - my $args; - - { - no warnings 'once'; - *MyApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args}; - *MyApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args}; - } - - my $c = bless {}, 'MyApp'; - - # test accept-context with class rather than instance - MyApp->model('M', qw/foo bar/); - is_deeply($args, [qw/foo bar/], 'MyApp->model args passed to ACCEPT_CONTEXT ok'); - - - $c->model('M', qw/foo bar/); - is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok'); - - my $x = $c->view('V', qw/foo2 bar2/); - is_deeply($args, [qw/foo2 bar2/], '$c->view args passed to ACCEPT_CONTEXT ok'); - - # regexp fallback - $c->view('::View::V', qw/foo3 bar3/); - is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok'); - - -} - -{ - my $warn = ''; - no warnings 'redefine'; - local *Catalyst::Log::warn = sub { $warn .= $_[1] }; - - is_deeply (MyApp->controller('MyApp::Controller::C'), - MyApp->components->{'MyApp::Controller::C'}, - 'controller by fully qualified name ok'); - - # You probably meant $c->controller('C') instead of $c->controller({'MyApp::Controller::C'}) - my ($suggested_comp_name, $orig_comp_name) = $warn =~ /You probably meant (.*) instead of (.*) /; - isnt($suggested_comp_name, $orig_comp_name, 'suggested fix in warning for fully qualified component names makes sense' ); -} - -{ - package MyApp::WithoutRegexFallback; - - use base qw/Catalyst/; - - __PACKAGE__->config( { disable_component_resolution_regex_fallback => 1 } ); - - __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } - qw/MyApp::WithoutRegexFallback::Controller::Another::Foo/ } ); - - # allow $c->log->warn to work - __PACKAGE__->setup_log; -} - -{ - # test if non-regex component retrieval still works - is( MyApp::WithoutRegexFallback->controller('Another::Foo'), - 'MyApp::WithoutRegexFallback::Controller::Another::Foo', 'controller Another::Foo found'); -} - -{ - my $warnings = 0; - no warnings 'redefine'; - local *Catalyst::Log::warn = sub { $warnings++ }; - - # try to get nonexisting object w/o regexp fallback - is( MyApp::WithoutRegexFallback->controller('Foo'), undef, 'no controller Foo found'); - ok( !$warnings, 'no regexp fallback warnings' ); -}