Catalyst-Runtime-*
*.bs
t/tmp
+cover_db/
authority('MSTROUT');
all_from 'lib/Catalyst/Runtime.pm';
+requires 'Bread::Board';
requires 'List::MoreUtils';
requires 'namespace::autoclean' => '0.09';
requires 'namespace::clean' => '0.23';
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
requires 'Plack' => '0.9974'; # IIS6 fix middleware
requires 'Plack::Middleware::ReverseProxy' => '0.04';
- 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
+
+### Final steps for GSOC
+
+##### Things that work:
+
+ - the default container loads all components, calls ACCEPT_CONTEXT() when appropriate, and COMPONENT() when appropriate, behaving like current Catalyst does
+
+ - its possible to create a custom container, and override the components you want. Lifecycle, class, dependencies, all overridable.
+
+ - config files are loaded without Catalyst::Plugin::ConfigLoader
+
+ - per request life cycle somewhat works
+
+ - external modules are loaded just using a custom container, much like Catalyst::Model::Adaptor
+
+##### Things that don't work:
+
+ - expand_component_module
+
+ - Some back compat
+ - wrappers around setup_component, setup_components in Catalyst.pm
+ - $instance->expand_modules
+ - search_extra
+ - Crazy tests for things such as:
+ sub COMPONENT {
+ ...
+ *${appclass}::Model::TopLevel::GENERATED::ACCEPT_CONTEXT = sub { ... };
+ ...
+ }
+
+##### Items for discussion and planning
+# (in no particular order, just numbered to be more easily refered to)
+
+ 1) per request life cycle
+
+ 2) sugar syntax
+
+ 3) when / when not COMPONENT should be called
+
+ 4) problems when get_all_components() is called when there is no 'context' yet
+
+ 5) Back compat problems:
+ - expand_component_module
+ - $instance->expand_modules
+ - search_extra
+ - what to do when a user overrides the locate_components method?
+
+ 6) locate_components service vs setup_components method
+ - can we be more lazy?
+ - should setup_components be a service that things like the ->component lookup
+ can depend on?
+
+ 7) $class->log->warn is being used to give warnings, but maybe there is a
+ better way to do it
+
+ 8) the ConstructorInjection depends on the application_name, which probably
+ makes app/ctx split harder. We need a way to get the application instance
+ passed properly.
+
+ 9) there is a call in Catalyst::Controller to catalyst_component_name class
+ accessor (which doesn't exist anymore).
+
+ 10) make ACCEPT_CONTEXT and COMPONENT optional in Catalyst::IOC::BlockInjection and Catalyst::IOC::ConstructorInjection
+ - Create COMPONENTSingleton life cycle
+
+ 11) we build the service too early, causing the COMPONENT method to be
+ called early, breaking components which build other components (e.g.
+ Model::DBIC::Schema).
+
+ 12) root service has a very ambiguous name - maybe root_dir?
+
+ 13) should _get_component_type_name (in Catalyst::IOC::Container) exist?
+
+ 14) 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
+ - Test for component Foo => ( lifecycle => 'Singleton', class => 'My::External::Class', dependencies => { config => depends_on("config") } )
+ - Fix ^^ so that you can get your component's namespaced config nicely.
+
+ 15) Tests for using the container outside of Catalyst
+ - Custom container which adds some (very simple) services which are initialized from
+ the application config file (note plain services, not components)
+ - Depend on (and test) these inside Catalyst
+ - Test loading container outside Catalyst, and these services working
+ - Test Catalyst / MyApp is not loaded
+
+### Next steps
+
+ - Push the config built in the container back up onto the app
+
+ - Find a better way to make path_to work. Current fix is in
+ Catalyst::IOC::Container, subs build_home_service, build_root_service.
+
+ - Improve validation on the 'component' methods in Catalyst::IOC
+ (check the type of the component, etc)
+
+ - Thigs to test:
+ - Imports getting the importing package in Catalyst::IOC
+ - Back compat for Catalyst.pm moved methods (locate_components)
+ - Custom container
+ - writing some tests which verify that the models you think should be
+ there are there, and that they received their dependencies as arguments
+ - i.e. Model::Bar should get params { foo => $model_foo } when being
+ constructed, etc
+ - Need to test that if you have a standard component Frotz
+ and a customized component Fnar, and Fnar depends on Frotz
+ - And yeah, some tests that the customised components actually work via
+ $c->model('Foo'), and that COMPONENT is called (or not called)
+ as appropiate and that ACCEPT_CONTEXT is called (or not) as appropriate
+
+
+#### 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
+ # Catalyst::Model::Adaptor example
+ component Fnar => ( lifecycle => 'Singleton', class => 'My::External::Class', dependencies => { config => depends_on('config')} );
+ # ^^ FIXME - gets whole config, not Model::Foo
+ # There should be a 'nice' way to get the 'standard' config
+ };
+ # 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;
use Catalyst::Utils;
use Catalyst::Controller;
use Data::OptList;
-use Devel::InnerPackage ();
-use Module::Pluggable::Object ();
+use File::stat;
use Text::SimpleTable ();
use Path::Class::Dir ();
use Path::Class::File ();
#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_loader context_class request_class response_class stats_class
setup_finished _psgi_app loading_psgi_file run_options/;
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);
$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
$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)
=cut
-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 );
- }
-
- return $c->component( $c->action->class );
-}
+sub controller { shift->_lookup_mvc('controller', @_) }
=head2 $c->model($name)
=cut
-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( $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.' );
- }
-
- return $c->_filter_component( $comp );
-}
-
+sub model { shift->_lookup_mvc('model', @_) }
=head2 $c->view($name)
=cut
-sub view {
- my ( $c, $name, @args ) = @_;
+sub view { shift->_lookup_mvc('view', @_) }
- 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 );
- }
+sub _lookup_mvc {
+ my ( $c, $type, $name, @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_${type}_instance"};
+ return $current_instance
+ if $current_instance && $type ne 'controller';
- 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 = $type eq 'controller'
+ ? Catalyst::Utils::class2classshortsuffix($c->action->class)
+ : $c->stash->{"current_${type}"}
+ ;
}
- return $c->_filter_component( $comp );
+ return $c->container->get_component_from_sub_container($type, $name, $c, @args);
}
=head2 $c->controllers
sub controllers {
my ( $c ) = @_;
- return $c->_comp_names(qw/Controller C/);
+ return $c->container->get_sub_container('controller')->get_service_list;
}
=head2 $c->models
sub models {
my ( $c ) = @_;
- return $c->_comp_names(qw/Model M/);
+ return $c->container->get_sub_container('model')->get_service_list;
}
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)
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
sub plugin {
my ( $class, $name, $plugin, @args ) = @_;
+ # See block comment in t/aggregate/unit_core_plugin.t
# See block comment in t/unit_core_plugin.t
$class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in a future release/);
}
}
+ $class->setup_config();
$class->setup_home( delete $flags->{home} );
$class->setup_log( delete $flags->{log} );
$class->setup unless $Catalyst::__AM_RESTARTING;
}
- # Initialize our data structure
- $class->components( {} );
-
$class->setup_components;
- if ( $class->debug ) {
+ if (
+ $class->debug and
+ my $comps = $class->container->get_all_components($class)
+ ) {
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( $_ => ref($comps->{$_}) ? 'instance' : 'class' ) for keys %$comps;
- # 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;
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($class);
+}
+
=head2 $c->context_class
Returns or sets the context class.
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<locate_components> method, expands them to
-package names with the L<expand_component_module> method, and then installs
-each component into the application.
-
-The C<setup_components> config option is passed to both of the above methods.
-
-Installation of each component is performed by the L<setup_component> 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 $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 %args = %{ $class->config || {} };
- for my $component ( @comps ) {
+ my $container_class;
- # 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 } );
+ if ( exists $args{container_class} ) {
+ $container_class = delete $args{container_class};
+ Class::MOP::load_class($container_class);
}
-
- 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);
- }
+ else {
+ $container_class = Class::MOP::load_first_existing_class("${class}::Container", 'Catalyst::IOC::Container');
}
-}
-=head2 $c->locate_components( $setup_component_config )
+ my $container = $container_class->new( %args, name => $class );
+ $class->container($container);
-This method is meant to provide a list of component modules that should be
-setup for the application. By default, it will use L<Module::Pluggable>.
+ my $config = $container->resolve( service => 'config' );
+ $class->config($config);
+ $class->finalize_config; # back-compat
+}
-Specify a C<setup_components> config option to pass additional options directly
-to L<Module::Pluggable>. To add additional search paths, specify a key named
-C<search_extra> 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 } || [];
+sub finalize_config { }
- push @paths, @$extra;
-
- my $locator = Module::Pluggable::Object->new(
- search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
- %$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<locate_components> 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<locate_components> will be passed to this method, which
-is expected to return a list of component (package) names to be set up.
+The C<setup_components> 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 ) = @_;
-
- 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
=item *
-C<disable_component_resolution_regex_fallback> - 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<undef> will be returned.
-
-=item *
-
C<home> - The application home directory. In an uninstalled application,
this is the top level application directory. In an installed application,
this will be the directory containing C<< MyApp.pm >>.
=item *
-C<search_extra> - 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<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
to be shown in hit debug tables in the test server.
Andrew Ruthven
+André Walker
+
andyg: Andy Grundman <andy@hybridized.org>
audreyt: Audrey Tang
has catalyst_component_name => ( is => 'ro' ); # Cannot be required => 1 as context
# class @ISA component - HATE
-# Make accessor callable as a class method, as we need to call setup_actions
-# on the application class, which we don't have an instance of, ewwwww
-# Also, naughty modules like Catalyst::View::JSON try to write to _everything_,
+# Naughty modules like Catalyst::View::JSON try to write to _everything_,
# so spit a warning, ignore that (and try to do the right thing anyway) here..
around catalyst_component_name => sub {
my ($orig, $self) = (shift, shift);
Carp::cluck("Tried to write to the catalyst_component_name accessor - is your component broken or just mad? (Write ignored - using default value.)") if scalar @_;
- blessed($self) ? $self->$orig() || blessed($self) : $self;
+ return $self->$orig() || blessed($self);
};
sub BUILDARGS {
my $class = ref($self) || $self;
my $appclass = ref($c) || $c;
+
+ # FIXME - catalyst_component_name is no longer a class accessor, because
+ # 'MyApp as a controller' behavior is removed. But is this call to
+ # catalyst_component_name necessary, or is it always the same as $class?
+ my $component_name = ref($self) ? $self->catalyst_component_name : $self;
+
if( ref($self) ){
return $self->$orig if $self->has_action_namespace;
} else {
}
}
- my $namespace = Catalyst::Utils::class2prefix($self->catalyst_component_name, $case_s) || '';
+ my $namespace = Catalyst::Utils::class2prefix($component_name, $case_s) || '';
$self->$orig($namespace) if ref($self);
return $namespace;
};
sub _find_component {
my ( $self, $c, $component ) = @_;
- # fugly, why doesn't ->component('MyApp') work?
- return $c if ($component eq blessed($c));
-
return blessed($component)
? $component
: $c->component($component);
--- /dev/null
+package Catalyst::IOC;
+use strict;
+use warnings;
+use Bread::Board qw/depends_on/;
+use Catalyst::IOC::ConstructorInjection;
+
+use Sub::Exporter -setup => {
+ exports => [qw/
+ depends_on
+ component
+ model
+ view
+ controller
+ container
+ /],
+ groups => { default => [qw/
+ depends_on
+ component
+ model
+ view
+ controller
+ container
+ /]},
+};
+
+sub container (&) {
+ my $code = shift;
+ my $caller = caller;
+
+ no strict 'refs';
+ ${"${caller}::customise_container"} = sub {
+ local ${"${caller}::current_container"} = shift;
+ $code->();
+ };
+}
+
+sub model (&) { &_subcontainer }
+sub view (&) { &_subcontainer }
+sub controller (&) { &_subcontainer }
+
+sub _subcontainer {
+ my $code = shift;
+
+ my ( $caller, $f, $l, $subcontainer ) = caller(1);
+ $subcontainer =~ s/^Catalyst::IOC:://;
+
+ no strict 'refs';
+ local ${"${caller}::current_container"} =
+ ${"${caller}::current_container"}->get_sub_container($subcontainer);
+ $code->();
+}
+
+sub component ($;%) {
+ my ($name, %args) = @_;
+ my $current_container;
+
+ {
+ no strict 'refs';
+ my $caller = caller;
+ $current_container = ${"${caller}::current_container"};
+ }
+
+ $args{dependencies} ||= {};
+ $args{dependencies}{catalyst_application} = depends_on( '/catalyst_application' );
+
+ my $lifecycle = $args{lifecycle} || 'Singleton';
+ $args{lifecycle} = grep( m/^$lifecycle$/, qw/COMPONENTSingleton Request/ )
+ ? "+Catalyst::IOC::LifeCycle::$lifecycle"
+ : $lifecycle
+ ;
+
+ # FIXME - check $args{type} here!
+
+ my $component_name = join '::', (
+ $current_container->resolve(service => '/catalyst_application'),
+ ucfirst($current_container->name),
+ $name
+ );
+
+ $current_container->add_service(
+ Catalyst::IOC::ConstructorInjection->new(
+ %args,
+ name => $name,
+ catalyst_component_name => $component_name,
+ )
+ );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::IOC - IOC for Catalyst, based on Bread::Board
+
+=head1 SYNOPSIS
+
+ package MyApp::Container;
+ use Moose;
+ use Catalyst::IOC;
+ extends 'Catalyst::IOC::Container';
+
+ container {
+ model {
+ # default component
+ component Foo => ();
+
+ # model Bar needs model Foo to be built before
+ # and Bar's constructor gets Foo as a parameter
+ component Bar => ( dependencies => [
+ depends_on('/model/Foo'),
+ ]);
+
+ # Baz is rebuilt once per HTTP request
+ component Baz => ( lifecycle => 'Request' );
+
+ # built only once per application life time
+ component Quux => ( lifecycle => 'Singleton' );
+
+ # built once per app life time and uses an external model,
+ # outside the default directory
+ # no need for wrappers or Catalyst::Model::Adaptor
+ component Fnar => (
+ lifecycle => 'Singleton',
+ class => 'My::External::Class',
+ );
+ };
+ view {
+ component HTML => ();
+ };
+ controller {
+ component Root => ();
+ };
+ }
+
+=head1 DESCRIPTION
+
+Catalyst::IOC provides "sugar" methods to extend the behavior of the default
+Catalyst container.
+
+=head1 METHODS
+
+=head2 container
+
+Sets up the root container to be customised.
+
+=head2 model
+
+Sets up the model container to be customised.
+
+=head2 view
+
+Sets up the view container to be customised.
+
+=head2 controller
+
+Sets up the controller container to be customised.
+
+=head2 component
+
+Adds a component to the sub-container. Works like L<Bread::Board::service>.
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 SEE ALSO
+
+L<Bread::Board>
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
--- /dev/null
+package Catalyst::IOC::BlockInjection;
+use Moose;
+extends 'Bread::Board::BlockInjection';
+
+with 'Catalyst::IOC::Service::WithAcceptContext',
+ 'Catalyst::IOC::Service::WithParameters',
+ 'Bread::Board::Service::WithDependencies';
+
+has catalyst_component_name => (
+ is => 'ro',
+);
+
+__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
--- /dev/null
+package Catalyst::IOC::ConstructorInjection;
+use Moose;
+use Bread::Board::Dependency;
+use Try::Tiny;
+use Catalyst::Utils ();
+
+extends 'Bread::Board::ConstructorInjection';
+
+sub BUILD {
+ my $self = shift;
+ $self->add_dependency(
+ __catalyst_config => Bread::Board::Dependency->new(
+ service_path => '/config'
+ )
+ );
+}
+
+has catalyst_component_name => (
+ is => 'ro',
+);
+
+has config => (
+ init_arg => undef,
+ is => 'ro',
+ isa => 'HashRef',
+ writer => '_set_config',
+ clearer => '_clear_config',
+);
+
+around resolve_dependencies => sub {
+ my ($orig, $self, @args) = @_;
+ my %deps = $self->$orig(@args);
+ my $app_config = delete $deps{__catalyst_config};
+ my $conf_key = Catalyst::Utils::class2classsuffix($self->catalyst_component_name);
+ $self->_set_config($app_config->{$conf_key} || {});
+ return %deps;
+};
+
+sub get {
+ my $self = shift;
+ my $component = $self->class;
+
+ my $params = $self->params;
+ my %config = (%{ $self->config || {} }, %{ $params });
+ $self->_clear_config;
+
+ my $app = $self->param('catalyst_application');
+
+ # Stash catalyst_component_name in the config here, so that custom COMPONENT
+ # methods also pass it.
+ $config{catalyst_component_name} = $self->catalyst_component_name;
+
+ unless ( $component->can( 'COMPONENT' ) ) {
+ # FIXME - make some deprecation warnings
+ return $component;
+ }
+
+ my $instance;
+ try {
+ $instance = $component->COMPONENT( $app, \%config );
+ }
+ catch {
+ Catalyst::Exception->throw(
+ message => qq/Couldn't instantiate component "$component", "$_"/
+ );
+ };
+
+ return $instance
+ if 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)./
+ );
+}
+
+__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
--- /dev/null
+package Catalyst::IOC::Container;
+use Bread::Board qw/depends_on/;
+use Moose;
+use Config::Any;
+use Data::Visitor::Callback;
+use Catalyst::Utils ();
+use List::Util qw(first);
+use Devel::InnerPackage ();
+use Hash::Util qw/lock_hash/;
+use MooseX::Types::LoadableClass qw/ LoadableClass /;
+use Moose::Util;
+use Scalar::Util qw/refaddr/;
+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 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
+ catalyst_application
+ 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' );
+
+ # don't force default_component to be undef if the config wasn't set
+ my @default_view = $config->{default_view}
+ ? ( default_component => $config->{default_view} )
+ : ( )
+ ;
+ my @default_model = $config->{default_model}
+ ? ( default_component => $config->{default_model} )
+ : ( )
+ ;
+
+ $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_view )
+ );
+
+ $self->add_sub_container(
+ $self->build_model_subcontainer( @default_model )
+ );
+
+ {
+ no strict 'refs';
+ no warnings 'once';
+ my $class = ref $self;
+ ${ $class . '::customise_container' }->($self)
+ if ${ $class . '::customise_container' };
+ }
+}
+
+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_home_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'home',
+ block => sub {
+ my $self = shift;
+ my $class = $self->param('catalyst_application');
+ my $home;
+
+ if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
+ $home = $env;
+ }
+
+ $home ||= Catalyst::Utils::home($class);
+ return $home;
+ },
+ dependencies => [ depends_on('catalyst_application') ],
+ );
+}
+
+sub build_root_dir_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'root_dir',
+ block => sub {
+ my $self = shift;
+
+ return Path::Class::Dir->new( $self->param('home') )->subdir('root');
+ },
+ dependencies => [ depends_on('home') ],
+ );
+}
+
+sub build_catalyst_application_service {
+ my $self = shift;
+
+ return Bread::Board::Literal->new( name => 'catalyst_application', value => $self->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('catalyst_application') );
+ },
+ dependencies => [ depends_on('catalyst_application') ],
+ );
+}
+
+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('catalyst_application'), 'CONFIG' )
+ || $s->param('file')
+ || $s->param('catalyst_application')->path_to( $s->param('prefix') );
+ },
+ dependencies => [ depends_on('file'), depends_on('catalyst_application'), 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('catalyst_application'), $s->param('substitutions'), $_ );
+ }
+
+ );
+ $v->visit( $s->param('raw_config') );
+ },
+ dependencies => [ depends_on('catalyst_application'), 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('catalyst_application');
+
+ # 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('catalyst_application') ],
+ );
+}
+
+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('catalyst_application'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
+
+ return $suffix;
+ },
+ dependencies => [ depends_on('catalyst_application') ],
+ );
+}
+
+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('catalyst_application');
+ 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('catalyst_application'), depends_on('config') ],
+ );
+}
+
+sub setup_components {
+ my $self = shift;
+ my $class = $self->resolve( service => 'catalyst_application' );
+ my @comps = @{ $self->resolve( service => 'locate_components' ) };
+ my %comps = map { $_ => 1 } @comps;
+ my $deprecatedcatalyst_component_names = 0;
+
+ my $app_locate_components_addr = refaddr(
+ $class->can('locate_components')
+ );
+ my $cat_locate_components_addr = refaddr(
+ Catalyst->can('locate_components')
+ );
+
+ if ($app_locate_components_addr != $cat_locate_components_addr) {
+ # FIXME - why not just say: @comps = $class->locate_components() ?
+ $class->log->warn(qq{You have overridden locate_components. That } .
+ qq{no longer works. Please refer to the documentation to achieve } .
+ qq{similar results.\n}
+ );
+ }
+
+ 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};
+ }
+ }
+}
+
+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, $ctx, @args ) = @_;
+ my @result;
+
+ my @components = grep { m{$component} } keys %{ $self->get_all_components($ctx) };
+
+ for (@components) {
+ my ($type, $name) = _get_component_type_name($_);
+
+ push @result, $self->get_component_from_sub_container(
+ $type, $name, $ctx, @args
+ ) if $type;
+ }
+
+ return @result;
+}
+
+sub get_all_components {
+ my ($self, $class) = @_;
+ my %components;
+
+ # FIXME - if we're getting from these containers, we need to either:
+ # - pass 'ctx' and 'accept_context_args' OR
+ # - make these params optional
+ # big problem when setting up the dispatcher - this method is called
+ # as $container->get_all_components('MyApp'). What to do with Request
+ # life cycles?
+ foreach my $type (qw/model view controller /) {
+ my $container = $self->get_sub_container($type);
+
+ for my $component ($container->get_service_list) {
+ my $comp_service = $container->get_service($component);
+
+ $components{$comp_service->catalyst_component_name} = $comp_service->get(ctx => $class);
+ }
+ }
+
+ return lock_hash %components;
+}
+
+sub add_component {
+ my ( $self, $component ) = @_;
+ my ( $type, $name ) = _get_component_type_name($component);
+
+ return unless $type;
+
+ # The 'component' sub-container will create the object, and store it's
+ # instance, which, by default, will live throughout the application.
+ # The model/view/controller sub-containers only reference the instance
+ # held in the aforementioned sub-container, and execute the ACCEPT_CONTEXT
+ # sub every time they are called, when it exists.
+ my $instance_container = $self->get_sub_container('component');
+ my $accept_context_container = $self->get_sub_container($type);
+
+ # Custom containers might have added the service already
+ # We don't want to override that
+ return if $accept_context_container->has_service( $name );
+
+ my $component_service_name = "${type}_${name}";
+
+ $instance_container->add_service(
+ Catalyst::IOC::ConstructorInjection->new(
+ name => $component_service_name,
+ catalyst_component_name => $component,
+ class => $component,
+ lifecycle => 'Singleton',
+ dependencies => [
+ depends_on( '/catalyst_application' ),
+ ],
+ ),
+ );
+ # XXX - FIXME - We have to explicitly build the service here,
+ # causing the COMPONENT method to be called early here, as otherwise
+ # if the component method defines other classes (e.g. the
+ # ACCEPT_CONTEXT injection Model::DBIC::Schema does)
+ # then they won't be found by Devel::InnerPackage
+ # see also t/aggregate/unit_core_component_loading.t
+ $instance_container->get_service($component_service_name)->get;
+
+ $accept_context_container->add_service(
+ Catalyst::IOC::BlockInjection->new(
+ name => $name,
+ catalyst_component_name => $component,
+ dependencies => [
+ depends_on( "/component/$component_service_name" ),
+ ],
+ block => sub { 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 $result;
+
+ while ( !$result and (my $index = index $component, '::') > 0 ) {
+ my $type = lc substr $component, 0, $index;
+ $component = substr $component, $index + 2;
+ $result = first { $type eq $_ or $type eq substr($_, 0, 1) }
+ qw{ model view controller };
+ }
+
+ return ($result, $component);
+}
+
+sub expand_component_module {
+ my ( $class, $module ) = @_;
+ return Devel::InnerPackage::list_packages( $module );
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Container - IOC for Catalyst components
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head1 Methods for Building Containers
+
+=head2 build_component_subcontainer
+
+Container that stores all components, i.e. all models, views and controllers
+together. Each service is an instance of the actual component, and by default
+it lives while the application is running. Retrieving components from this
+sub-container will instantiate the component, if it hasn't been instantiated
+already, but will not execute ACCEPT_CONTEXT.
+
+=head2 build_model_subcontainer
+
+Container that stores references for all models that are inside the components
+sub-container. Retrieving a model triggers ACCEPT_CONTEXT, if it exists.
+
+=head2 build_view_subcontainer
+
+Same as L<build_model_subcontainer>, but for views.
+
+=head2 build_controller_subcontainer
+
+Same as L<build_model_subcontainer>, but for controllers.
+
+=head1 Methods for Building Services
+
+=head2 build_catalyst_application_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-E<gt>path_to('')>
+
+=item * C<__ENV(foo)__> - replaced with the value of C<$ENV{foo}>
+
+=item * C<__path_to(foo/bar)__> - replaced with C<$c-E<gt>path_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
+C<< <MyApp->config( 'Plugin::ConfigLoader' => { 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 look-up 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<local>, which will load C<myapp_local.conf>. 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<local> in the
+name of the local config file to be loaded.
+
+For example, if C< $ENV{ MYAPP_CONFIG_LOCAL_SUFFIX }> is set to C<testing>,
+ConfigLoader will try and load C<myapp_testing.conf> instead of
+C<myapp_local.conf>.
+
+=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<Module::Pluggable>.
+
+Specify a C<setup_components> config option to pass additional options directly
+to L<Module::Pluggable>.
+
+=head1 Other methods
+
+=head2 get_component_from_sub_container($sub_container, $name, $c, @args)
+
+Looks for components in a given sub-container (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_all_components
+
+Fetches all the components, in each of the sub_containers model, view and
+controller, and returns a read-only 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 sub-container. The sub-container is guessed
+by the component name given.
+
+=head2 find_component
+
+Searches for components in all containers. If $component is the full class
+name, the sub-container is guessed, and it gets the searched component in there.
+Otherwise, it looks for a component with that name in all sub-containers. If
+$component is a regexp it calls _find_component_regexp and matches all
+components against that regexp.
+
+=head2 expand_component_module
+
+Components found by C<locate_components> will be passed to this method, which
+is expected to return a list of component (package) names to be set up.
+
+=head2 setup_components
+
+Uses locate_components service to list the components, and adds them to the
+appropriate sub-containers, using add_component().
+
+=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
--- /dev/null
+package Catalyst::IOC::LifeCycle::Request;
+use Moose::Role;
+use namespace::autoclean;
+with 'Bread::Board::LifeCycle';
+
+around get => sub {
+ my $orig = shift;
+ my $self = shift;
+ my $params = {@_};
+
+ my $ctx = exists $params->{ctx} && ref $params->{ctx}
+ ? $params->{ctx}
+ : undef
+ ;
+
+ # FIXME - this makes absolutely no sense
+ # dispatcher wants the object (through container->get_all_components)
+ # but doesn't have the context. Builder *needs* the context!!
+ # What to do???
+ return $self->$orig(@_) unless $ctx;
+
+ my $stash_key = "__Catalyst_IOC_LifeCycle_Request_" . $self->name;
+ return $ctx->stash->{$stash_key} ||= $self->$orig(@_);
+};
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::IOC::LifeCycle::Request - Components that last for one request
+
+=head1 SYNOPSIS
+
+=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
--- /dev/null
+package Catalyst::IOC::Service::WithAcceptContext;
+use Moose::Role;
+
+has accept_context_sub => (
+ is => 'ro',
+ isa => 'Str',
+ default => 'ACCEPT_CONTEXT',
+);
+
+around get => sub {
+ my $orig = shift;
+ my $self = shift;
+
+ my $accept_context_args = $self->param('accept_context_args');
+ my $ac_sub = $self->accept_context_sub;
+
+ my $instance = $self->$orig(@_);
+
+ if ( $accept_context_args && $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
--- /dev/null
+package Catalyst::IOC::Service::WithParameters;
+use Moose::Role;
+
+with 'Bread::Board::Service::WithParameters' => { excludes => '_build_parameters' };
+
+# FIXME - shouldn't this be merged with WithAcceptContext?
+
+sub _build_parameters {
+ {
+ ctx => {
+ required => 1,
+ },
+ accept_context_args => {
+ isa => 'ArrayRef',
+ default => [],
+ }
+ };
+}
+
+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
--- /dev/null
+package Catalyst::IOC::SubContainer;
+use Bread::Board;
+use Moose;
+
+extends 'Bread::Board::Container';
+
+has default_component => (
+ isa => 'Str|Undef',
+ is => 'ro',
+ builder => '_build_default_component',
+ lazy => 1,
+);
+
+sub _build_default_component {
+ my ( $self ) = @_;
+
+ my @complist = $self->get_service_list;
+
+ scalar @complist == 1 ? $complist[0] : undef;
+}
+
+
+sub get_component {
+ my ( $self, $name, $ctx, @args ) = @_;
+
+ return $self->resolve(
+ service => $name,
+ parameters => {
+ accept_context_args => [ $ctx, @args ],
+ ctx => $ctx,
+ },
+ );
+}
+
+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;
+}
+
+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
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.
--- /dev/null
+use warnings;
+use strict;
+use FindBin '$Bin';
+use lib "$Bin/../lib";
+use Test::More;
+
+BEGIN {
+ if ( $ENV{CATALYST_SERVER} ) {
+ plan skip_all => 'This test does not run live';
+ exit 0;
+ }
+}
+use TestCustomContainer;
+
+TestCustomContainer->new(sugar => 0);
--- /dev/null
+use warnings;
+use strict;
+use FindBin '$Bin';
+use lib "$Bin/../lib";
+use Test::More;
+
+BEGIN {
+ if ( $ENV{CATALYST_SERVER} ) {
+ plan skip_all => 'This test does not run live';
+ exit 0;
+ }
+}
+
+use TestCustomContainer;
+
+TestCustomContainer->new(sugar => 1);
--- /dev/null
+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;
+
+++ /dev/null
-#!perl
-
-use strict;
-use warnings;
-no warnings 'once';
-
-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;
-
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,
-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 results 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' );
}
{
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;
-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;
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;
-use Test::More tests => 6;
+use Test::More;
use strict;
use warnings;
use lib 't/lib';
is($model_foo->model_quux_method, 'chunkybacon', 'Model method getting $self->{quux} from config');
+done_testing;
-# 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;
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) {
);
}
-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";
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 we need a much better way of components being able to generate
+# sub-components of themselves (e.g. bring back expand_component_modules?)
+# as otherwise we _have_ to construct / call the COMPONENT method
+# explicitly to get all the sub-components built for Devel::InnerPackage
+# to find them. See FIXME in Catalyst::IOC::Container
+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";
isa_ok($appclass->controller('Test'), 'Catalyst::Controller');
rmtree($libdir);
+
+done_testing;
-use Test::More tests => 1;
+use Test::More;
use strict;
use warnings;
like($warn, qr/after Catalyst::Component in MyApp::Component/,
'correct warning thrown');
+done_testing;
--- /dev/null
+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;
--- /dev/null
+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;
+}
--- /dev/null
+#!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');
+
+my $home = TestAppContainer->container->resolve(service => 'config')->{home};
+ok( $home );
+
+$home = TestAppContainer->config->{home};
+ok( $home );
+
+done_testing;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
-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;
+
+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++ };
+
+ __PACKAGE__->setup;
}
+ok( $warnings, 'Issues deprecated warnings' );
+is( @{[ MyMVCTestApp->component_list ]}, scalar @complist + 1, 'Loaded all components' );
+
is( MyMVCTestApp->view('View'), 'MyMVCTestApp::V::View', 'V::View ok' );
is( MyMVCTestApp->controller('Controller'),
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');
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');
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++ };
+
+ __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++ };
+
+ __PACKAGE__->config( default_model => 'M' );
-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__->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
{
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');
}
{
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' );
}
{
use base qw/Catalyst/;
+ no warnings 'redefine';
+
__PACKAGE__->config( { disable_component_resolution_regex_fallback => 1 } );
__PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) }
# 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;
add_stopwords(qw(
API CGI MVC PSGI Plack README SSI Starman XXXX URI htaccess middleware
mixins namespace psgi startup Deprecations catamoose cataplack linearize
- subclasses subdirectories refactoring adaptors
+ subclasses subdirectories refactoring adaptors ConfigLoader json xml
+ IOC conf myapp customised
undef env regex unary rethrow rethrows stringifies CPAN STDERR SIGCHLD baz
roadmap wishlist refactor refactored Runtime pluggable pluggability hoc apis
fastcgi nginx Lighttpd IIS middlewares backend IRC
filename tempname request's subdirectory ini uninstalled uppercased
wiki bitmask uri url urls dir hostname proxied http https IP SSL
inline INLINE plugins
+ André
Andreas
Ashton
Axel
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;
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 {
$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;
--- /dev/null
+{
+ 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' } },
+}
--- /dev/null
+{
+ view => 'View::TT::New',
+ 'Controller::Foo' => { new => 'key' },
+ Component => { 'Model::Baz' => { 'another' => 'new key' } },
+}
package PluginTestApp;
use Test::More;
+use base 'Catalyst';
use Catalyst (
'Test::Plugin',
package TestApp;
-use strict;
+use Moose;
+
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;
# -----------
# 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 } ) );
}
return $c->maybe::next::method(@_);
}
-# Make sure we can load Inline plugins.
+# Make sure we can load Inline plugins.
package Catalyst::Plugin::Test::Inline;
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 {
--- /dev/null
+package TestAppComponent;
+use Moose;
+use Catalyst;
+extends q/Catalyst/;
+
+{
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub {};
+ __PACKAGE__->setup;
+}
+
+1;
--- /dev/null
+package TestAppComponent::C::Controller;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+
+1;
--- /dev/null
+package TestAppComponent::M::Model;
+use Moose;
+extends 'Catalyst::Model';
+
+1;
--- /dev/null
+package TestAppComponent::V::View;
+use Moose;
+extends 'Catalyst::View';
+
+1;
--- /dev/null
+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;
--- /dev/null
+package TestAppContainer::Controller::Config;
+
+use strict;
+use warnings;
+
+use base qw( Catalyst::Controller );
+
+1;
--- /dev/null
+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;
--- /dev/null
+{
+ name => 'TestAppContainer',
+ 'Controller::Config' => { foo => 'foo' },
+ cache => '__HOME__/cache',
+ multi => '__HOME__,__path_to(x)__,__HOME__,__path_to(y)__',
+}
--- /dev/null
+package TestAppController;
+use Moose;
+use namespace::autoclean;
+use Catalyst;
+
+extends 'Catalyst';
+
+__PACKAGE__->setup;
+__PACKAGE__->meta->make_immutable;
+
+1;
--- /dev/null
+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;
--- /dev/null
+package TestAppCustomContainer;
+use Moose;
+use Catalyst;
+extends 'Catalyst';
+use namespace::autoclean;
+
+confess("No default container") unless $ENV{TEST_APP_CURRENT_CONTAINER};
+
+__PACKAGE__->config(
+ container_class => $ENV{TEST_APP_CURRENT_CONTAINER}
+);
+
+__PACKAGE__->setup;
+
+1;
--- /dev/null
+package TestAppCustomContainer::Controller::Root;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+
+__PACKAGE__->config(namespace => '');
+
+sub index : Default {
+ my ($self, $c) = @_;
+ $c->res->body('foo');
+}
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+1;
--- /dev/null
+package TestAppCustomContainer::External::Class;
+use Moose;
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
--- /dev/null
+package TestAppCustomContainer::Model::DefaultSetup;
+use Moose;
+extends 'Catalyst::Model';
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+1;
--- /dev/null
+package TestAppCustomContainer::Model::DependsOnDefaultSetup;
+use Moose;
+extends 'Catalyst::Model';
+#with 'TestAppCustomContainer::Role::HoldsFoo';
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+1;
+
--- /dev/null
+package TestAppCustomContainer::Model::RequestLifeCycle;
+use Moose;
+extends 'Catalyst::Model';
+with 'TestAppCustomContainer::Role::ACCEPT_CONTEXT';
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+1;
--- /dev/null
+package TestAppCustomContainer::Model::SingletonLifeCycle;
+use Moose;
+extends 'Catalyst::Model';
+with 'TestAppCustomContainer::Role::FailIfACCEPT_CONTEXTCalled';
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+1;
--- /dev/null
+package TestAppCustomContainer::NoSugarContainer;
+use Moose;
+use namespace::autoclean;
+use Catalyst::IOC;
+
+extends 'Catalyst::IOC::Container';
+
+sub BUILD {
+ my $self = shift;
+
+ $self->get_sub_container('model')->add_service(
+ Catalyst::IOC::ConstructorInjection->new(
+ name => 'SingletonLifeCycle',
+ lifecycle => 'Singleton',
+ class => 'TestAppCustomContainer::Model::SingletonLifeCycle',
+ catalyst_component_name => 'TestAppCustomContainer::Model::SingletonLifeCycle',
+ dependencies => {
+ catalyst_application => depends_on( '/catalyst_application' ),
+ },
+ )
+ );
+
+ $self->get_sub_container('model')->add_service(
+ Catalyst::IOC::ConstructorInjection->new(
+ name => 'RequestLifeCycle',
+ lifecycle => '+Catalyst::IOC::LifeCycle::Request',
+ class => 'TestAppCustomContainer::Model::RequestLifeCycle',
+ catalyst_component_name => 'TestAppCustomContainer::Model::RequestLifeCycle',
+ dependencies => {
+ catalyst_application => depends_on( '/catalyst_application' ),
+ },
+ )
+ );
+
+# $self->get_sub_container('model')->add_service(
+# Catalyst::IOC::ConstructorInjection->new(
+# name => 'DependsOnDefaultSetup',
+# class => 'TestAppCustomContainer::Model::DependsOnDefaultSetup',
+# catalyst_component_name => 'TestAppCustomContainer::Model::DependsOnDefaultSetup',
+# dependencies => {
+# catalyst_application => depends_on( '/catalyst_application' ),
+# # FIXME - this is what is blowing up everything:
+# # DefaultSetup needs the context. It's not getting it here!
+# foo => depends_on('/model/DefaultSetup'),
+# },
+# )
+# );
+
+# Broken deps!?!
+# $self->get_sub_container('model')->add_service(
+# Catalyst::IOC::BlockInjection->new(
+# name => 'Quux',
+# lifecycle => 'Singleton',
+# dependencies => [
+# depends_on( '/component/model_Quux' ),
+# ],
+# block => sub { shift->param('model_Bar') },
+# )
+# );
+
+# my $fnar_config = $self->resolve(service => 'config')->{'Model::Fnar'} || {};
+# $self->get_sub_container('component')->add_service(
+# Catalyst::IOC::ConstructorInjection->new(
+# name => 'model_Fnar',
+# lifecycle => 'Singleton',
+# class => 'TestAppCustomContainer::External::Class',
+# dependencies => [
+# depends_on( '/catalyst_application' ),
+# ],
+# config => $fnar_config,
+# )
+# );
+# $self->get_sub_container('model')->add_service(
+# Catalyst::IOC::BlockInjection->new(
+# name => 'model_Fnar',
+# lifecycle => 'Singleton',
+# dependencies => [
+# depends_on( '/config' ),
+# depends_on( '/component/model_Fnar' ),
+# ],
+# block => sub { shift->param('model_Fnar') },
+# )
+# );
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
--- /dev/null
+package TestAppCustomContainer::Role::ACCEPT_CONTEXT;
+use Moose::Role;
+use namespace::autoclean;
+
+has accept_context_called => (
+ traits => ['Counter'],
+ isa => 'Int',
+ is => 'ro',
+ default => 0,
+ handles => {
+ inc_accept_context_called => 'inc',
+ },
+);
+
+sub ACCEPT_CONTEXT {}
+
+around ACCEPT_CONTEXT => sub {
+ my ( $orig, $self, $ctx, @args ) = @_;
+
+ $self->inc_accept_context_called;
+
+ return $self->$orig() || $self;
+};
+
+1;
--- /dev/null
+package TestAppCustomContainer::Role::FailIfACCEPT_CONTEXTCalled;
+use Moose::Role;
+use Test::More;
+
+sub ACCEPT_CONTEXT {}
+before ACCEPT_CONTEXT => sub {
+ my ($self, $ctx, @args) = @_;
+ fail("ACCEPT_CONTEXT called for $self");
+};
+
+1;
--- /dev/null
+package TestAppCustomContainer::Role::HoldsFoo;
+use Moose::Role;
+use Test::More;
+use namespace::autoclean;
+
+has foo => (
+ is => 'ro',
+# isa => 'TestAppCustomContainer::Model::Foo',
+# required => 1,
+);
+
+sub BUILD {}
+
+after BUILD => sub {
+ my $self = shift;
+ ok($self->foo, ref($self) . " got a ->foo");
+ isa_ok($self->foo, 'TestAppCustomContainer::Model::DefaultSetup', ref($self) . " isa 'TestAppCustomContainer::Model::DefaultSetup'");
+};
+
+1;
--- /dev/null
+package TestAppCustomContainer::SugarContainer;
+use Moose;
+use namespace::autoclean;
+use Catalyst::IOC;
+extends 'Catalyst::IOC::Container';
+
+container {
+ model {
+ component 'SingletonLifeCycle' => (
+ class => 'TestAppCustomContainer::Model::SingletonLifeCycle',
+ lifecycle => 'Singleton',
+ );
+ component 'RequestLifeCycle' => (
+ class => 'TestAppCustomContainer::Model::RequestLifeCycle',
+ lifecycle => 'Request',
+ );
+ };
+};
+
+__PACKAGE__->meta->make_immutable;
+
+1;
--- /dev/null
+package TestAppCustomContainer::View::MyView;
+use Moose;
+extends 'Catalyst::View';
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+1;
--- /dev/null
+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;
--- /dev/null
+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;
package TestAppOneView;
-use strict;
-use warnings;
+use Moose;
use Catalyst;
+extends 'Catalyst';
__PACKAGE__->setup;
-use strict;
-use warnings;
-
package TestAppPathBug;
-use strict;
-use warnings;
+use Moose;
+extends 'Catalyst';
use Catalyst;
our $VERSION = '0.01';
__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 {}
--- /dev/null
+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;
+++ /dev/null
-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;
-
+++ /dev/null
-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;
--- /dev/null
+package TestCustomContainer;
+use Moose;
+use namespace::autoclean;
+use Test::More;
+
+has app_name => (
+ is => 'ro',
+ isa => 'Str',
+ default => 'TestAppCustomContainer',
+);
+
+has container_class => (
+ is => 'ro',
+ isa => 'Str',
+ lazy_build => 1,
+);
+
+has sugar => (
+ is => 'ro',
+ isa => 'Int',
+);
+
+# Reason for this class:
+# I wanted have a set of tests that would test both the sugar version of the
+# container, as the sugar-less. I figured I shouldn't just copy and paste
+# the tests. So after struggling for hours to find a way to test twice
+# against the same TestApp using only one file, I decided to break it
+# into a separate class (this one), and call it at
+# - live_container_custom_container_sugar.t and
+# - live_container_custom_container_nosugar.t
+# setting only the sugar attribute.
+
+sub BUILD {
+ my $self = shift;
+ my $app = $self->app_name;
+
+ $ENV{TEST_APP_CURRENT_CONTAINER} = $self->container_class;
+
+ require Catalyst::Test;
+ Catalyst::Test->import($app);
+
+ is($app->config->{container_class}, $self->container_class, 'config is set properly');
+ isa_ok($app->container, $self->container_class, 'and container isa our container class');
+
+ # RequestLifeCycle
+ {
+ # just to be sure the app is not broken
+ ok(my ($res, $ctx) = ctx_request('/'), 'request');
+ ok($res->is_success, 'request 2xx');
+ is($res->content, 'foo', 'content is expected');
+
+ ok(my $model = $ctx->container->get_sub_container('model')->resolve(service => 'RequestLifeCycle', parameters => { ctx => $ctx, accept_context_args => [$ctx] } ), 'fetching RequestLifeCycle');
+ isa_ok($model, 'TestAppCustomContainer::Model::RequestLifeCycle');
+
+ ok(my $model2 = $ctx->model('RequestLifeCycle'), 'fetching RequestLifeCycle again');
+ is($model, $model2, 'object is not recreated during the same request');
+
+ # another request
+ my ($res2, $ctx2) = ctx_request('/');
+ ok($model2 = $ctx2->model('RequestLifeCycle'), 'fetching RequestLifeCycle again');
+ isnt($model, $model2, 'object is recreated in a different request');
+ }
+
+ # SingletonLifeCycle
+ {
+ # already tested, I only need the $ctx
+ my ($res, $ctx) = ctx_request('/');
+
+ ok(my $model = $ctx->container->get_sub_container('model')->resolve(service => 'SingletonLifeCycle', parameters => { ctx => $ctx, accept_context_args => [$ctx] } ), 'fetching SingletonLifeCycle');
+ isa_ok($model, 'TestAppCustomContainer::Model::SingletonLifeCycle');
+
+ ok(my $model2 = $ctx->model('SingletonLifeCycle'), 'fetching SingletonLifeCycle again');
+ is($model, $model2, 'object is not recreated during the same request');
+
+ # another request
+ my ($res2, $ctx2) = ctx_request('/');
+ ok($model2 = $ctx2->model('SingletonLifeCycle'), 'fetching SingletonLifeCycle again');
+ is($model, $model2, 'object is not recreated in a different request');
+ }
+
+ done_testing;
+}
+
+sub _build_container_class {
+ my $self = shift;
+
+ my $sugar = $self->sugar ? '' : 'No';
+
+ return $self->app_name . "::${sugar}SugarContainer";
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
local $SIG{__WARN__} = sub { $last_warning = shift };
my $res = get('/');
}
+
is( $last_warning, undef, 'there should be no warnings about uninitialized value' );
done_testing;
projects / catagits/Catalyst-Runtime.git / commitdiff