From: André Walker Date: Mon, 1 Aug 2011 23:33:50 +0000 (-0300) Subject: Merge branch 'suppress_data_dumper_warnings' into gsoc_breadboard X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=98dd7c5ff798448c229e48415dbfcabdd242b9c7;hp=143cf217a4cb0172c6766c8e6ea1b3afaf43c285;p=catagits%2FCatalyst-Runtime.git Merge branch 'suppress_data_dumper_warnings' into gsoc_breadboard --- diff --git a/.gitignore b/.gitignore index a853ad2..19a3918 100644 --- a/.gitignore +++ b/.gitignore @@ -15,3 +15,4 @@ Debian* Catalyst-Runtime-* *.bs t/tmp +cover_db/ diff --git a/Makefile.PL b/Makefile.PL index 7d57917..c00267d 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -13,6 +13,7 @@ perl_version '5.008004'; name 'Catalyst-Runtime'; all_from 'lib/Catalyst/Runtime.pm'; +requires 'Bread::Board'; requires 'List::MoreUtils'; requires 'namespace::autoclean' => '0.09'; requires 'namespace::clean' => '0.13'; @@ -50,6 +51,7 @@ requires 'MRO::Compat'; requires 'MooseX::Getopt' => '0.30'; requires 'MooseX::Types'; requires 'MooseX::Types::Common::Numeric'; +requires 'MooseX::Types::LoadableClass'; requires 'String::RewritePrefix' => '0.004'; # Catalyst::Utils::resolve_namespace test_requires 'Class::Data::Inheritable'; diff --git a/TODO b/TODO index 8fd77ad..4937c44 100644 --- a/TODO +++ b/TODO @@ -54,3 +54,127 @@ http://github.com/willert/catalyst-plugin-log4perl-simple/tree - Profit! (Things like changing the complete app config per vhost, i.e. writing a config loader / app class role which dispatches per vhost to differently configured apps is piss easy) + +## GSOC + +### Next large steps, planned: + +For all components that have been discovered, in whatever way, we create a service: + - that's a catalyst component service + - which is basically just a constructor injection + - except the constructor name is COMPONENT + - and we're "implicitly" passing along some constructor args + - Lifecycle => Singleton + + - Fix B::B so that Service::WithParametrs' parameters attribute has a builder + - Fix ConstructorInjection so that default parameters are supplied (for accept_context_args) + - Fix ConstructorInjection's 'suffix' - should be called 'config_key' or something, and + should be an attribute on the service (as it never changes), rather than a parameter + to the service + + - We make a 'components' sub container in the main container. + - This gets the ConstructorInjection COMPONENT services, as model_Foo. + - Lifecycle of these services is Singleton + - This simplifies the code for MyApp->components, as it need only list one sub-container + + - We create a second service (depending on the first one) for ACCEPT_CONTEXT + - This has a custom service which calls ACCEPT_CONTEXT when the instance is fetched + - Not Singleton lifecycle + + Note - ACCEPT_CONTEXT can be called on app values - if you have a Model::Foo, with an ACCEPT_CONTEXT + and you call MyApp->model('Foo') then ACCEPT_CONTEXT gets invoked with a $c of 'MyApp' (this is not\ + the normal case, but we need to preserve for compat) + +### Next steps - less planned: + + - Creating service()-like sugar for component + + - Test cases for extending the container in an application. + - Using the sugar added in the previous item + - Test when Model::Foo depends_on Model::Bar + + +#### Extending my app, notes + +Basically try to implement something like this (starting out without the sugar!), and see how it breaks +and what needs to be done to fix it! + +##### Eventual syntax + +package MyApp::Container; +use Catalyst::IOC; + + container $self, as { + container model => as { + component Foo => (); # As per default! + component Bar => (dependencies => ['/model/Foo']); # Magic! + component Baz => ( lifecycle => 'InstancePerContext ); + component Quux => ( lifecycle => 'Singleton' ); # ACCEPT_CONTEXT not called + }; + # Note - implementation of BB may need to be changed to support making sure existing + # services actually get overridden. not sure how the default container behaves when doing that + # above code would build the constructor injection as it currently does, + # defaulting to the class name in the right namespace as declared by the surrounding container + # as well as adding using the catalyst-specific service class + }; + +1; + +##### To start with + +package MyApp::Container; +use Moose; + +extends 'Catalyst::Container; + +after BUILD => sub { + my $self = shift; + my $model_container = $self->get_sub_container('model'); + my $service = Catalyst::IOC::ConstructorInjection->new( + name => 'Baz', + class => 'MyApp::Model::Baz', + dependencies => [ + depends_on( '/application_name' ), + depends_on( '/config' ), + depends_on( '/model/Foo' ), + ], + lifecycle => 'InstancePerContext', + ); + $model_container->add_service( 'Foo', $service ); +}; + +### To polish off / t0m review + + - + $class->container->get_sub_container('model')->make_single_default; + + $class->container->get_sub_container('view')->make_single_default; + + get_components_names_types + + locate_components + + +# FIXME - t0m, how do you feel about this name? + +# also, do you think I should draw it here, or just return the data structure? + +sub get_components_names_types { + + + MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = { + + +# FIXME - just till I understand how it's supposed to be done + +# Made this so that COMPONENT is executed once, + +# and ACCEPT_CONTEXT every call. + +has instance => ( + + is => 'rw', + + # This is ok?? + +my $applevel_config = TestAppContainer->container->resolve(service => 'config')->{applevel_config}; + +__PACKAGE__->config(applevel_config => 'foo'); + + + accept_context_args - where does this come from? + +### Known issues + + - Broken $instance->expand_modules() in setup_components and figure + out later how to bring it back + + - expand_component_module + diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index fd57ca6..6cdeb7f 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -15,9 +15,7 @@ use Catalyst::Response; use Catalyst::Utils; use Catalyst::Controller; use Data::OptList; -use Devel::InnerPackage (); use File::stat; -use Module::Pluggable::Object (); use Text::SimpleTable (); use Path::Class::Dir (); use Path::Class::File (); @@ -67,7 +65,7 @@ our $GO = Catalyst::Exception::Go->new; #I imagine that very few of these really need to be class variables. if any. #maybe we should just make them attributes with a default? __PACKAGE__->mk_classdata($_) - for qw/components arguments dispatcher engine log dispatcher_class + for qw/container arguments dispatcher engine log dispatcher_class engine_class context_class request_class response_class stats_class setup_finished/; @@ -92,10 +90,12 @@ sub import { return if $caller eq 'main'; my $meta = Moose::Meta::Class->initialize($caller); - unless ( $caller->isa('Catalyst') ) { - my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller'); - $meta->superclasses(@superclasses); - } + + unless ( $caller->isa('Catalyst') ) { # XXX - Remove! + my @superclasses = ($meta->superclasses, $class, 'Catalyst::Component'); # XXX - Remove! + $meta->superclasses(@superclasses); # XXX - Remove! + } # XXX - Remove! + # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses); @@ -112,6 +112,15 @@ sub import { $caller->setup_home; } +sub MODIFY_CODE_ATTRIBUTES { + Catalyst::Exception->throw( + "Catalyst applications (aka MyApp) cannot be controllers anymore. " . + "That has been deprecated and removed. You should create a " . + "controller class called Root.pm, and move relevant code to that class." + ); +} + + sub _application { $_[0] } =head1 NAME @@ -536,98 +545,6 @@ sub clear_errors { $c->error(0); } -sub _comp_search_prefixes { - my $c = shift; - return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_); -} - -# search components given a name and some prefixes -sub _comp_names_search_prefixes { - my ( $c, $name, @prefixes ) = @_; - my $appclass = ref $c || $c; - my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; - $filter = qr/$filter/; # Compile regex now rather than once per loop - - # map the original component name to the sub part that we will search against - my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; } - grep { /$filter/ } keys %{ $c->components }; - - # undef for a name will return all - return keys %eligible if !defined $name; - - my $query = ref $name ? $name : qr/^$name$/i; - my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible; - - return @result if @result; - - # 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; - - # no results? try against full names - if( !@result ) { - @result = grep { m{$query} } keys %eligible; - } - - # don't warn if we didn't find any results, it just might not exist - if( @result ) { - # Disgusting hack to work out correct method name - my $warn_for = lc $prefixes[0]; - my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" . - (join '", "', @result) . "'. Relying on regexp fallback behavior for " . - "component resolution is unreliable and unsafe."; - my $short = $result[0]; - # 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 " . - "plugin's config"; - } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) { - $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}'), " . - "but if you really wanted to search, pass in a regexp as the argument " . - "like so: \$c->${warn_for}(qr/${name}/)"; - } - $c->log->warn( "${msg}$shortmess" ); - } - - return @result; -} - -# Find possible names for a prefix -sub _comp_names { - my ( $c, @prefixes ) = @_; - my $appclass = ref $c || $c; - - my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; - - my @names = map { s{$filter}{}; $_; } - $c->_comp_names_search_prefixes( undef, @prefixes ); - - return @names; -} - -# Filter a component before returning by calling ACCEPT_CONTEXT if available -sub _filter_component { - my ( $c, $comp, @args ) = @_; - - if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) { - return $comp->ACCEPT_CONTEXT( $c, @args ); - } - - return $comp; -} - =head2 COMPONENT ACCESSORS =head2 $c->controller($name) @@ -650,19 +567,9 @@ If you want to search for controllers, pass in a regexp as the argument. sub controller { my ( $c, $name, @args ) = @_; - my $appclass = ref($c) || $c; - if( $name ) { - unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps - my $comps = $c->components; - my $check = $appclass."::Controller::".$name; - return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; - } - my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ ); - return map { $c->_filter_component( $_, @args ) } @result if ref $name; - return $c->_filter_component( $result[ 0 ], @args ); - } + $name ||= Catalyst::Utils::class2classshortsuffix( $c->action->class ); - return $c->component( $c->action->class ); + return $c->container->get_component_from_sub_container( 'controller', $name, $c, @args); } =head2 $c->model($name) @@ -688,38 +595,16 @@ If you want to search for models, pass in a regexp as the argument. sub model { my ( $c, $name, @args ) = @_; - my $appclass = ref($c) || $c; - if( $name ) { - unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps - my $comps = $c->components; - my $check = $appclass."::Model::".$name; - return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; - } - my @result = $c->_comp_search_prefixes( $name, qw/Model M/ ); - return map { $c->_filter_component( $_, @args ) } @result if ref $name; - return $c->_filter_component( $result[ 0 ], @args ); - } - - if (ref $c) { - return $c->stash->{current_model_instance} - if $c->stash->{current_model_instance}; - return $c->model( $c->stash->{current_model} ) - if $c->stash->{current_model}; - } - return $c->model( $appclass->config->{default_model} ) - if $appclass->config->{default_model}; - my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/); + if (ref $c && !$name) { + my $current_instance = $c->stash->{current_model_instance}; + return $current_instance + if $current_instance; - if( $rest ) { - $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') ); - $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' ); - $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' ); - $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' ); - $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' ); + $name = $c->stash->{current_model}; } - return $c->_filter_component( $comp ); + return $c->container->get_component_from_sub_container( 'model', $name, $c, @args); } @@ -747,43 +632,15 @@ If you want to search for views, pass in a regexp as the argument. sub view { my ( $c, $name, @args ) = @_; - my $appclass = ref($c) || $c; - if( $name ) { - unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps - my $comps = $c->components; - my $check = $appclass."::View::".$name; - if( exists $comps->{$check} ) { - return $c->_filter_component( $comps->{$check}, @args ); - } - else { - $c->log->warn( "Attempted to use view '$check', but does not exist" ); - } - } - my @result = $c->_comp_search_prefixes( $name, qw/View V/ ); - return map { $c->_filter_component( $_, @args ) } @result if ref $name; - return $c->_filter_component( $result[ 0 ], @args ); - } - - if (ref $c) { - return $c->stash->{current_view_instance} - if $c->stash->{current_view_instance}; - return $c->view( $c->stash->{current_view} ) - if $c->stash->{current_view}; - } - return $c->view( $appclass->config->{default_view} ) - if $appclass->config->{default_view}; - - my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/); + if (ref $c && !$name) { + my $current_instance = $c->stash->{current_view_instance}; + return $current_instance + if $current_instance; - if( $rest ) { - $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' ); - $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' ); - $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' ); - $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' ); - $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' ); + $name = $c->stash->{current_view}; } - return $c->_filter_component( $comp ); + return $c->container->get_component_from_sub_container( 'view', $name, $c, @args); } =head2 $c->controllers @@ -794,7 +651,7 @@ Returns the available names which can be passed to $c->controller sub controllers { my ( $c ) = @_; - return $c->_comp_names(qw/Controller C/); + return $c->container->get_sub_container('controller')->get_service_list; } =head2 $c->models @@ -805,7 +662,7 @@ Returns the available names which can be passed to $c->model sub models { my ( $c ) = @_; - return $c->_comp_names(qw/Model M/); + return $c->container->get_sub_container('model')->get_service_list; } @@ -817,7 +674,7 @@ Returns the available names which can be passed to $c->view sub views { my ( $c ) = @_; - return $c->_comp_names(qw/View V/); + return $c->container->get_sub_container('view')->get_service_list; } =head2 $c->comp($name) @@ -832,57 +689,50 @@ 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 { - my ( $c, $name, @args ) = @_; + my ( $c, $component, @args ) = @_; - if( $name ) { - my $comps = $c->components; + unless ($component) { + $c->log->warn('Calling $c->component with no args is deprecated and '); + $c->log->warn('will be removed in a future release.'); + $c->log->warn('Use $c->component_list instead.'); + return $c->component_list; + } - if( !ref $name ) { - # is it the exact name? - return $c->_filter_component( $comps->{ $name }, @args ) - if exists $comps->{ $name }; + my @result = $c->container->find_component( $component, $c, @args ); - # perhaps we just omitted "MyApp"? - my $composed = ( ref $c || $c ) . "::${name}"; - return $c->_filter_component( $comps->{ $composed }, @args ) - if exists $comps->{ $composed }; + # list context for regexp searches + return @result if ref $component; - # search all of the models, views and controllers - my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ ); - return $c->_filter_component( $comp, @args ) if $comp; - } + # only one component (if it's found) for string searches + return shift @result if @result; - return - if $c->config->{disable_component_resolution_regex_fallback}; + if (ref $c eq $component) { + $c->log->warn('You are calling $c->comp("MyApp"). This behaviour is'); + $c->log->warn('deprecated, and will be removed in a future release.'); + return $c; + } - # This is here so $c->comp( '::M::' ) works - my $query = ref $name ? $name : qr{$name}i; + $c->log->warn("Looking for '$component', but nothing was found."); - my @result = grep { m{$query} } keys %{ $c->components }; - return map { $c->_filter_component( $_, @args ) } @result if ref $name; + # I would expect to return an empty list here, but that breaks back-compat + $c->log->warn('Component not found, returning the list of existing'); + $c->log->warn('components. This behavior is deprecated and will be'); + $c->log->warn('removed in a future release. Use $c->component_list'); + $c->log->warn('instead.'); - if( $result[ 0 ] ) { - $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) ); - $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' ); - $c->log->warn( 'is unreliable and unsafe. You have been warned' ); - return $c->_filter_component( $result[ 0 ], @args ); - } + return $c->component_list; +} - # I would expect to return an empty list here, but that breaks back-compat - } +=head2 $c->component_list - # fallback - return sort keys %{ $c->components }; -} +Returns the sorted list of the component names of the application. + +=cut + +sub component_list { sort keys %{ shift->components } } =head2 CLASS DATA AND HELPER CLASSES @@ -1048,7 +898,7 @@ Please do not use this functionality in new code. sub plugin { my ( $class, $name, $plugin, @args ) = @_; - # See block comment in t/unit_core_plugin.t + # See block comment in t/aggregate/unit_core_plugin.t $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/); $class->_register_plugin( $plugin, 1 ); @@ -1112,6 +962,7 @@ sub setup { } } + $class->setup_config(); $class->setup_home( delete $flags->{home} ); $class->setup_log( delete $flags->{log} ); @@ -1176,25 +1027,17 @@ EOF $class->setup unless $Catalyst::__AM_RESTARTING; } - # Initialize our data structure - $class->components( {} ); - $class->setup_components; - if ( $class->debug ) { + if ( + $class->debug and + my @comps_names_types = $class->container->get_components_names_types + ) { my $column_width = Catalyst::Utils::term_width() - 8 - 9; my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] ); - for my $comp ( sort keys %{ $class->components } ) { - my $type = ref $class->components->{$comp} ? 'instance' : 'class'; - $t->row( $comp, $type ); - } - $class->log->debug( "Loaded components:\n" . $t->draw . "\n" ) - if ( keys %{ $class->components } ); - } + $t->row( @$_ ) for @comps_names_types; - # Add our self to components, since we are also a component - if( $class->isa('Catalyst::Controller') ){ - $class->components->{$class} = $class; + $class->log->debug( "Loaded components:\n" . $t->draw . "\n" ); } $class->setup_actions; @@ -1592,6 +1435,23 @@ These methods are not meant to be used by end users. Returns a hash of components. +=cut + +sub components { + my ( $class, $comps ) = @_; + + # people create components calling this sub directly, before setup + $class->setup_config unless $class->container; + + my $container = $class->container; + + if ( $comps ) { + $container->add_component( $_ ) for keys %$comps; + } + + return $container->get_all_components(); +} + =head2 $c->context_class Returns or sets the context class. @@ -2414,139 +2274,71 @@ Sets up actions for a component. sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) } -=head2 $c->setup_components - -This method is called internally to set up the application's components. - -It finds modules by calling the L method, expands them to -package names with the L method, and then installs -each component into the application. - -The C config option is passed to both of the above methods. - -Installation of each component is performed by the L method, -below. +=head2 $c->setup_config =cut -sub setup_components { +sub setup_config { my $class = shift; - my $config = $class->config->{ setup_components }; - - my @comps = $class->locate_components($config); - my %comps = map { $_ => 1 } @comps; + my %args = %{ $class->config || {} }; - my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps; - $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}. - qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n} - ) if $deprecatedcatalyst_component_names; + my @container_classes = ( "${class}::Container", 'Catalyst::IOC::Container'); + unshift @container_classes, delete $args{container_class} if exists $args{container_class}; - for my $component ( @comps ) { + my $container_class = Class::MOP::load_first_existing_class(@container_classes); - # We pass ignore_loaded here so that overlay files for (e.g.) - # Model::DBI::Schema sub-classes are loaded - if it's in @comps - # we know M::P::O found a file on disk so this is safe + my $container = $container_class->new( %args, application_name => "$class", name => "$class" ); + $class->container($container); - Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } ); - } - - for my $component (@comps) { - my $instance = $class->components->{ $component } = $class->setup_component($component); - my @expanded_components = $instance->can('expand_modules') - ? $instance->expand_modules( $component, $config ) - : $class->expand_component_module( $component, $config ); - for my $component (@expanded_components) { - next if $comps{$component}; - $class->components->{ $component } = $class->setup_component($component); - } - } + my $config = $container->resolve( service => 'config' ); + $class->config($config); + $class->finalize_config; # back-compat } -=head2 $c->locate_components( $setup_component_config ) - -This method is meant to provide a list of component modules that should be -setup for the application. By default, it will use L. - -Specify a C config option to pass additional options directly -to L. To add additional search paths, specify a key named -C as an array reference. Items in the array beginning with C<::> -will have the application class name prepended to them. +=head2 $c->finalize_config =cut -sub locate_components { - my $class = shift; - my $config = shift; - - my @paths = qw( ::Controller ::C ::Model ::M ::View ::V ); - my $extra = delete $config->{ search_extra } || []; - - push @paths, @$extra; - - my $locator = Module::Pluggable::Object->new( - search_path => [ map { s/^(?=::)/$class/; $_; } @paths ], - %$config - ); +sub finalize_config { } - # XXX think about ditching this sort entirely - my @comps = sort { length $a <=> length $b } $locator->plugins; +=head2 $c->setup_components - return @comps; -} +This method is called internally to set up the application's components. -=head2 $c->expand_component_module( $component, $setup_component_config ) +It finds modules by calling the L method, expands them to +package names with the $container->expand_component_module method, and then +installs each component into the application. -Components found by C will be passed to this method, which -is expected to return a list of component (package) names to be set up. +The C config option is passed to both of the above methods. =cut -sub expand_component_module { - my ($class, $module) = @_; - return Devel::InnerPackage::list_packages( $module ); +sub setup_components { + shift->container->setup_components(); } -=head2 $c->setup_component +=head2 locate_components =cut -sub setup_component { - my( $class, $component ) = @_; +# FIXME - removed locate_components +# don't people mess with this method directly? +# what to do with that? - unless ( $component->can( 'COMPONENT' ) ) { - return $component; - } - - my $suffix = Catalyst::Utils::class2classsuffix( $component ); - my $config = $class->config->{ $suffix } || {}; - # Stash catalyst_component_name in the config here, so that custom COMPONENT - # methods also pass it. local to avoid pointlessly shitting in config - # for the debug screen, as $component is already the key name. - local $config->{catalyst_component_name} = $component; +sub locate_components { + my $class = shift; - my $instance = eval { $component->COMPONENT( $class, $config ); }; + $class->log->warn('The locate_components method has been deprecated.'); + $class->log->warn('Please read Catalyst::IOC::Container documentation to'); + $class->log->warn('update your application.'); - if ( my $error = $@ ) { - chomp $error; - Catalyst::Exception->throw( - message => qq/Couldn't instantiate component "$component", "$error"/ - ); - } - - unless (blessed $instance) { - my $metaclass = Moose::Util::find_meta($component); - my $method_meta = $metaclass->find_method_by_name('COMPONENT'); - my $component_method_from = $method_meta->associated_metaclass->name; - my $value = defined($instance) ? $instance : 'undef'; - Catalyst::Exception->throw( - message => - qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./ - ); - } - return $instance; + # XXX think about ditching this sort entirely + return sort { length $a <=> length $b } + @{ $class->container->resolve( service => 'locate_components' ) }; } + =head2 $c->setup_dispatcher Sets up dispatcher. @@ -2926,14 +2718,6 @@ C - The default view to be rendered or returned when C<< $c->view =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 >>. @@ -2961,12 +2745,6 @@ 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. @@ -3107,6 +2885,8 @@ Andrew Ford EA.Ford@ford-mason.co.ukE Andrew Ruthven +André Walker + andyg: Andy Grundman audreyt: Audrey Tang diff --git a/lib/Catalyst/IOC/BlockInjection.pm b/lib/Catalyst/IOC/BlockInjection.pm new file mode 100644 index 0000000..4453e84 --- /dev/null +++ b/lib/Catalyst/IOC/BlockInjection.pm @@ -0,0 +1,34 @@ +package Catalyst::IOC::BlockInjection; +use Moose; +extends 'Bread::Board::BlockInjection'; + +with 'Bread::Board::Service::WithDependencies', + 'Catalyst::IOC::Service::WithParameters', + 'Catalyst::IOC::Service::WithAcceptContext'; + +__PACKAGE__->meta->make_immutable; + +no Moose; 1; + +__END__ + +=pod + +=head1 NAME + +Catalyst::IOC::BlockInjection + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/lib/Catalyst/IOC/ConstructorInjection.pm b/lib/Catalyst/IOC/ConstructorInjection.pm new file mode 100644 index 0000000..a37e5bd --- /dev/null +++ b/lib/Catalyst/IOC/ConstructorInjection.pm @@ -0,0 +1,64 @@ +package Catalyst::IOC::ConstructorInjection; +use Moose; +use Catalyst::Utils (); +extends 'Bread::Board::ConstructorInjection'; + +with 'Bread::Board::Service::WithClass', + 'Bread::Board::Service::WithDependencies', + 'Bread::Board::Service::WithParameters', + 'Catalyst::IOC::Service::WithCOMPONENT'; + +has config_key => ( + is => 'ro', + isa => 'Str', + lazy_build => 1, +); + +sub _build_config_key { + Catalyst::Utils::class2classsuffix( shift->class ); +} + +# FIXME - how much of this should move to ::WithCOMPONENT? +sub get { + my $self = shift; + + my $constructor = $self->constructor_name; + my $component = $self->class; + my $params = $self->params; + my $config = $params->{config}->{ $self->config_key } || {}; + my $app_name = $params->{application_name}; + + # Stash catalyst_component_name in the config here, so that custom COMPONENT + # methods also pass it. local to avoid pointlessly shitting in config + # for the debug screen, as $component is already the key name. + local $config->{catalyst_component_name} = $component; + + return $component->$constructor( $app_name, $config ); +} + +__PACKAGE__->meta->make_immutable; + +no Moose; 1; + +__END__ + +=pod + +=head1 NAME + +Catalyst::IOC::ConstructorInjection + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/lib/Catalyst/IOC/Container.pm b/lib/Catalyst/IOC/Container.pm new file mode 100644 index 0000000..051f758 --- /dev/null +++ b/lib/Catalyst/IOC/Container.pm @@ -0,0 +1,907 @@ +package Catalyst::IOC::Container; +use Bread::Board; +use Moose; +use Config::Any; +use Data::Visitor::Callback; +use Catalyst::Utils (); +use Devel::InnerPackage (); +use Hash::Util qw/lock_hash/; +use MooseX::Types::LoadableClass qw/ LoadableClass /; +use Moose::Util; +use Catalyst::IOC::BlockInjection; +use Catalyst::IOC::ConstructorInjection; +use Module::Pluggable::Object (); +use namespace::autoclean; + +extends 'Bread::Board::Container'; + +has config_local_suffix => ( + is => 'ro', + isa => 'Str', + default => 'local', +); + +has driver => ( + is => 'ro', + isa => 'HashRef', + default => sub { +{} }, +); + +has file => ( + is => 'ro', + isa => 'Str', + default => '', +); + +has substitutions => ( + is => 'ro', + isa => 'HashRef', + default => sub { +{} }, +); + +has application_name => ( + is => 'ro', + isa => 'Str', + required => 1, +); + +has sub_container_class => ( + isa => LoadableClass, + is => 'ro', + coerce => 1, + default => 'Catalyst::IOC::SubContainer', + handles => { + new_sub_container => 'new', + } +); + +sub BUILD { + my ( $self, $params ) = @_; + + $self->add_service( + $self->${\"build_${_}_service"} + ) for qw/ + substitutions + file + driver + application_name + prefix + extensions + path + config + raw_config + global_files + local_files + global_config + local_config + class_config + config_local_suffix + config_path + locate_components + /; + + my $config = $self->resolve( service => 'config' ); + + $self->add_sub_container( + $self->build_component_subcontainer + ); + + $self->add_sub_container( + $self->build_controller_subcontainer + ); + + $self->add_sub_container( + $self->build_view_subcontainer( + default_component => $config->{default_view}, + ) + ); + + $self->add_sub_container( + $self->build_model_subcontainer( + default_component => $config->{default_model}, + ) + ); +} + +sub build_model_subcontainer { + my $self = shift; + + return $self->new_sub_container( @_, + name => 'model', + ); +} + +sub build_view_subcontainer { + my $self = shift; + + return $self->new_sub_container( @_, + name => 'view', + ); +} + +sub build_controller_subcontainer { + my $self = shift; + + return $self->new_sub_container( + name => 'controller', + ); +} + +sub build_component_subcontainer { + my $self = shift; + + return Bread::Board::Container->new( + name => 'component', + ); +} + +sub build_application_name_service { + my $self = shift; + + return Bread::Board::Literal->new( name => 'application_name', value => $self->application_name ); +} + +sub build_driver_service { + my $self = shift; + + return Bread::Board::Literal->new( name => 'driver', value => $self->driver ); +} + +sub build_file_service { + my $self = shift; + + return Bread::Board::Literal->new( name => 'file', value => $self->file ); +} + +sub build_substitutions_service { + my $self = shift; + + return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions ); +} + +sub build_extensions_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'extensions', + block => sub { + return \@{Config::Any->extensions}; + }, + ); +} + +sub build_prefix_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'prefix', + block => sub { + return Catalyst::Utils::appprefix( shift->param('application_name') ); + }, + dependencies => [ depends_on('application_name') ], + ); +} + +sub build_path_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'path', + block => sub { + my $s = shift; + + return Catalyst::Utils::env_value( $s->param('application_name'), 'CONFIG' ) + || $s->param('file') + || $s->param('application_name')->path_to( $s->param('prefix') ); + }, + dependencies => [ depends_on('file'), depends_on('application_name'), depends_on('prefix') ], + ); +} + +sub build_config_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'config', + block => sub { + my $s = shift; + + my $v = Data::Visitor::Callback->new( + plain_value => sub { + return unless defined $_; + return $self->_config_substitutions( $s->param('application_name'), $s->param('substitutions'), $_ ); + } + + ); + $v->visit( $s->param('raw_config') ); + }, + dependencies => [ depends_on('application_name'), depends_on('raw_config'), depends_on('substitutions') ], + ); +} + +sub build_raw_config_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'raw_config', + block => sub { + my $s = shift; + + my @global = @{$s->param('global_config')}; + my @locals = @{$s->param('local_config')}; + + my $config = $s->param('class_config'); + + for my $cfg (@global, @locals) { + for (keys %$cfg) { + $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} ); + } + } + + return $config; + }, + dependencies => [ depends_on('global_config'), depends_on('local_config'), depends_on('class_config') ], + ); +} + +sub build_global_files_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'global_files', + block => sub { + my $s = shift; + + my ( $path, $extension ) = @{$s->param('config_path')}; + + my @extensions = @{$s->param('extensions')}; + + my @files; + if ( $extension ) { + die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions; + push @files, $path; + } else { + @files = map { "$path.$_" } @extensions; + } + return \@files; + }, + dependencies => [ depends_on('extensions'), depends_on('config_path') ], + ); +} + +sub build_local_files_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'local_files', + block => sub { + my $s = shift; + + my ( $path, $extension ) = @{$s->param('config_path')}; + my $suffix = $s->param('config_local_suffix'); + + my @extensions = @{$s->param('extensions')}; + + my @files; + if ( $extension ) { + die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions; + $path =~ s{\.$extension}{_$suffix.$extension}; + push @files, $path; + } else { + @files = map { "${path}_${suffix}.$_" } @extensions; + } + return \@files; + }, + dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ], + ); +} + +sub build_class_config_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'class_config', + block => sub { + my $s = shift; + my $app = $s->param('application_name'); + + # Container might be called outside Catalyst context + return {} unless Class::MOP::is_class_loaded($app); + + # config might not have been defined + return $app->config || {}; + }, + dependencies => [ depends_on('application_name') ], + ); +} + +sub build_global_config_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'global_config', + block => sub { + my $s = shift; + + return Config::Any->load_files({ + files => $s->param('global_files'), + filter => \&_fix_syntax, + use_ext => 1, + driver_args => $s->param('driver'), + }); + }, + dependencies => [ depends_on('global_files') ], + ); +} + +sub build_local_config_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'local_config', + block => sub { + my $s = shift; + + return Config::Any->load_files({ + files => $s->param('local_files'), + filter => \&_fix_syntax, + use_ext => 1, + driver_args => $s->param('driver'), + }); + }, + dependencies => [ depends_on('local_files') ], + ); +} + +sub build_config_path_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'config_path', + block => sub { + my $s = shift; + + my $path = $s->param('path'); + my $prefix = $s->param('prefix'); + + my ( $extension ) = ( $path =~ m{\.(.{1,4})$} ); + + if ( -d $path ) { + $path =~ s{[\/\\]$}{}; + $path .= "/$prefix"; + } + + return [ $path, $extension ]; + }, + dependencies => [ depends_on('prefix'), depends_on('path') ], + ); +} + +sub build_config_local_suffix_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'config_local_suffix', + block => sub { + my $s = shift; + my $suffix = Catalyst::Utils::env_value( $s->param('application_name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix; + + return $suffix; + }, + dependencies => [ depends_on('application_name') ], + ); +} + +sub build_locate_components_service { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'locate_components', + block => sub { + my $s = shift; + my $class = $s->param('application_name'); + my $config = $s->param('config')->{ setup_components }; + + Catalyst::Exception->throw( + qq{You are using search_extra config option. That option is\n} . + qq{deprecated, please refer to the documentation for\n} . + qq{other ways of achieving the same results.\n} + ) if delete $config->{ search_extra }; + + my @paths = qw( ::Controller ::C ::Model ::M ::View ::V ); + + my $locator = Module::Pluggable::Object->new( + search_path => [ map { s/^(?=::)/$class/; $_; } @paths ], + %$config + ); + + return [ $locator->plugins ]; + }, + dependencies => [ depends_on('application_name'), depends_on('config') ], + ); +} + +sub setup_components { + my $self = shift; + my $class = $self->resolve( service => 'application_name' ); + my @comps = @{ $self->resolve( service => 'locate_components' ) }; + my %comps = map { $_ => 1 } @comps; + my $deprecatedcatalyst_component_names = 0; + + for my $component ( @comps ) { + + # We pass ignore_loaded here so that overlay files for (e.g.) + # Model::DBI::Schema sub-classes are loaded - if it's in @comps + # we know M::P::O found a file on disk so this is safe + + Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } ); + } + + for my $component (@comps) { + $self->add_component( $component ); + # FIXME - $instance->expand_modules() is broken + my @expanded_components = $self->expand_component_module( $component ); + + if ( + !$deprecatedcatalyst_component_names && + ($deprecatedcatalyst_component_names = $component =~ m/::[CMV]::/) || + ($deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @expanded_components) + ) { + # FIXME - should I be calling warn here? + # Maybe it's time to remove it, or become fatal + $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}. + qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n} + ); + } + + for my $component (@expanded_components) { + $self->add_component( $component ) + unless $comps{$component}; + } + } + + $self->get_sub_container('model')->make_single_default; + $self->get_sub_container('view')->make_single_default; +} + +sub _fix_syntax { + my $config = shift; + my @components = ( + map +{ + prefix => $_ eq 'Component' ? '' : $_ . '::', + values => delete $config->{ lc $_ } || delete $config->{ $_ } + }, + grep { ref $config->{ lc $_ } || ref $config->{ $_ } } + qw( Component Model M View V Controller C Plugin ) + ); + + foreach my $comp ( @components ) { + my $prefix = $comp->{ prefix }; + foreach my $element ( keys %{ $comp->{ values } } ) { + $config->{ "$prefix$element" } = $comp->{ values }->{ $element }; + } + } +} + +sub _config_substitutions { + my ( $self, $name, $subs, $arg ) = @_; + + $subs->{ HOME } ||= sub { shift->path_to( '' ); }; + $subs->{ ENV } ||= + sub { + my ( $c, $v ) = @_; + if (! defined($ENV{$v})) { + Catalyst::Exception->throw( message => + "Missing environment variable: $v" ); + return ""; + } else { + return $ENV{ $v }; + } + }; + $subs->{ path_to } ||= sub { shift->path_to( @_ ); }; + $subs->{ literal } ||= sub { return $_[ 1 ]; }; + my $subsre = join( '|', keys %$subs ); + + $arg =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $name, $2 ? split( /,/, $2 ) : () ) }eg; + return $arg; +} + +sub get_component_from_sub_container { + my ( $self, $sub_container_name, $name, $c, @args ) = @_; + + my $sub_container = $self->get_sub_container( $sub_container_name ); + + if (!$name) { + my $default = $sub_container->default_component; + + return $sub_container->get_component( $default, $c, @args ) + if $default && $sub_container->has_service( $default ); + + # FIXME - should I be calling $c->log->warn here? + # this is never a controller, so this is safe + $c->log->warn( "Calling \$c->$sub_container_name() is not supported unless you specify one of:" ); + $c->log->warn( "* \$c->config(default_$sub_container_name => 'the name of the default $sub_container_name to use')" ); + $c->log->warn( "* \$c->stash->{current_$sub_container_name} # the name of the view to use for this request" ); + $c->log->warn( "* \$c->stash->{current_${sub_container_name}_instance} # the instance of the $sub_container_name to use for this request" ); + + return; + } + + return $sub_container->get_component_regexp( $name, $c, @args ) + if ref $name; + + return $sub_container->get_component( $name, $c, @args ) + if $sub_container->has_service( $name ); + + $c->log->warn( + "Attempted to use $sub_container_name '$name', " . + "but it does not exist" + ); + + return; +} + +sub find_component { + my ( $self, $component, @args ) = @_; + my ( $type, $name ) = _get_component_type_name($component); + my @result; + + return $self->get_component_from_sub_container( + $type, $name, @args + ) if $type; + + my $query = ref $component + ? $component + : qr{^$component$} + ; + + for my $subcontainer_name (qw/model view controller/) { + my $subcontainer = $self->get_sub_container( $subcontainer_name ); + my @components = $subcontainer->get_service_list; + @result = grep { m{$component} } @components; + + return map { $subcontainer->get_component( $_, @args ) } @result + if @result; + } + + # one last search for things like $c->comp(qr/::M::/) + @result = $self->find_component_regexp( + $component, @args + ) if !@result and ref $component; + + # it expects an empty list on failed searches + return @result; +} + +sub find_component_regexp { + my ( $self, $component, @args ) = @_; + my @result; + + my @components = grep { m{$component} } keys %{ $self->get_all_components }; + + for (@components) { + my ($type, $name) = _get_component_type_name($_); + + push @result, $self->get_component_from_sub_container( + $type, $name, @args + ) if $type; + } + + return @result; +} + +# FIXME - t0m, how do you feel about this name? +# also, do you think I should draw it here, or just return the data structure? +sub get_components_names_types { + my ( $self ) = @_; + my @comps_names_types; + + for my $sub_container_name (qw/model view controller/) { + my $sub_container = $self->get_sub_container($sub_container_name); + for my $service ( $sub_container->get_service_list ) { + my $comp = $sub_container->resolve(service => $service); + my $compname = ref $comp || $comp; + my $type = ref $comp ? 'instance' : 'class'; + push @comps_names_types, [ $compname, $type ]; + } + } + + return @comps_names_types; +} + +sub get_all_components { + my $self = shift; + my %components; + + my $container = $self->get_sub_container('component'); + + for my $component ($container->get_service_list) { + my $comp = $container->resolve( + service => $component + ); + my $comp_name = ref $comp || $comp; + $components{$comp_name} = $comp; + } + + return lock_hash %components; +} + +sub add_component { + my ( $self, $component ) = @_; + my ( $type, $name ) = _get_component_type_name($component); + + return unless $type; + + my $component_service_name = "${type}_${name}"; + + $self->get_sub_container('component')->add_service( + Catalyst::IOC::ConstructorInjection->new( + name => $component_service_name, + class => $component, + lifecycle => 'Singleton', + dependencies => [ + depends_on( '/application_name' ), + depends_on( '/config' ), + ], + ) + ); + + $self->get_sub_container($type)->add_service( + Catalyst::IOC::BlockInjection->new( + name => $name, + dependencies => [ + depends_on( "/component/$component_service_name" ), + ], + block => sub { return shift->param($component_service_name) }, + ) + ); +} + +# FIXME: should this sub exist? +# should it be moved to Catalyst::Utils, +# or replaced by something already existing there? +sub _get_component_type_name { + my ( $component ) = @_; + + my @parts = split /::/, $component; + + while (my $type = shift @parts) { + return ('controller', join '::', @parts) + if $type =~ /^(c|controller)$/i; + + return ('model', join '::', @parts) + if $type =~ /^(m|model)$/i; + + return ('view', join '::', @parts) + if $type =~ /^(v|view)$/i; + } + + return (undef, $component); +} + +sub expand_component_module { + my ( $class, $module ) = @_; + return Devel::InnerPackage::list_packages( $module ); +} + +1; + +__END__ + +=pod + +=head1 NAME + +Catalyst::Container - IOC for Catalyst components + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=head1 Building Containers + +=head2 build_model_subcontainer + +Container that stores all models. + +=head2 build_view_subcontainer + +Container that stores all views. + +=head2 build_controller_subcontainer + +Container that stores all controllers. + +=head1 Building Services + +=head2 build_application_name_service + +Name of the application (such as MyApp). + +=head2 build_driver_service + +Config options passed directly to the driver being used. + +=head2 build_file_service + +? + +=head2 build_substitutions_service + +This method substitutes macros found with calls to a function. There are a +number of default macros: + +=over + +=item * C<__HOME__> - replaced with C<$c-Epath_to('')> + +=item * C<__ENV(foo)__> - replaced with the value of C<$ENV{foo}> + +=item * C<__path_to(foo/bar)__> - replaced with C<$c-Epath_to('foo/bar')> + +=item * C<__literal(__FOO__)__> - leaves __FOO__ alone (allows you to use +C<__DATA__> as a config value, for example) + +=back + +The parameter list is split on comma (C<,>). You can override this method to +do your own string munging, or you can define your own macros in +Cconfig-E{ 'Plugin::ConfigLoader' }-E{ substitutions }>. +Example: + + MyApp->config->{ 'Plugin::ConfigLoader' }->{ substitutions } = { + baz => sub { my $c = shift; qux( @_ ); } + } + +The above will respond to C<__baz(x,y)__> in config strings. + +=head2 build_extensions_service + +Config::Any's available config file extensions (e.g. xml, json, pl, etc). + +=head2 build_prefix_service + +The prefix, based on the application name, that will be used to lookup the +config files (which will be in the format $prefix.$extension). If the app is +MyApp::Foo, the prefix will be myapp_foo. + +=head2 build_path_service + +The path to the config file (or environment variable, if defined). + +=head2 build_config_service + +The resulting configuration for the application, after it has successfully +been loaded, and all substitutions have been made. + +=head2 build_raw_config_service + +The merge of local_config and global_config hashes, before substitutions. + +=head2 build_global_files_service + +Gets all files for config that don't have the local_suffix, such as myapp.conf. + +=head2 build_local_files_service + +Gets all files for config that have the local_suffix, such as myapp_local.conf. + +=head2 build_global_config_service + +Reads config from global_files. + +=head2 build_local_config_service + +Reads config from local_files. + +=head2 build_class_config_service + +Reads config set from the application's class attribute config, +i.e. MyApp->config( name => 'MyApp', ... ) + +=head2 build_config_path_service + +Splits the path to the config file, and returns on array ref containing +the path to the config file minus the extension in the first position, +and the extension in the second. + +=head2 build_config_local_suffix_service + +Determines the suffix of files used to override the main config. By default +this value is C, which will load C. The suffix can +be specified in the following order of preference: + +=over + +=item * C<$ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }> + +=item * C<$ENV{ CATALYST_CONFIG_LOCAL_SUFFIX }> + +=back + +The first one of these values found replaces the default of C in the +name of the local config file to be loaded. + +For example, if C< $ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }> is set to C, +ConfigLoader will try and load C instead of +C. + +=head2 build_locate_components_service + +This method is meant to provide a list of component modules that should be +setup for the application. By default, it will use L. + +Specify a C config option to pass additional options directly +to L. + +=head1 Other methods + +=head2 get_component_from_sub_container($sub_container, $name, $c, @args) + +Looks for components in a given subcontainer (such as controller, model or +view), and returns the searched component. If $name is undef, it returns the +default component (such as default_view, if $sub_container is 'view'). If +$name is a regexp, it returns an array of matching components. Otherwise, it +looks for the component with name $name. + +=head2 get_components_names_types + +Gets all components from all containers and returns them as an array of +arrayrefs containing the component name and the component type (i.e., whether +it's an instance or a class). + +=head2 get_all_components + +Fetches all the components, in each of the sub_containers model, view and +controller, and returns a readonly hash. The keys are the class names, and +the values are the blessed objects. This is what is returned by $c->components. + +=head2 add_component + +Adds a component to the appropriate subcontainer. The subcontainer is guessed +by the component name given. + +=head2 find_component + +Searches for components in all containers. If $component is the full class +name, the subcontainer is guessed, and it gets the searched component in there. +Otherwise, it looks for a component with that name in all subcontainers. If +$component is a regexp, it calls the method below, find_component_regexp, +and matches all components against that regexp. + +=head2 find_component_regexp + +Finds components that match a given regexp. Used internally, by find_component. + +=head2 expand_component_module + +Components found by C will be passed to this method, which +is expected to return a list of component (package) names to be set up. + +=head2 setup_components + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/lib/Catalyst/IOC/Service/WithAcceptContext.pm b/lib/Catalyst/IOC/Service/WithAcceptContext.pm new file mode 100644 index 0000000..4559a69 --- /dev/null +++ b/lib/Catalyst/IOC/Service/WithAcceptContext.pm @@ -0,0 +1,54 @@ +package Catalyst::IOC::Service::WithAcceptContext; +use Moose::Role; + +with 'Bread::Board::Service'; + +has accept_context_sub => ( + is => 'ro', + isa => 'Str', + default => 'ACCEPT_CONTEXT', +); + +around 'get' => sub { + my $orig = shift; + my $self = shift; + + my $instance = $self->$orig(@_); + + my $accept_context_args = $self->param('accept_context_args'); + my $ac_sub = $self->accept_context_sub; + + if ( $instance->can($ac_sub) ) { + return $instance->$ac_sub( @$accept_context_args ); + } + + return $instance; +}; + +no Moose::Role; +1; + +__END__ + +=pod + +=head1 NAME + +Catalyst::IOC::Service::WithAcceptContext + +=head1 DESCRIPTION + +=head1 ATTRIBUTES + +=head2 accept_context_sub + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/lib/Catalyst/IOC/Service/WithCOMPONENT.pm b/lib/Catalyst/IOC/Service/WithCOMPONENT.pm new file mode 100644 index 0000000..97a08ea --- /dev/null +++ b/lib/Catalyst/IOC/Service/WithCOMPONENT.pm @@ -0,0 +1,65 @@ +package Catalyst::IOC::Service::WithCOMPONENT; +use Moose::Role; + +with 'Bread::Board::Service'; + +sub _build_constructor_name { 'COMPONENT' } + +around 'get' => sub { + my ( $orig, $self ) = @_; + + my $constructor = $self->constructor_name; + my $component = $self->class; + + unless ( $component->can( $constructor ) ) { + # FIXME - make some deprecation warnings + return $component; + } + + my $instance = eval { $self->$orig() }; + + if ( my $error = $@ ) { + chomp $error; + Catalyst::Exception->throw( + message => qq/Couldn't instantiate component "$component", "$error"/ + ); + } + elsif (!blessed $instance) { + my $metaclass = Moose::Util::find_meta($component); + my $method_meta = $metaclass->find_method_by_name($constructor); + my $component_method_from = $method_meta->associated_metaclass->name; + my $value = defined($instance) ? $instance : 'undef'; + Catalyst::Exception->throw( + message => + qq/Couldn't instantiate component "$component", $constructor() method (from $component_method_from) didn't return an object-like value (value was $value)./ + ); + } + + return $instance; +}; + +no Moose::Role; +1; + +__END__ + +=pod + +=head1 NAME + +Catalyst::IOC::Service::WithCOMPONENT + +=head1 DESCRIPTION + +=head1 METHODS + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/lib/Catalyst/IOC/Service/WithParameters.pm b/lib/Catalyst/IOC/Service/WithParameters.pm new file mode 100644 index 0000000..44c42f9 --- /dev/null +++ b/lib/Catalyst/IOC/Service/WithParameters.pm @@ -0,0 +1,41 @@ +package Catalyst::IOC::Service::WithParameters; +use Moose::Role; + +with 'Bread::Board::Service', + 'Bread::Board::Service::WithParameters'; + +sub _build_parameters { + return { + accept_context_args => { + isa => 'ArrayRef|Undef', + required => 0, + default => undef, + } + }; +} + +no Moose::Role; +1; + +__END__ + +=pod + +=head1 NAME + +Catalyst::IOC::Service::WithParameters + +=head1 DESCRIPTION + +=head1 METHODS + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/lib/Catalyst/IOC/SubContainer.pm b/lib/Catalyst/IOC/SubContainer.pm new file mode 100644 index 0000000..4870bf0 --- /dev/null +++ b/lib/Catalyst/IOC/SubContainer.pm @@ -0,0 +1,83 @@ +package Catalyst::IOC::SubContainer; +use Bread::Board; +use Moose; + +extends 'Bread::Board::Container'; + +has default_component => ( + isa => 'Str|Undef', + is => 'ro', + required => 0, + writer => '_set_default_component', +); + +sub get_component { + my ( $self, $name, @args ) = @_; + + return $self->resolve( + service => $name, + parameters => { accept_context_args => \@args }, + ); +} + +sub get_component_regexp { + my ( $self, $query, $c, @args ) = @_; + + my @result = map { + $self->get_component( $_, $c, @args ) + } grep { m/$query/ } $self->get_service_list; + + return @result; +} + +# FIXME - is this sub ok? +# is the name ok too? +sub make_single_default { + my ( $self ) = @_; + + my @complist = $self->get_service_list; + + $self->_set_default_component( shift @complist ) + if !$self->default_component && scalar @complist == 1; +} + +1; + +__END__ + +=pod + +=head1 NAME + +Catalyst::IOC::SubContainer - Container for models, controllers and views + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head1 METHODS + +=head2 get_component + +Gets the service of the container for the searched component. Also executes +the ACCEPT_CONTEXT sub in the component, if it exists. + +=head2 get_component_regexp + +Gets all components from container that match a given regexp. + +=head2 make_single_default + +If the container has only one component, and no default has been defined, +this method makes that one existing service the default. + +=head1 AUTHORS + +Catalyst Contributors, see Catalyst.pm + +=head1 COPYRIGHT + +This library is free software. You can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm index 45f52e4..1a0dd41 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -84,6 +84,20 @@ sub class2classsuffix { return $class; } +=head2 class2classshortsuffix($class) + + MyApp::Controller::Foo::Bar becomes Foo::Bar + +=cut + +sub class2classshortsuffix { + my $class = shift || ''; + my $prefix = class2classprefix($class) || ''; + $class =~ s/$prefix\:://; + return $class; +} + + =head2 class2env($class); Returns the environment name for class. diff --git a/t/aggregate/live_mvc_warnings.t b/t/aggregate/live_mvc_warnings.t new file mode 100644 index 0000000..5d940a0 --- /dev/null +++ b/t/aggregate/live_mvc_warnings.t @@ -0,0 +1,25 @@ +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Test::More; +use Catalyst::Test 'TestAppMVCWarnings'; + +if ( $ENV{CATALYST_SERVER} ) { + plan skip_all => 'Using remote server'; +} + +{ + ok( request('http://localhost/view'), 'Request' ); + like($TestAppMVCWarnings::log_messages[0], qr/Calling \$c->view\(\) is not supported/s, 'View failure warning received'); + + @TestAppMVCWarnings::log_messages = (); + + ok( request('http://localhost/model'), 'Request' ); + like($TestAppMVCWarnings::log_messages[0], qr/Calling \$c->model\(\) is not supported/s, 'Model failure warning received'); +} + +done_testing; + diff --git a/t/aggregate/live_view_warnings.t b/t/aggregate/live_view_warnings.t deleted file mode 100644 index 1387c1b..0000000 --- a/t/aggregate/live_view_warnings.t +++ /dev/null @@ -1,23 +0,0 @@ -#!perl - -use strict; -use warnings; - -use FindBin; -use lib "$FindBin::Bin/../lib"; - -use Test::More; -use Catalyst::Test 'TestAppViewWarnings'; - -if ( $ENV{CATALYST_SERVER} ) { - plan skip_all => 'Using remote server'; -} - -{ - ok( my $response = request('http://localhost/'), 'Request' ); - like($TestAppViewWarnings::log_messages[0], qr/Attempted to use view/s, 'View failure warning received'); - -} - -done_testing; - diff --git a/t/aggregate/unit_core_action_for.t b/t/aggregate/unit_core_action_for.t index c0af9d3..ede9c35 100644 --- a/t/aggregate/unit_core_action_for.t +++ b/t/aggregate/unit_core_action_for.t @@ -12,7 +12,7 @@ plan tests => 4; use_ok('TestApp'); -is(TestApp->action_for('global_action')->code, TestApp::Controller::Root->can('global_action'), +is(TestApp->controller('Root')->action_for('global_action')->code, TestApp::Controller::Root->can('global_action'), 'action_for on appclass ok'); is(TestApp->controller('Args')->action_for('args')->code, diff --git a/t/aggregate/unit_core_component.t b/t/aggregate/unit_core_component.t index 69ac6c0..62785ea 100644 --- a/t/aggregate/unit_core_component.t +++ b/t/aggregate/unit_core_component.t @@ -1,72 +1,49 @@ -use Test::More tests => 22; +use Test::More; use strict; use warnings; +use FindBin; +use lib "$FindBin::Bin/../lib"; +use TestAppComponent; -use_ok('Catalyst'); +my @complist = map { "TestAppComponent::$_"; } qw/C::Controller M::Model V::View/; -my @complist = map { "MyApp::$_"; } qw/C::Controller M::Model V::View/; +is(ref TestAppComponent->comp('TestAppComponent::V::View'), 'TestAppComponent::V::View', 'Explicit return ok'); -{ - package MyApp; - - use base qw/Catalyst/; - - __PACKAGE__->components({ map { ($_, $_) } @complist }); - - # this is so $c->log->warn will work - __PACKAGE__->setup_log; -} - -is(MyApp->comp('MyApp::V::View'), 'MyApp::V::View', 'Explicit return ok'); +is(ref TestAppComponent->comp('C::Controller'), 'TestAppComponent::C::Controller', 'Two-part return ok'); -is(MyApp->comp('C::Controller'), 'MyApp::C::Controller', 'Two-part return ok'); +is(ref TestAppComponent->comp('Model'), 'TestAppComponent::M::Model', 'Single part return ok'); -is(MyApp->comp('Model'), 'MyApp::M::Model', 'Single part return ok'); - -is_deeply([ MyApp->comp() ], \@complist, 'Empty return ok'); +is_deeply([ TestAppComponent->comp() ], \@complist, 'Empty return ok'); # Is this desired behaviour? -is_deeply([ MyApp->comp('Foo') ], \@complist, 'Fallthrough return ok'); +is_deeply([ TestAppComponent->comp('Foo') ], \@complist, 'Fallthrough return ok'); # regexp behavior { - is_deeply( [ MyApp->comp( qr{Model} ) ], [ 'MyApp::M::Model'], 'regexp ok' ); - is_deeply( [ MyApp->comp('MyApp::V::View$') ], [ 'MyApp::V::View' ], 'Explicit return ok'); - is_deeply( [ MyApp->comp('MyApp::C::Controller$') ], [ 'MyApp::C::Controller' ], 'Explicit return ok'); - is_deeply( [ MyApp->comp('MyApp::M::Model$') ], [ 'MyApp::M::Model' ], 'Explicit return ok'); - - # a couple other varieties for regexp fallback - is_deeply( [ MyApp->comp('M::Model') ], [ 'MyApp::M::Model' ], 'Explicit return ok'); + is_deeply( [ map { ref $_ } TestAppComponent->comp( qr{Model} ) ], [ 'TestAppComponent::M::Model' ], 'regexp ok' ); { my $warnings = 0; no warnings 'redefine'; local *Catalyst::Log::warn = sub { $warnings++ }; - is_deeply( [ MyApp->comp('::M::Model') ], [ 'MyApp::M::Model' ], 'Explicit return ok'); - ok( $warnings, 'regexp fallback warnings' ); - - $warnings = 0; - is_deeply( [ MyApp->comp('Mode') ], [ 'MyApp::M::Model' ], 'Explicit return ok'); + is_deeply( [ TestAppComponent->comp('::M::Model') ], \@complist, 'no reulsts for regexp fallback'); ok( $warnings, 'regexp fallback warnings' ); - - $warnings = 0; - is(MyApp->comp('::M::'), 'MyApp::M::Model', 'Regex return ok'); - ok( $warnings, 'regexp fallback for comp() warns' ); } } # multiple returns { - my @expected = sort qw( MyApp::C::Controller MyApp::M::Model ); - my @got = sort MyApp->comp( qr{::[MC]::} ); + # already sorted + my @expected = qw( TestAppComponent::C::Controller TestAppComponent::M::Model ); + my @got = map { ref $_ } sort TestAppComponent->comp( qr{::[MC]::} ); is_deeply( \@got, \@expected, 'multiple results from regexp ok' ); } # failed search { - is_deeply( scalar MyApp->comp( qr{DNE} ), 0, 'no results for failed search' ); + is_deeply( scalar TestAppComponent->comp( qr{DNE} ), 0, 'no results for failed search' ); } @@ -76,18 +53,16 @@ is_deeply([ MyApp->comp('Foo') ], \@complist, 'Fallthrough return ok'); { no warnings 'once'; - *MyApp::M::Model::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args}; + *TestAppComponent::M::Model::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args}; } - my $c = bless {}, 'MyApp'; + my $c = bless {}, 'TestAppComponent'; - $c->component('MyApp::M::Model', qw/foo bar/); + $c->component('TestAppComponent::M::Model', qw/foo bar/); is_deeply($args, [qw/foo bar/], 'args passed to ACCEPT_CONTEXT ok'); $c->component('M::Model', qw/foo2 bar2/); is_deeply($args, [qw/foo2 bar2/], 'args passed to ACCEPT_CONTEXT ok'); - - $c->component('Mode', qw/foo3 bar3/); - is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok'); } +done_testing; diff --git a/t/aggregate/unit_core_component_generating.t b/t/aggregate/unit_core_component_generating.t index a518fce..4905711 100644 --- a/t/aggregate/unit_core_component_generating.t +++ b/t/aggregate/unit_core_component_generating.t @@ -1,4 +1,5 @@ -use Test::More tests => 3; +# FIXME - what to do about expand_modules? +use Test::More skip_all => "Needs expand_modules, that has been removed from Catalyst.pm"; use strict; use warnings; @@ -8,3 +9,5 @@ use TestApp; ok(TestApp->model('Generating'), 'knows about generating model'); ok(TestApp->model('Generated'), 'knows about the generated model'); is(TestApp->model('Generated')->foo, 'foo', 'can operate on generated model'); + +done_testing; diff --git a/t/aggregate/unit_core_component_layers.t b/t/aggregate/unit_core_component_layers.t index c15bc73..d603b0b 100644 --- a/t/aggregate/unit_core_component_layers.t +++ b/t/aggregate/unit_core_component_layers.t @@ -1,4 +1,4 @@ -use Test::More tests => 6; +use Test::More; use strict; use warnings; use lib 't/lib'; @@ -24,3 +24,4 @@ TestApp->setup; is($model_foo->model_quux_method, 'chunkybacon', 'Model method getting $self->{quux} from config'); +done_testing; diff --git a/t/aggregate/unit_core_component_loading.t b/t/aggregate/unit_core_component_loading.t index 2c53144..19a316c 100644 --- a/t/aggregate/unit_core_component_loading.t +++ b/t/aggregate/unit_core_component_loading.t @@ -1,8 +1,5 @@ -# 2 initial tests, and 6 per component in the loop below -# (do not forget to update the number of components in test 3 as well) -# 5 extra tests for the loading options -# One test for components in inner packages -use Test::More tests => 2 + 6 * 24 + 8 + 1; +# way too many tests to count +use Test::More; use strict; use warnings; @@ -94,12 +91,16 @@ my $shut_up_deprecated_warnings = q{ eval "package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->setup"; +is_deeply( + [ sort $appclass->locate_components ], + [ map { $appclass . '::' . $_->{prefix} . '::' . $_->{name} } @components ], 'locate_components finds the components correctly' +); + can_ok( $appclass, 'components'); my $complist = $appclass->components; -# the +1 below is for the app class itself -is(scalar keys %$complist, 24+1, "Correct number of components loaded"); +is(scalar keys %$complist, 24, "Correct number of components loaded"); foreach (keys %$complist) { @@ -152,27 +153,49 @@ foreach my $component (@components) { ); } -eval qq( -package $appclass; -use Catalyst; -$shut_up_deprecated_warnings -__PACKAGE__->config->{ setup_components } = { - search_extra => [ '::Extra' ], - except => [ "${appclass}::Controller::Foo" ] -}; -__PACKAGE__->setup; -); +SKIP: { + # FIXME - any backcompat planned? + skip "search_extra has been removed", 5; + eval qq( + package $appclass; + use Catalyst; + $shut_up_deprecated_warnings + __PACKAGE__->config->{ setup_components } = { + search_extra => [ '::Extra' ], + except => [ "${appclass}::Controller::Foo" ] + }; + __PACKAGE__->setup; + ); -can_ok( $appclass, 'components'); + { + my $config = { + search_extra => [ '::Extra' ], + except => [ "${appclass}::Controller::Foo" ] + }; + my @components_located = $appclass->locate_components($config); + my @components_expected; + for (@components) { + my $name = $appclass . '::' . $_->{prefix} . '::' . $_->{name}; + push @components_expected, $name if $name ne "${appclass}::Controller::Foo"; + } + is_deeply( + [ sort @components_located ], + [ sort @components_expected ], + 'locate_components finds the components correctly' + ); + } -$complist = $appclass->components; + can_ok( $appclass, 'components'); -is(scalar keys %$complist, 24+1, "Correct number of components loaded"); + $complist = $appclass->components; -ok( !exists $complist->{ "${appclass}::Controller::Foo" }, 'Controller::Foo was skipped' ); -ok( exists $complist->{ "${appclass}::Extra::Foo" }, 'Extra::Foo was loaded' ); + is(scalar keys %$complist, 24+1, "Correct number of components loaded"); -rmtree($libdir); + ok( !exists $complist->{ "${appclass}::Controller::Foo" }, 'Controller::Foo was skipped' ); + ok( exists $complist->{ "${appclass}::Extra::Foo" }, 'Extra::Foo was loaded' ); + + rmtree($libdir); +} $appclass = "ComponentOnce"; @@ -215,8 +238,9 @@ eval "package $appclass; use Catalyst; __PACKAGE__->setup"; is($@, '', "Didn't load component twice"); is($appclass->model('TopLevel::Nested')->called,1, 'COMPONENT called once'); -ok($appclass->model('TopLevel::Generated'), 'Have generated model'); -is(ref($appclass->model('TopLevel::Generated')), 'FooBarBazQuux', +# FIXME - OMG why should this even work?!! +ok($appclass->model('TopLevel::GENERATED'), 'Have generated model'); +is(ref($appclass->model('TopLevel::GENERATED')), 'FooBarBazQuux', 'ACCEPT_CONTEXT in generated inner package fired as expected'); $appclass = "InnerComponent"; @@ -233,3 +257,5 @@ eval "package $appclass; use Catalyst; __PACKAGE__->setup"; isa_ok($appclass->controller('Test'), 'Catalyst::Controller'); rmtree($libdir); + +done_testing; diff --git a/t/aggregate/unit_core_component_mro.t b/t/aggregate/unit_core_component_mro.t index 8e9a064..3b0fae6 100644 --- a/t/aggregate/unit_core_component_mro.t +++ b/t/aggregate/unit_core_component_mro.t @@ -1,4 +1,4 @@ -use Test::More tests => 1; +use Test::More; use strict; use warnings; @@ -27,3 +27,4 @@ my $warn = ''; like($warn, qr/after Catalyst::Component in MyApp::Component/, 'correct warning thrown'); +done_testing; diff --git a/t/aggregate/unit_core_component_setup_component.t b/t/aggregate/unit_core_component_setup_component.t new file mode 100644 index 0000000..c2cab1e --- /dev/null +++ b/t/aggregate/unit_core_component_setup_component.t @@ -0,0 +1,100 @@ +use strict; +use warnings; + +# FIXME - backcompat? +use Test::More skip_all => "Removed setup_component from Catalyst.pm"; +use Moose::Meta::Class; + +my %config = ( + foo => 42, + bar => 'myconf', +); + +Moose::Meta::Class->create( TestAppComponent => ( + superclasses => ['Catalyst'], +)); + +TestAppComponent->config( + 'Model::With::Config' => { %config }, +); + +TestAppComponent->setup_config; + +my @comps; +push @comps, "TestAppComponent::$_" for qw/ + Without::Component::Sub + Model::With::Config + Dieing + NotBlessed + Regular +/; +my ($no_sub, $config, $dieing, $not_blessed, $regular) = @comps; + +Moose::Meta::Class->create( $no_sub => ( + superclasses => ['Catalyst::Component'], +)); + +Moose::Meta::Class->create( $config => ( + superclasses => ['Catalyst::Component'], + methods => { + COMPONENT => sub { bless $_[2] } + }, +)); + +Moose::Meta::Class->create( $dieing => ( + superclasses => ['Catalyst::Component'], + methods => { + COMPONENT => sub { die "Could not create component" } + }, +)); + +Moose::Meta::Class->create( $not_blessed => ( + superclasses => ['Catalyst::Component'], + methods => { + COMPONENT => sub { {} } + }, +)); + +Moose::Meta::Class->create( $regular => ( + superclasses => ['Catalyst::Component'], + methods => { + COMPONENT => sub { shift->new } + }, +)); + +{ + no warnings 'redefine', 'once'; + my $message; + my $component; + + local *Catalyst::Exception::throw = sub { shift; my %h = @_; $message = $h{message} }; + + $component = eval { TestAppComponent->setup_component($no_sub) }; + ok( !$@, "setup_component doesnt die with $no_sub" ); + is( $message, undef, "no exception thrown" ); + isa_ok( $component, $no_sub, "the returned value isa the component" ); + + undef $message; + $component = eval { TestAppComponent->setup_component($config) }; + ok( !$@, "setup_component doesnt die with $config" ); + is( $message, undef, "no exception thrown" ); + is_deeply( $component, \%config, "the returned config is correct" ); + + undef $message; + $component = eval { TestAppComponent->setup_component($dieing) }; + ok( !$@, "setup_component doesnt die with $dieing" ); + like( $message, qr/Could not create component/, "the exception is thrown correctly" ); + + undef $message; + $component = eval { TestAppComponent->setup_component($not_blessed) }; + ok( !$@, "setup_component doesnt die with $not_blessed" ); + isnt( $message, undef, "it throws an exception" ); + + undef $message; + $component = eval { TestAppComponent->setup_component($regular) }; + ok( !$@, "setup_component doesnt die with $regular" ); + is( $message, undef, "no exception thrown" ); + isa_ok( $component, $regular, "the returned value is correct" ); +} + +done_testing; diff --git a/t/aggregate/unit_core_component_setup_components.t b/t/aggregate/unit_core_component_setup_components.t new file mode 100644 index 0000000..ffbbb99 --- /dev/null +++ b/t/aggregate/unit_core_component_setup_components.t @@ -0,0 +1,127 @@ +use strict; +use warnings; +use Test::More; +use Moose::Meta::Class; + +Moose::Meta::Class->create( TestAppComponents => ( + superclasses => ['Catalyst'], + methods => { + locate_components => \&overriden_locate_components, + }, +)); + +TestAppComponents->components( {} ); + +# this is so TestAppComponents->container will work +TestAppComponents->setup_config; + +# this is so TestAppComponents->log->warn will work +TestAppComponents->setup_log; + +my @comps = TestAppComponents->locate_components; + +for my $component (@comps) { + Moose::Meta::Class->create( $component => ( + superclasses => ['Catalyst::Component'], + )); +} + +{ + my @loaded_comps; + my $warnings = 0; + + no warnings 'redefine', 'once'; + + local *Catalyst::Log::warn = sub { $warnings++ }; + local *Catalyst::Utils::ensure_class_loaded = sub { my $class = shift; push @loaded_comps, $class; }; + + eval { TestAppComponents->setup_components }; + + ok( !$@, "setup_components doesnt die" ); + ok( $warnings, "it warns about deprecated names" ); + + # FIXME - do I need the original sort in locate_components service? + is_deeply( [ sort @comps ], [ sort @loaded_comps ], 'all components loaded' ); +} + +my @comps_copy = @comps; + +my @controllers = map { s/^TestAppComponents::(C|Controller):://; $_; } @comps_copy[0..7]; +my @models = map { s/^TestAppComponents::(M|Model):://; $_; } @comps_copy[8..15]; +my @views = map { s/^TestAppComponents::(V|View):://; $_; } @comps_copy[16..23]; +my $container = TestAppComponents->container; + +is_deeply( + [ sort $container->get_sub_container('controller')->get_service_list ], + [ sort @controllers ], + 'controllers are in the container', +); + +is_deeply( + [ sort TestAppComponents->controllers ], + [ sort @controllers ], + 'controllers are listed correctly by $c->controllers()', +); + +is_deeply( + [ sort $container->get_sub_container('model')->get_service_list ], + [ sort @models ], + 'models are in the container', +); + +is_deeply( + [ sort TestAppComponents->models ], + [ sort @models ], + 'models are listed correctly by $c->models()', +); + +is_deeply( + [ sort $container->get_sub_container('view')->get_service_list ], + [ sort @views ], + 'views are in the container', +); + +is_deeply( + [ sort TestAppComponents->views ], + [ sort @views ], + 'views are listed correctly by $c->views()', +); + +is_deeply( + [ sort keys %{ TestAppComponents->components } ], + [ sort @comps ], + 'all components are in the components accessor' +); + +done_testing(); + +sub overriden_locate_components { + my @comps; + push @comps, "TestAppComponents::$_" for qw/ + C::Bar + C::Foo::Bar + C::Foo::Foo::Bar + C::Foo::Foo::Foo::Bar + Controller::Bar::Bar::Bar::Foo + Controller::Bar::Bar::Foo + Controller::Bar::Foo + Controller::Foo + M::Bar + M::Foo::Bar + M::Foo::Foo::Bar + M::Foo::Foo::Foo::Bar + Model::Bar::Bar::Bar::Foo + Model::Bar::Bar::Foo + Model::Bar::Foo + Model::Foo + V::Bar + V::Foo::Bar + V::Foo::Foo::Bar + V::Foo::Foo::Foo::Bar + View::Bar::Bar::Bar::Foo + View::Bar::Bar::Foo + View::Bar::Foo + View::Foo + /; + return @comps; +} diff --git a/t/aggregate/unit_core_container_applevel_config.t b/t/aggregate/unit_core_container_applevel_config.t new file mode 100644 index 0000000..9ec08a4 --- /dev/null +++ b/t/aggregate/unit_core_container_applevel_config.t @@ -0,0 +1,19 @@ +#!perl + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Test::More; +use TestAppContainer; + +my $applevel_config = TestAppContainer->container->resolve(service => 'config')->{applevel_config}; + +ok($applevel_config, 'applevel_config exists in the container'); +is($applevel_config, 'foo', 'and has the correct value'); + +$applevel_config = TestAppContainer->config->{applevel_config}; + +ok($applevel_config, 'applevel_config exists in the config accessor'); +is($applevel_config, 'foo', 'and has the correct value'); + +done_testing; diff --git a/t/aggregate/unit_core_container_custom_container.t b/t/aggregate/unit_core_container_custom_container.t new file mode 100644 index 0000000..f86ac5e --- /dev/null +++ b/t/aggregate/unit_core_container_custom_container.t @@ -0,0 +1,46 @@ +use strict; +use warnings; +use Test::More; + +# first, test if it loads Catalyst::Container when +# no custom container exists +{ + package ContainerTestApp; + use Moose; + extends 'Catalyst'; + + __PACKAGE__->setup_config(); + __PACKAGE__->setup_log(); +} + +my $container = ContainerTestApp->container; + +# 'is' instead of 'isa_ok', because I want it to be only Catalyst::Container +# and not some subclass +is( ref $container, 'Catalyst::IOC::Container', 'The container is Catalyst::IOC::Container, not a subclass'); + +# now, check if it loads the subclass when it exists +{ + package CustomContainerTestApp::Container; + use Moose; + extends 'Catalyst::IOC::Container'; + + sub my_custom_method { 1 } +} + +{ + package CustomContainerTestApp; + use Moose; + BEGIN { extends 'Catalyst' }; + + __PACKAGE__->setup_config(); +} + +$container = CustomContainerTestApp->container; + +isa_ok($container, 'CustomContainerTestApp::Container'); +isa_ok($container, 'Catalyst::IOC::Container'); +can_ok($container, 'my_custom_method'); +ok( eval { $container->my_custom_method }, 'executes the method correctly'); + +done_testing; diff --git a/t/aggregate/unit_core_container_live_auto.t b/t/aggregate/unit_core_container_live_auto.t new file mode 100644 index 0000000..be1879d --- /dev/null +++ b/t/aggregate/unit_core_container_live_auto.t @@ -0,0 +1,25 @@ +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Test::More; + +use_ok('TestAppContainer'); + +is( TestAppContainer->controller('Config')->{foo}, 'foo', 'config ok' ); + +ok( TestAppContainer->config->{cache} !~ /^__HOME__/, + 'home dir substituted in config var' +); + +is( TestAppContainer->config->{foo}, 'bar', 'app finalize_config works' ); + +my $home = TestAppContainer->config->{ home }; +my $path = join ',', + $home, TestAppContainer->path_to( 'x' ), + $home, TestAppContainer->path_to( 'y' ); +is( TestAppContainer->config->{multi}, $path, 'vars substituted in config var, twice' ); + +done_testing; diff --git a/t/aggregate/unit_core_container_mock_load.t b/t/aggregate/unit_core_container_mock_load.t new file mode 100644 index 0000000..b2af3ae --- /dev/null +++ b/t/aggregate/unit_core_container_mock_load.t @@ -0,0 +1,31 @@ +package MockApp; + +use Test::More; +use Cwd; + +# Remove all relevant env variables to avoid accidental fail +foreach my $name ( grep { m{^(CATALYST)} } keys %ENV ) { + delete $ENV{ $name }; +} + +$ENV{ CATALYST_HOME } = cwd . '/t/lib/MockAppConfigLoader'; + +use_ok( 'Catalyst' ); + +__PACKAGE__->config->{ substitutions } = { + foo => sub { shift; join( '-', @_ ); } +}; + +__PACKAGE__->setup; + +ok( my $conf = __PACKAGE__->config, 'config loads' ); +is( $conf->{ 'Controller::Foo' }->{ foo }, 'bar' ); +is( $conf->{ 'Controller::Foo' }->{ new }, 'key' ); +is( $conf->{ 'Model::Baz' }->{ qux }, 'xyzzy' ); +is( $conf->{ 'Model::Baz' }->{ another }, 'new key' ); +is( $conf->{ 'view' }, 'View::TT::New' ); +is( $conf->{ 'foo_sub' }, 'x-y' ); +is( $conf->{ 'literal_macro' }, '__DATA__', 'literal macro' ); +is( $conf->{ 'Plugin::Zot' }->{ zoot }, 'zooot'); + +done_testing; diff --git a/t/aggregate/unit_core_container_mock_load_env.t b/t/aggregate/unit_core_container_mock_load_env.t new file mode 100644 index 0000000..88c3b0b --- /dev/null +++ b/t/aggregate/unit_core_container_mock_load_env.t @@ -0,0 +1,32 @@ +package MockAppEnv; + +use Test::More; +use Cwd; + +# Remove all relevant env variables to avoid accidental fail +foreach my $name ( grep { m{^(CATALYST|MOCKAPPENV)} } keys %ENV ) { + delete $ENV{ $name }; +} + +$ENV{ CATALYST_HOME } = cwd . '/t/lib/MockAppConfigLoader'; +$ENV{ MOCKAPPENV_CONFIG } = $ENV{ CATALYST_HOME } . '/mockapp.pl'; + +use_ok( 'Catalyst' ); + +__PACKAGE__->config->{substitutions} = { + foo => sub { shift; join( '-', @_ ); } +}; + +__PACKAGE__->setup; + +ok( my $conf = __PACKAGE__->config, 'config loads' ); +is( $conf->{ 'Controller::Foo' }->{ foo }, 'bar' ); +is( $conf->{ 'Controller::Foo' }->{ new }, 'key' ); +is( $conf->{ 'Model::Baz' }->{ qux }, 'xyzzy' ); +is( $conf->{ 'Model::Baz' }->{ another }, 'new key' ); +is( $conf->{ 'view' }, 'View::TT::New' ); +is( $conf->{ 'foo_sub' }, 'x-y' ); +is( $conf->{ 'literal_macro' }, '__DATA__', 'literal macro' ); +is( $conf->{ 'environment_macro' }, $ENV{ CATALYST_HOME }.'/mockapp.pl', 'environment macro' ); + +done_testing; diff --git a/t/aggregate/unit_core_container_path_env.t b/t/aggregate/unit_core_container_path_env.t new file mode 100644 index 0000000..11e3d81 --- /dev/null +++ b/t/aggregate/unit_core_container_path_env.t @@ -0,0 +1,17 @@ +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Test::More; + +$ENV{ TESTAPPCONTAINER_CONFIG } = 'test.perl'; + +use_ok 'Catalyst::Test', 'TestAppContainer'; + +ok my ( $res, $c ) = ctx_request( '/' ), 'context object'; + +is_deeply $c->container->resolve( service => 'config_path' ), [ qw( test.perl perl ) ], 'path is "test.perl"'; + +done_testing; diff --git a/t/aggregate/unit_core_container_suffix_env.t b/t/aggregate/unit_core_container_suffix_env.t new file mode 100644 index 0000000..2390ba6 --- /dev/null +++ b/t/aggregate/unit_core_container_suffix_env.t @@ -0,0 +1,16 @@ +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Test::More; + +$ENV{ TESTAPPCONTAINER_CONFIG_LOCAL_SUFFIX } = 'test'; +use_ok 'Catalyst::Test', 'TestAppContainer'; + +ok my ( $res, $c ) = ctx_request( '/' ), 'context object'; + +is $c->container->resolve( service => 'config_local_suffix' ), 'test', 'suffix is "test"'; + +done_testing; diff --git a/t/aggregate/unit_core_mvc.t b/t/aggregate/unit_core_mvc.t index b04c3a3..2905838 100644 --- a/t/aggregate/unit_core_mvc.t +++ b/t/aggregate/unit_core_mvc.t @@ -1,29 +1,66 @@ -use Test::More tests => 51; +use Test::More; use strict; use warnings; -use_ok('Catalyst'); +{ + no warnings 'redefine'; + *Catalyst::Utils::ensure_class_loaded = sub { }; +} -my @complist = - map { "MyMVCTestApp::$_"; } - qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/; +use Moose::Meta::Class; -{ +our @complist_suffix = qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/; + +our @complist = map { "MyMVCTestApp::$_" } @complist_suffix; + +foreach my $comp (@complist) { + Moose::Meta::Class->create( + $comp => + version => '0.1', + ); +} +our $warnings = 0; +our $loaded = 0; + +Moose::Meta::Class->create('Some::Test::Object'); +Moose::Meta::Class->create( + 'MyMVCTestApp::Model::Test::Object' => + superclasses => [ 'Catalyst::Model', 'Some::Test::Object' ], +); + +{ package MyMVCTestApp; use base qw/Catalyst/; - __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @complist } ); + no warnings 'redefine'; - my $thingie={}; - bless $thingie, 'Some::Test::Object'; - __PACKAGE__->components->{'MyMVCTestApp::Model::Test::Object'} = $thingie; + local *Catalyst::IOC::Container::build_locate_components_service = sub { + my $self = shift; - # allow $c->log->warn to work - __PACKAGE__->setup_log; + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'locate_components', + block => sub { + return [@complist, 'MyMVCTestApp::Model::Test::Object']; + + }, + ); + }; + local *Catalyst::Log::warn = sub { $warnings++ }; + *Class::MOP::load_class = sub { + my $class = shift; + $loaded++ + if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestApp/ + }; + + __PACKAGE__->setup; } +ok( $warnings, 'Issues deprecated warnings' ); +is( $loaded, scalar @complist + 1, 'Loaded all components' ); + is( MyMVCTestApp->view('View'), 'MyMVCTestApp::V::View', 'V::View ok' ); is( MyMVCTestApp->controller('Controller'), @@ -65,8 +102,8 @@ is_deeply( [ sort MyMVCTestApp->models ], 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( MyMVCTestApp->view , undef, 'view() w/o a default is undef' ); + ok( $warnings, 'warnings thrown for view() w/o a default' ); } is ( bless ({stash=>{current_view=>'V'}}, 'MyMVCTestApp')->view , 'MyMVCTestApp::View::V', 'current_view ok'); @@ -82,13 +119,8 @@ is ( bless ({stash=>{current_view_instance=> $view, current_view=>'MyMVCTestApp: 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( MyMVCTestApp->model, undef, 'model() w/o a default is undef' ); + ok( $warnings, 'warnings thrown for model() w/o a default' ); } is ( bless ({stash=>{current_model=>'M'}}, 'MyMVCTestApp')->model , 'MyMVCTestApp::Model::M', 'current_model ok'); @@ -99,13 +131,85 @@ is ( bless ({stash=>{current_model_instance=> $model }}, 'MyMVCTestApp')->model 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'); +{ + use FindBin '$Bin'; + use lib "$Bin/../lib"; + + use Catalyst::Test 'TestAppController'; + + is( get('/foo/test_controller'), 'bar', 'controller() with empty args returns current controller' ); +} + +our @complist_default_view = + map { "MyMVCTestAppDefaultView::$_" } @complist_suffix; + +{ + package MyMVCTestAppDefaultView; + + use base qw/Catalyst/; + no warnings 'redefine'; + + local *Catalyst::IOC::Container::build_locate_components_service = sub { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'locate_components', + block => sub { + return \@complist_default_view; + }, + ); + }; + local *Catalyst::Log::warn = sub { $warnings++ }; + *Class::MOP::load_class = sub { + my $class = shift; + $loaded++ + if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestAppDefaultView/ + }; -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'); + __PACKAGE__->config( default_view => 'V' ); + + __PACKAGE__->setup; +} + +is( bless ({stash=>{}}, 'MyMVCTestAppDefaultView')->view, 'MyMVCTestAppDefaultView::View::V', 'default_view ok' ); +is( MyMVCTestAppDefaultView->view , 'MyMVCTestAppDefaultView::View::V', 'default_view in class method ok' ); + +our @complist_default_model = + map { "MyMVCTestAppDefaultModel::$_" } @complist_suffix; + +{ + package MyMVCTestAppDefaultModel; + + use base qw/Catalyst/; + + no warnings 'redefine'; + + local *Catalyst::IOC::Container::build_locate_components_service = sub { + my $self = shift; + + return Bread::Board::BlockInjection->new( + lifecycle => 'Singleton', + name => 'locate_components', + block => sub { + return \@complist_default_model; + }, + ); + }; + local *Catalyst::Log::warn = sub { $warnings++ }; + *Class::MOP::load_class = sub { + my $class = shift; + $loaded++ + if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestAppDefaultModel/ + }; + + __PACKAGE__->config( default_model => 'M' ); + + __PACKAGE__->setup; +} + +is( bless ({stash=>{}}, 'MyMVCTestAppDefaultModel')->model , 'MyMVCTestAppDefaultModel::Model::M', 'default_model ok' ); +is( MyMVCTestAppDefaultModel->model , 'MyMVCTestAppDefaultModel::Model::M', 'default_model in class method ok' ); # regexp behavior tests { @@ -123,13 +227,15 @@ is ( MyMVCTestApp->model , 'MyMVCTestApp::Model::M', 'default_model in class met local *Catalyst::Log::warn = sub { $warnings++ }; # object w/ regexp fallback - is_deeply( [ MyMVCTestApp->model( 'Test' ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' ); + is( MyMVCTestApp->model( 'Test' ), undef, 'no regexp fallback' ); 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'); + is( MyMVCTestApp->view('MyMVCTestApp::V::View$'), undef, 'no regexp fallback'); + + is( MyMVCTestApp->controller('MyMVCTestApp::C::Controller$'), undef, 'no regexp fallback'); + + is( MyMVCTestApp->model('MyMVCTestApp::M::Model$'), undef, 'no regexp fallback'); } { @@ -175,25 +281,6 @@ is ( MyMVCTestApp->model , 'MyMVCTestApp::Model::M', 'default_model in class met 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' ); } { @@ -201,6 +288,12 @@ is ( MyMVCTestApp->model , 'MyMVCTestApp::Model::M', 'default_model in class met use base qw/Catalyst/; + no warnings 'redefine'; + + *Class::MOP::load_class = sub { + $loaded++; + }; + __PACKAGE__->config( { disable_component_resolution_regex_fallback => 1 } ); __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @@ -223,5 +316,6 @@ is ( MyMVCTestApp->model , 'MyMVCTestApp::Model::M', 'default_model in class met # 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' ); } + +done_testing; diff --git a/t/deprecated_appclass_action_warnings.t b/t/deprecated_appclass_action_warnings.t index f25d8d5..d809349 100644 --- a/t/deprecated_appclass_action_warnings.t +++ b/t/deprecated_appclass_action_warnings.t @@ -5,14 +5,9 @@ use FindBin; use lib "$FindBin::Bin/lib"; use Test::More; -use Catalyst::Test 'DeprecatedActionsInAppClassTestApp'; -plan tests => 3; +eval 'use DeprecatedActionsInAppClassTestApp'; +ok( $@, 'application dies if it has actions'); +like( $@, qr/cannot be controllers anymore/, 'for the correct reason' ); -my $warnings; -my $logger = DeprecatedActionsInAppClassTestApp::Log->new; -Catalyst->log($logger); - -ok( my $response = request('http://localhost/foo'), 'Request' ); -ok( $response->is_success, 'Response Successful 2xx' ); -is( $DeprecatedActionsInAppClassTestApp::Log::warnings, 1, 'Get the appclass action warning' ); \ No newline at end of file +done_testing; diff --git a/t/lib/DeprecatedActionsInAppClassTestApp.pm b/t/lib/DeprecatedActionsInAppClassTestApp.pm index 9c870b0..bdf4b98 100644 --- a/t/lib/DeprecatedActionsInAppClassTestApp.pm +++ b/t/lib/DeprecatedActionsInAppClassTestApp.pm @@ -4,10 +4,6 @@ use strict; use warnings; use Catalyst; -our $VERSION = '0.01'; - -__PACKAGE__->config( name => 'DeprecatedActionsInAppClassTestApp', root => '/some/dir' ); -__PACKAGE__->log(DeprecatedActionsInAppClassTestApp::Log->new); __PACKAGE__->setup; sub foo : Local { @@ -15,16 +11,4 @@ sub foo : Local { $c->res->body('OK'); } -package DeprecatedActionsInAppClassTestApp::Log; -use strict; -use warnings; -use base qw/Catalyst::Log/; - -our $warnings; - -sub warn { - my ($self, $warning) = @_; - $warnings++ if $warning =~ /action methods .+ found defined/i; -} - 1; diff --git a/t/lib/MockAppConfigLoader/mockapp.pl b/t/lib/MockAppConfigLoader/mockapp.pl new file mode 100644 index 0000000..73d17f9 --- /dev/null +++ b/t/lib/MockAppConfigLoader/mockapp.pl @@ -0,0 +1,10 @@ +{ + name => 'TestAppContainer', + view => 'View::TT', + 'Controller::Foo' => { foo => 'bar' }, + 'Model::Baz' => { qux => 'xyzzy' }, + foo_sub => '__foo(x,y)__', + literal_macro => '__literal(__DATA__)__', + environment_macro => '__ENV(CATALYST_HOME)__/mockapp.pl', + Plugin => { Zot => { zoot => 'zooot' } }, +} diff --git a/t/lib/MockAppConfigLoader/mockapp_local.pl b/t/lib/MockAppConfigLoader/mockapp_local.pl new file mode 100644 index 0000000..81660fe --- /dev/null +++ b/t/lib/MockAppConfigLoader/mockapp_local.pl @@ -0,0 +1,5 @@ +{ + view => 'View::TT::New', + 'Controller::Foo' => { new => 'key' }, + Component => { 'Model::Baz' => { 'another' => 'new key' } }, +} diff --git a/t/lib/PluginTestApp.pm b/t/lib/PluginTestApp.pm index 29a02cd..20a5c9a 100644 --- a/t/lib/PluginTestApp.pm +++ b/t/lib/PluginTestApp.pm @@ -1,5 +1,6 @@ package PluginTestApp; use Test::More; +use base 'Catalyst'; use Catalyst ( 'Test::Plugin', diff --git a/t/lib/TestApp.pm b/t/lib/TestApp.pm index 3bd3763..1dfe999 100644 --- a/t/lib/TestApp.pm +++ b/t/lib/TestApp.pm @@ -1,19 +1,19 @@ package TestApp; +use Moose; -use strict; use Catalyst qw/ Test::MangleDollarUnderScore - Test::Errors - Test::Headers + Test::Errors + Test::Headers Test::Plugin Test::Inline +TestApp::Plugin::FullyQualified +TestApp::Plugin::AddDispatchTypes +TestApp::Role /; +extends 'Catalyst'; use Catalyst::Utils; -use Moose; use namespace::autoclean; # ----------- @@ -104,9 +104,9 @@ sub execute { # useful info if something crashes during a test sub finalize_error { my $c = shift; - + $c->next::method(@_); - + $c->res->status(500); $c->res->body( 'FATAL ERROR: ' . join( ', ', @{ $c->error } ) ); } @@ -116,7 +116,7 @@ sub finalize_error { sub Catalyst::Log::error { } } -# Make sure we can load Inline plugins. +# Make sure we can load Inline plugins. package Catalyst::Plugin::Test::Inline; diff --git a/t/lib/TestApp/Controller/Action/Forward.pm b/t/lib/TestApp/Controller/Action/Forward.pm index 062d6a1..1d3970d 100644 --- a/t/lib/TestApp/Controller/Action/Forward.pm +++ b/t/lib/TestApp/Controller/Action/Forward.pm @@ -87,7 +87,7 @@ sub embed : Local { sub class_forward_test_action : Local { my ( $self, $c ) = @_; - $c->forward(qw/TestApp class_forward_test_method/); + $c->forward(qw/TestApp::Controller::Root class_forward_test_method/); } sub forward_to_uri_check : Local { diff --git a/t/lib/TestAppComponent.pm b/t/lib/TestAppComponent.pm new file mode 100644 index 0000000..e6fb92b --- /dev/null +++ b/t/lib/TestAppComponent.pm @@ -0,0 +1,12 @@ +package TestAppComponent; +use Moose; +use Catalyst; +extends q/Catalyst/; + +{ + no warnings 'redefine'; + local *Catalyst::Log::warn = sub {}; + __PACKAGE__->setup; +} + +1; diff --git a/t/lib/TestAppComponent/C/Controller.pm b/t/lib/TestAppComponent/C/Controller.pm new file mode 100644 index 0000000..4f48381 --- /dev/null +++ b/t/lib/TestAppComponent/C/Controller.pm @@ -0,0 +1,5 @@ +package TestAppComponent::C::Controller; +use Moose; +BEGIN { extends 'Catalyst::Controller' } + +1; diff --git a/t/lib/TestAppComponent/M/Model.pm b/t/lib/TestAppComponent/M/Model.pm new file mode 100644 index 0000000..17f4dcd --- /dev/null +++ b/t/lib/TestAppComponent/M/Model.pm @@ -0,0 +1,5 @@ +package TestAppComponent::M::Model; +use Moose; +extends 'Catalyst::Model'; + +1; diff --git a/t/lib/TestAppComponent/V/View.pm b/t/lib/TestAppComponent/V/View.pm new file mode 100644 index 0000000..3d284e5 --- /dev/null +++ b/t/lib/TestAppComponent/V/View.pm @@ -0,0 +1,5 @@ +package TestAppComponent::V::View; +use Moose; +extends 'Catalyst::View'; + +1; diff --git a/t/lib/TestAppContainer.pm b/t/lib/TestAppContainer.pm new file mode 100644 index 0000000..6c4fce7 --- /dev/null +++ b/t/lib/TestAppContainer.pm @@ -0,0 +1,18 @@ +package TestAppContainer; +use Moose; +use Catalyst; +extends 'Catalyst'; + +our $VERSION = '0.01'; + +__PACKAGE__->config(applevel_config => 'foo'); + +__PACKAGE__->setup; + +sub finalize_config { + my $c = shift; + $c->config( foo => 'bar' ); + $c->next::method( @_ ); +} + +1; diff --git a/t/lib/TestAppContainer/Controller/Config.pm b/t/lib/TestAppContainer/Controller/Config.pm new file mode 100644 index 0000000..9aa70bb --- /dev/null +++ b/t/lib/TestAppContainer/Controller/Config.pm @@ -0,0 +1,8 @@ +package TestAppContainer::Controller::Config; + +use strict; +use warnings; + +use base qw( Catalyst::Controller ); + +1; diff --git a/t/lib/TestAppContainer/Controller/Root.pm b/t/lib/TestAppContainer/Controller/Root.pm new file mode 100644 index 0000000..b628056 --- /dev/null +++ b/t/lib/TestAppContainer/Controller/Root.pm @@ -0,0 +1,16 @@ +package TestAppContainer::Controller::Root; + +use strict; +use warnings; + +use base 'Catalyst::Controller'; + +__PACKAGE__->config->{namespace} = ''; + +sub default :Path { + my ( $self, $c ) = @_; + $c->response->body( 'Page not found' ); + $c->response->status(404); +} + +1; diff --git a/t/lib/TestAppContainer/testappcontainer.pl b/t/lib/TestAppContainer/testappcontainer.pl new file mode 100644 index 0000000..e3856d2 --- /dev/null +++ b/t/lib/TestAppContainer/testappcontainer.pl @@ -0,0 +1,6 @@ +{ + name => 'TestAppContainer', + 'Controller::Config' => { foo => 'foo' }, + cache => '__HOME__/cache', + multi => '__HOME__,__path_to(x)__,__HOME__,__path_to(y)__', +} diff --git a/t/lib/TestAppController.pm b/t/lib/TestAppController.pm new file mode 100644 index 0000000..8e65cf6 --- /dev/null +++ b/t/lib/TestAppController.pm @@ -0,0 +1,11 @@ +package TestAppController; +use Moose; +use namespace::autoclean; +use Catalyst; + +extends 'Catalyst'; + +__PACKAGE__->setup; +__PACKAGE__->meta->make_immutable; + +1; diff --git a/t/lib/TestAppController/Controller/Foo.pm b/t/lib/TestAppController/Controller/Foo.pm new file mode 100644 index 0000000..650793b --- /dev/null +++ b/t/lib/TestAppController/Controller/Foo.pm @@ -0,0 +1,21 @@ +package TestAppController::Controller::Foo; + +use Moose; +use namespace::autoclean; +BEGIN { extends 'Catalyst::Controller' }; + +has foo => ( + isa => 'Str', + is => 'ro', + default => 'bar', +); + +sub test_controller :Local { + my ( $self, $c ) = @_; + + $c->res->body( $c->controller->foo ); +} + +__PACKAGE__->meta->make_immutable; + +1; diff --git a/t/lib/TestAppMVCWarnings.pm b/t/lib/TestAppMVCWarnings.pm new file mode 100644 index 0000000..e0aebdf --- /dev/null +++ b/t/lib/TestAppMVCWarnings.pm @@ -0,0 +1,20 @@ +package TestAppMVCWarnings; +use Moose; +extends 'Catalyst'; +use Catalyst; + +our @log_messages; + +__PACKAGE__->config( name => 'TestAppMVCWarnings', root => '/some/dir', default_view => "DoesNotExist" ); + +__PACKAGE__->log(TestAppMVCWarnings::Log->new); + +__PACKAGE__->setup; + +package TestAppMVCWarnings::Log; +use Moose; +extends q/Catalyst::Log/; + +sub warn { push(@TestAppMVCWarnings::log_messages, @_[1..$#_]); } + +1; diff --git a/t/lib/TestAppMVCWarnings/Controller/Root.pm b/t/lib/TestAppMVCWarnings/Controller/Root.pm new file mode 100644 index 0000000..dc3b9b4 --- /dev/null +++ b/t/lib/TestAppMVCWarnings/Controller/Root.pm @@ -0,0 +1,21 @@ +package TestAppMVCWarnings::Controller::Root; +use Moose; +BEGIN { extends 'Catalyst::Controller' }; + +__PACKAGE__->config->{namespace} = ''; + +sub index :Path Args() {} + +sub model : Local { + my ($self, $c) = @_; + $c->model; # Cause model lookup and ergo warning we are testing. + $c->res->body('foo'); +} + +sub view : Local { + my ($self, $c) = @_; + $c->view; # Cause view lookup and ergo warning we are testing. + $c->res->body('bar'); +} + +1; diff --git a/t/lib/TestAppPathBug.pm b/t/lib/TestAppPathBug.pm index 74a2f27..7ae5f5b 100644 --- a/t/lib/TestAppPathBug.pm +++ b/t/lib/TestAppPathBug.pm @@ -1,9 +1,6 @@ -use strict; -use warnings; - package TestAppPathBug; -use strict; -use warnings; +use Moose; +extends 'Catalyst'; use Catalyst; our $VERSION = '0.01'; @@ -13,15 +10,9 @@ __PACKAGE__->config( name => 'TestAppPathBug', root => '/some/dir' ); __PACKAGE__->log(TestAppPathBug::Log->new); __PACKAGE__->setup; -sub foo : Path { - my ( $self, $c ) = @_; - $c->res->body( 'This is the foo method.' ); -} - package TestAppPathBug::Log; -use strict; -use warnings; -use base qw/Catalyst::Log/; +use Moose; +extends 'Catalyst::Log'; sub warn {} diff --git a/t/lib/TestAppPathBug/Controller/Root.pm b/t/lib/TestAppPathBug/Controller/Root.pm new file mode 100644 index 0000000..b28d6b3 --- /dev/null +++ b/t/lib/TestAppPathBug/Controller/Root.pm @@ -0,0 +1,14 @@ +package TestAppPathBug::Controller::Root; +use Moose; +use namespace::autoclean; + +BEGIN { extends 'Catalyst::Controller' }; + +__PACKAGE__->config(namespace => ''); + +sub foo : Path { + my ( $self, $c ) = @_; + $c->res->body( 'This is the foo method.' ); +} + +1; diff --git a/t/lib/TestAppViewWarnings.pm b/t/lib/TestAppViewWarnings.pm deleted file mode 100644 index 3a9102c..0000000 --- a/t/lib/TestAppViewWarnings.pm +++ /dev/null @@ -1,22 +0,0 @@ -use strict; -use warnings; - -package TestAppViewWarnings; - -use Catalyst; - -our @log_messages; - -__PACKAGE__->config( name => 'TestAppWarnings', root => '/some/dir', default_view => "DoesNotExist" ); - -__PACKAGE__->log(TestAppViewWarnings::Log->new); - -__PACKAGE__->setup; - -package TestAppViewWarnings::Log; - -use base qw/Catalyst::Log/; -sub warn { push(@TestAppViewWarnings::log_messages, @_[1..$#_]); } - -1; - diff --git a/t/lib/TestAppViewWarnings/Controller/Root.pm b/t/lib/TestAppViewWarnings/Controller/Root.pm deleted file mode 100644 index 6d252f8..0000000 --- a/t/lib/TestAppViewWarnings/Controller/Root.pm +++ /dev/null @@ -1,17 +0,0 @@ -package TestAppViewWarnings::Controller::Root; -use strict; -use warnings; -use base 'Catalyst::Controller'; - -__PACKAGE__->config->{namespace} = ''; - -# Return log messages from previous request -sub index :Path Args() {} - -sub end : Action { - my ($self, $c) = @_; - $c->view; # Cause view lookup and ergo warning we are testing. - $c->res->body('foo'); -} - -1; diff --git a/t/live_show_internal_actions_warnings.t b/t/live_show_internal_actions_warnings.t index 0fe6ea3..e59d5d0 100644 --- a/t/live_show_internal_actions_warnings.t +++ b/t/live_show_internal_actions_warnings.t @@ -20,6 +20,7 @@ my $last_warning; local $SIG{__WARN__} = sub { $last_warning = shift }; my $res = get('/'); } + is( $last_warning, undef, 'there should be no warnings about uninitialized value' ); done_testing;