From: Florian Ragwitz Date: Tue, 17 Nov 2009 23:00:32 +0000 (+0000) Subject: Merge branch 'exception_interface' X-Git-Tag: 5.80014~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=bb3504780353c63757b5d30ea81e649f32833e7e;hp=80e287baec94d765da86c3f208e8590a2b568060 Merge branch 'exception_interface' exception_interface: Use MooseX::Role::WithOverloading. Add Exception::Interface and Exception::Basic. Make ::Base, ::Go and ::Detach use them. Create branch exception_interface --- diff --git a/Changes b/Changes index bba5e3b..cbedef1 100644 --- a/Changes +++ b/Changes @@ -1,12 +1,82 @@ # This file documents the revision history for Perl extension Catalyst. -# - - - Add allow_mutable_ancestors option when force inlining a constructor onto - applications with plugins defining their own (usually Class::Accessor::Fast) - new methods, to avoid warnings generated by upcoming Moose releases - as we can make a class (MyApp) immutable when not all of it's superclasses - (e.g. plugins not fully Moose converted, but using - MooseX::Emulate::Class::Accessor::Fast) are not immutable. + + Bug fixes: + - Require MooseX::MethodAttributes 0.17. This in turn requires new + MooseX::Types to stop warnings in Moose 0.91, and correctly supports + role combination of roles containing attributed methods. + - 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. + - 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. + - Args ($c->request->args) and CaptureArgs ($c->request->captrues) + passed to $c->uri_for with an action object ($c->action) will now + correctly round-trip when args or captures contain / as it is now + correctly uri encoded to %2F. + + 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. + - Pod fix in Catalyst::Request (RT#51490) + - Pod fixes to refer to ::Controller:: rather than ::C:: as the latter + is deprecated (RT#51490) + + New features: + - Added disable_component_resolution_regex_fallback config option to + 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 + + 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 + + Bug fixes: + - Preserve immutable_options when temporarily making a class mutable in + Catalyst::ClassData as this is needed by new Class::MOP. + This could have potentially caused issues when using the deprecated runtime + plugins feature in an application with plugins which define their own new + method. + - Require new Moose version and new versions of various dependencies + to avoid warnings from newest Moose release. + - Fix go / visit expecting captures and arguments in reverse order. + + Documentation: + - Rework the $c->go documentation to make it more clear. + - Additional documentation in Catalyst::Upgrading covering more deprecation + warnings. + + Refactoring / cleanups: + - Action methods in the application class are deprecated and applications + using them will now generate a warning at startup. + - The -short option has been removed from catalyst.pl, stopping new + applications from being generated using the ::[MVC]:: naming scheme as + this is deprecated and generates warnings. RT#49771 5.80012 2009-09-09 19:09:09 diff --git a/Makefile.PL b/Makefile.PL index fcf057e..fe7a723 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,26 +1,28 @@ 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'; all_from 'lib/Catalyst/Runtime.pm'; requires 'List::MoreUtils'; -requires 'namespace::autoclean'; +requires 'namespace::autoclean' => '0.09'; requires 'namespace::clean'; requires 'B::Hooks::EndOfScope' => '0.08'; -requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00801'; +requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903'; requires 'Class::MOP' => '0.83'; -requires 'Moose' => '0.78'; -requires 'MooseX::MethodAttributes::Inheritable' => '0.15'; +requires 'Moose' => '0.90'; +requires 'MooseX::MethodAttributes::Inheritable' => '0.17'; requires 'MooseX::Role::WithOverloading'; requires 'Carp'; requires 'Class::C3::Adopt::NEXT' => '0.07'; @@ -29,8 +31,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'; @@ -51,6 +53,7 @@ recommends 'B::Hooks::OP::Check::StashChange'; test_requires 'Class::Data::Inheritable'; test_requires 'Test::Exception'; +test_requires 'Test::More' => '0.88'; # aggregate tests if AGGREGATE_TESTS is set and a recent Test::Aggregate and a Test::Simple it works with is available if ($ENV{AGGREGATE_TESTS} && can_use('Test::Simple', '0.88') && can_use('Test::Aggregate', '0.35_05')) { @@ -62,6 +65,8 @@ else { grep { $_ ne 't/aggregate.t' } map { glob } qw[t/*.t t/aggregate/*.t]; } +author_requires 'CatalystX::LeakChecker', '0.03'; # Skipped if this isn't installed +author_requires 'File::Copy::Recursive'; # For http server test author_tests 't/author'; author_requires(map {; $_ => 0 } qw( @@ -108,6 +113,7 @@ EOF # NOTE - This is the version number of the _incompatible_ code, # not the version number of the fixed version. my %conflicts = ( + 'Catalyst::Model::Akismet' => '0.02', 'Catalyst::Component::ACCEPT_CONTEXT' => '0.06', 'Catalyst::Plugin::ENV' => '9999', # This plugin is just stupid, full stop # should have been a core fix. @@ -146,8 +152,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 0f4f0ff..6e74e58 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -79,7 +79,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.80012'; +our $VERSION = '5.80013'; { my $dev_version = $VERSION =~ /_\d{2}$/; @@ -349,6 +349,21 @@ Or make sure to always return true values from your actions and write your code like this: $c->forward('foo') || return; + +Another note is that C<< $c->forward >> always returns a scalar because it +actually returns $c->state which operates in a scalar context. +Thus, something like: + + return @array; + +in an action that is forwarded to is going to return a scalar, +i.e. how many items are in that array, which is probably not what you want. +If you need to return an array then return a reference to it, +or stash it like so: + + $c->stash->{array} = \@array; + +and access it from the stash. =cut @@ -490,7 +505,9 @@ sub error { =head2 $c->state -Contains the return value of the last executed action. +Contains the return value of the last executed action. +Note that << $c->state >> operates in a scalar context which means that all +values it returns are scalar. =head2 $c->clear_errors @@ -535,6 +552,10 @@ sub _comp_names_search_prefixes { # if we were given a regexp to search against, we're done. return if ref $name; + # skip regexp fallback if configured + return + if $appclass->config->{disable_component_resolution_regex_fallback}; + # regexp fallback $query = qr/$name/i; @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible; @@ -552,7 +573,8 @@ sub _comp_names_search_prefixes { (join '", "', @result) . "'. Relying on regexp fallback behavior for " . "component resolution is unreliable and unsafe."; my $short = $result[0]; - $short =~ s/.*?Model:://; + # remove the component namespace prefix + $short =~ s/.*?(Model|Controller|View):://; my $shortmess = Carp::shortmess(''); if ($shortmess =~ m#Catalyst/Plugin#) { $msg .= " You probably need to set '$short' instead of '${name}' in this " . @@ -561,7 +583,7 @@ sub _comp_names_search_prefixes { $msg .= " You probably need to set '$short' instead of '${name}' in this " . "component's config"; } else { - $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}({'${name}'}), " . + $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " . "but if you really wanted to search, pass in a regexp as the argument " . "like so: \$c->${warn_for}(qr/${name}/)"; } @@ -778,6 +800,12 @@ should be used instead. If C<$name> is a regexp, a list of components matched against the full 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 ); + =cut sub component { @@ -1117,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 { @@ -1142,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. } @@ -1170,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? ) @@ -1178,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 @@ -1219,9 +1259,10 @@ sub uri_for { } if ( blessed($path) ) { # action object - my $captures = ( scalar @args && ref $args[0] eq 'ARRAY' - ? shift(@args) - : [] ); + my $captures = [ map { s|/|%2F|; $_; } + ( scalar @args && ref $args[0] eq 'ARRAY' + ? @{ shift(@args) } + : ()) ]; my $action = $path; $path = $c->dispatcher->uri_for_action($action, $captures); if (not defined $path) { @@ -1239,6 +1280,7 @@ sub uri_for { carp "uri_for called with undef argument" if grep { ! defined $_ } @args; s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args; + s|/|%2F| for @args; unshift(@args, $path); @@ -1601,9 +1643,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"}, @@ -2635,6 +2678,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>, @@ -2643,16 +2753,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, @@ -2762,6 +2862,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/ClassData.pm b/lib/Catalyst/ClassData.pm index cd0ad90..89cc1fd 100644 --- a/lib/Catalyst/ClassData.pm +++ b/lib/Catalyst/ClassData.pm @@ -49,8 +49,7 @@ sub mk_classdata { unless $meta->isa('Class::MOP::Class'); my $was_immutable = $meta->is_immutable; - # Need to save immutable_options if they're available from Moose 0.89_02 - my %immutable_options = $meta->can('immutable_options') ? $meta->immutable_options : (); + my %immutable_options = $meta->immutable_options; $meta->make_mutable if $was_immutable; diff --git a/lib/Catalyst/Component/ContextClosure.pm b/lib/Catalyst/Component/ContextClosure.pm index 23e1381..18d09b7 100644 --- a/lib/Catalyst/Component/ContextClosure.pm +++ b/lib/Catalyst/Component/ContextClosure.pm @@ -22,7 +22,7 @@ Catalyst::Component::ContextClosure - Moose Role for components which need to cl package MyApp::Controller::Foo; use Moose; - use namespace::autoclean; + use namespace::clean -except => 'meta'; BEGIN { extends 'Catalyst::Controller'; with 'Catalyst::Component::ContextClosure'; @@ -33,7 +33,7 @@ Catalyst::Component::ContextClosure - Moose Role for components which need to cl $ctx->stash(a_closure => $self->make_context_closure(sub { my ($ctx) = @_; $ctx->response->body('body set from closure'); - }, $ctx); + }, $ctx)); } =head1 DESCRIPTION diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm index 3d6573b..d82dfe1 100644 --- a/lib/Catalyst/Dispatcher.pm +++ b/lib/Catalyst/Dispatcher.pm @@ -29,7 +29,7 @@ our @POSTLOAD = qw/Default/; # Note - see back-compat methods at end of file. has _tree => (is => 'rw', builder => '_build__tree'); -has _dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1); +has dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1); has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1); has _method_action_class => (is => 'rw', default => 'Catalyst::Action'); has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} }); @@ -131,7 +131,7 @@ sub _command2action { my (@args, @captures); if ( ref( $extra_params[-2] ) eq 'ARRAY' ) { - @captures = @{ pop @extra_params }; + @captures = @{ splice @extra_params, -2, 1 }; } if ( ref( $extra_params[-1] ) eq 'ARRAY' ) { @@ -372,7 +372,7 @@ sub prepare_action { # Check out dispatch types to see if any will handle the path at # this level - foreach my $type ( @{ $self->_dispatch_types } ) { + foreach my $type ( @{ $self->dispatch_types } ) { last DESCEND if $type->match( $c, $path ); } @@ -470,7 +470,7 @@ cannot determine an appropriate URI, this method will return undef. sub uri_for_action { my ( $self, $action, $captures) = @_; $captures ||= []; - foreach my $dispatch_type ( @{ $self->_dispatch_types } ) { + foreach my $dispatch_type ( @{ $self->dispatch_types } ) { my $uri = $dispatch_type->uri_for_action( $action, $captures ); return( $uri eq '' ? '/' : $uri ) if defined($uri); @@ -489,7 +489,7 @@ single action. sub expand_action { my ($self, $action) = @_; - foreach my $dispatch_type (@{ $self->_dispatch_types }) { + foreach my $dispatch_type (@{ $self->dispatch_types }) { my $expanded = $dispatch_type->expand_action($action); return $expanded if $expanded; } @@ -518,12 +518,12 @@ sub register { # 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 $@; + push( @{ $self->dispatch_types }, $class->new ) unless $@; $registered->{$class} = 1; } } - my @dtypes = @{ $self->_dispatch_types }; + my @dtypes = @{ $self->dispatch_types }; my @normal_dtypes; my @low_precedence_dtypes; @@ -647,7 +647,7 @@ sub _display_action_tables { if $has_private; # List all public actions - $_->list($c) for @{ $self->_dispatch_types }; + $_->list($c) for @{ $self->dispatch_types }; } sub _load_dispatch_types { @@ -662,7 +662,7 @@ sub _load_dispatch_types { eval { Class::MOP::load_class($class) }; Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ ) if $@; - push @{ $self->_dispatch_types }, $class->new; + push @{ $self->dispatch_types }, $class->new; push @loaded, $class; } @@ -684,7 +684,7 @@ sub dispatch_type { # first param is undef because we cannot get the appclass $name = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $name); - for (@{ $self->_dispatch_types }) { + for (@{ $self->dispatch_types }) { return $_ if ref($_) eq $name; } return undef; @@ -722,7 +722,6 @@ use Moose; # Alias _method_name to method_name, add a before modifier to warn.. foreach my $public_method_name (qw/ tree - dispatch_types registered_dispatch_types method_action_class action_hash 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..4b7de6d 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; } @@ -210,7 +210,7 @@ Returns a reference to an array containing the arguments. For example, if your action was - package MyApp::C::Foo; + package MyApp::Controller::Foo; sub moose : Local { ... @@ -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/Response.pm b/lib/Catalyst/Response.pm index cb73a34..bbfa316 100644 --- a/lib/Catalyst/Response.pm +++ b/lib/Catalyst/Response.pm @@ -65,7 +65,7 @@ will turn the Catalyst::Response into a HTTP Response and return it to the clien =head1 METHODS -=head2 $res->body(<$text|$fh|$iohandle_object) +=head2 $res->body( $text | $fh | $iohandle_object ) $c->response->body('Catalyst rocks!'); diff --git a/lib/Catalyst/Runtime.pm b/lib/Catalyst/Runtime.pm index 2cf1bd3..0304b89 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.80012'; +our $VERSION='5.80013'; $VERSION = eval $VERSION; 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 0410bcf..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 @@ -304,6 +305,43 @@ COMPONENT method in your @ISA. =head1 WARNINGS +=head2 Actions in your application class + +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). + +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 + +Having packages called MyApp::[MVC]::XX is deprecated and can no longer be generated +by catalyst.pl + +This is still supported, but it is recommended that you rename your application +components to Model/View/Controller. + +A warning will be issued at application startup if the ::[MVC]:: naming scheme is +in use. + =head2 Catalyst::Base Any code using L will now emit a warning; this @@ -363,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..53bf795 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -124,7 +124,7 @@ sub class2prefix { Returns a tempdir for a class. If create is true it will try to create the path. My::App becomes /tmp/my/app - My::App::C::Foo::Bar becomes /tmp/my/app/c/foo/bar + My::App::Controller::Foo::Bar becomes /tmp/my/app/c/foo/bar =cut @@ -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/script/catalyst.pl b/script/catalyst.pl index 287c12e..e9083cc 100755 --- a/script/catalyst.pl +++ b/script/catalyst.pl @@ -26,14 +26,12 @@ my $force = 0; my $help = 0; my $makefile = 0; my $scripts = 0; -my $short = 0; GetOptions( 'help|?' => \$help, 'force|nonew' => \$force, 'makefile' => \$makefile, 'scripts' => \$scripts, - 'short' => \$short ); pod2usage(1) if ( $help || !$ARGV[0] ); @@ -43,7 +41,7 @@ my $helper = Catalyst::Helper->new( '.newfiles' => !$force, 'makefile' => $makefile, 'scripts' => $scripts, - 'short' => $short, + 'short' => 0, # FIXME - to be removed. } ); pod2usage(1) unless $helper->mk_app( $ARGV[0] ); @@ -67,7 +65,6 @@ upgrade the skeleton of your old application. -help display this help and exit -makefile only update Makefile.PL -scripts only update helper scripts - -short use short names, M/V/C instead of Model/View/Controller. application-name must be a valid Perl module name and can include "::", which will be converted to '-' in the project name. 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/aggregate/live_component_controller_action_chained.t b/t/aggregate/live_component_controller_action_chained.t index 3784fe6..53dca92 100644 --- a/t/aggregate/live_component_controller_action_chained.t +++ b/t/aggregate/live_component_controller_action_chained.t @@ -10,7 +10,7 @@ our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } -use Test::More tests => 148*$iters; +use Test::More; use Catalyst::Test 'TestApp'; if ( $ENV{CAT_BENCHMARK} ) { @@ -1018,5 +1018,31 @@ sub run_tests { 'request with URI-encoded arg' ); like( $content, qr{foo/bar;\z}, 'args decoded' ); } + + # Test round tripping, specifically the / character %2F in uri_for: + # not being able to feed it back action + captureargs and args into uri for + # and result in the original request uri is a major piece of suck ;) + foreach my $thing ( + ['foo', 'bar'], + ['foo%2Fbar', 'baz'], + ['foo', 'bar%2Fbaz'], + ['foo%2Fbar', 'baz%2Fquux'], + ['foo%2Fbar', 'baz%2Fquux', { foo => 'bar', 'baz' => 'quux%2Ffrood'}], + ['foo%2Fbar', 'baz%2Fquux', { foo => 'bar', 'baz%2Ffnoo' => 'quux%2Ffrood'}], + ) { + my $path = '/chained/roundtrip_urifor/' . + $thing->[0] . '/' . $thing->[1]; + $path .= '?' . join('&', + map { $_ .'='. $thing->[2]->{$_}} + sort keys %{$thing->[2]}) if $thing->[2]; + ok( my $content = + get('http://localhost/' . $path), + 'request ' . $path . ' ok'); + # Just check that the path matches, as who the hell knows or cares + # where the app is based (live tests etc) + ok( index($content, $path) > 1, 'uri can round trip through uri_for' ); + } } +done_testing; + diff --git a/t/aggregate/live_component_controller_action_go.t b/t/aggregate/live_component_controller_action_go.t index 41b09b6..8554f72 100644 --- a/t/aggregate/live_component_controller_action_go.t +++ b/t/aggregate/live_component_controller_action_go.t @@ -262,7 +262,7 @@ sub run_tests { ok( my $response = request('http://localhost/action/go/go_chained'), 'go to chained + subcontroller endpoint' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); - is( $response->content, 'arg1, arg2; captureme', 'Content OK' ); + is( $response->content, 'captureme; arg1, arg2', 'Content OK' ); } } diff --git a/t/aggregate/live_component_controller_action_visit.t b/t/aggregate/live_component_controller_action_visit.t index 4bd246d..b331e7c 100644 --- a/t/aggregate/live_component_controller_action_visit.t +++ b/t/aggregate/live_component_controller_action_visit.t @@ -276,7 +276,7 @@ sub run_tests { "visit to chained + subcontroller endpoint for $i" ); is( $response->header('X-Catalyst-Executed'), $expected, "Executed actions for $i" ); - is( $response->content, "arg1, arg2; becomescapture", + is( $response->content, "becomescapture; arg1, arg2", "Content OK for $i" ); } } 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/Chained.pm b/t/lib/TestApp/Controller/Action/Chained.pm index 64de556..cbba762 100644 --- a/t/lib/TestApp/Controller/Action/Chained.pm +++ b/t/lib/TestApp/Controller/Action/Chained.pm @@ -204,6 +204,13 @@ sub return_arg_decoded : Chained('/') PathPart('chained/return_arg_decoded') Arg $c->req->args([ map { decode_entities($_) } @{ $c->req->args }]); } +sub roundtrip_urifor : Chained('/') PathPart('chained/roundtrip_urifor') CaptureArgs(1) {} +sub roundtrip_urifor_end : Chained('roundtrip_urifor') PathPart('') Args(1) { + my ($self, $c) = @_; + # This should round-trip, always - i.e. the uri you put in should come back out. + $c->res->body($c->uri_for($c->action, $c->req->captures, @{$c->req->args}, $c->req->parameters)); + $c->stash->{no_end} = 1; +} sub end :Private { my ($self, $c) = @_; 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 8cb1fcb..0000000 --- a/t/unit_core_mvc.t +++ /dev/null @@ -1,183 +0,0 @@ -use Test::More tests => 46; -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'); - - -}