Catalyst-Runtime-*
*.bs
t/tmp
+cover_db/
name 'Catalyst-Runtime';
all_from 'lib/Catalyst/Runtime.pm';
+requires 'Bread::Board';
requires 'List::MoreUtils';
requires 'namespace::autoclean' => '0.09';
requires 'namespace::clean' => '0.13';
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
+
+ - sugar is still not completely implemented
+
+ - Some back compat
+ - wrappers around setup_component, setup_components, locate_components in Catalyst.pm
+ - $instance->expand_modules
+ - search_extra
+ - Crazy tests for things such as:
+ sub COMPONENT {
+ ...
+ *${appclass}::Model::TopLevel::GENERATED::ACCEPT_CONTEXT = sub { ... };
+ ...
+ }
+
+##### Need planning, have questions:
+
+ - per request life cycle
+
+ - sugar - we should discuss the syntax with rafl and edenc
+
+ - when / when not COMPONENT should be called
+
+ - 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?
+
+ - There are a few more FIXMEs, idk if any relevant here
+
+### Next steps - planned:
+
+ - some imports need to get the importing package in Catalyst::IOC
+ - done - needs testing
+
+ - Back compat for Catalyst.pm moved methods (locate_components)
+ - done - needs testing
+
+ - Test 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
+
+### Next steps - less planned:
+
+ - make ACCEPT_CONTEXT and COMPONENT optional in Catalyst::IOC::BlockInjection and Catalyst::IOC::ConstructorInjection
+ - Create COMPONENTSingleton life cycle
+
+ - Creating service()-like sugar for component
+
+ - Test cases for extending the container in an application.
+ - Using the sugar added in the previous item
+ - Test when Model::Foo depends_on Model::Bar
+ - 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.
+
+ - 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
+
+#### 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
+ conponent 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($_)
+<<<<<<< HEAD
+ for qw/container arguments dispatcher engine log dispatcher_class
+ engine_class context_class request_class response_class stats_class
+ setup_finished/;
+=======
for qw/components arguments dispatcher engine log dispatcher_class
engine_loader context_class request_class response_class stats_class
setup_finished _psgi_app loading_psgi_file/;
+>>>>>>> master
__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
__PACKAGE__->request_class('Catalyst::Request');
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 );
- }
-
- 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};
+sub _lookup_mvc {
+ my ( $c, $type, $name, @args ) = @_;
- 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/unit_core_plugin.t
+ # See block comment in t/aggregate/unit_core_plugin.t
$class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
$class->_register_plugin( $plugin, 1 );
}
}
+ $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;
-
- for my $component ( @comps ) {
+ my %args = %{ $class->config || {} };
- # We pass ignore_loaded here so that overlay files for (e.g.)
- # Model::DBI::Schema sub-classes are loaded - if it's in @comps
- # we know M::P::O found a file on disk so this is safe
+ my $container_class;
- 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, application_name => "$class", 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;
- }
+# FIXME - removed locate_components
+# don't people mess with this method directly?
+# what to do with that?
- 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;
-
- my $instance = eval { $component->COMPONENT( $class, $config ); };
+sub locate_components {
+ my $class = shift;
- if ( my $error = $@ ) {
- chomp $error;
- Catalyst::Exception->throw(
- message => qq/Couldn't instantiate component "$component", "$error"/
- );
- }
+ $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.');
- 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;
+no strict 'refs';
+
+# FIXME - All of these imports need to get the importing package
+# as the customise_container and current_container variables
+# NEED to be in the containers package so there can be multiple
+# containers..
+use Sub::Exporter -setup => {
+ exports => [qw/
+ depends_on
+ component
+ model
+ container
+ /],
+ groups => { default => [qw/
+ depends_on
+ component
+ model
+ container
+ /]},
+};
+#use Sub::Exporter -setup => [
+# qw(
+# Bread::Board::as
+# Bread::Board::container
+# Bread::Board::depends_on
+# Bread::Board::service
+# Bread::Board::alias
+# Bread::Board::wire_names
+# Bread::Board::include
+# Bread::Board::typemap
+# Bread::Board::infer
+# )
+#];
+# I'm probably doing it wrong.
+# Anyway, I'll just use Moose::Exporter. Do I really have to use Sub::Exporter?
+#use Moose::Exporter;
+#Moose::Exporter->setup_import_methods(
+# also => ['Bread::Board'],
+#);
+sub container (&) {
+ my $code = shift;
+ my $caller = caller;
+ ${"${caller}::customise_container"} = sub {
+ warn("In customise container");
+ local ${"${caller}::current_container"} = shift;
+ $code->();
+ };
+}
+
+sub model (&) {
+ my $code = shift;
+ my $caller = caller;
+ local ${"${caller}::current_container"} = ${"${caller}::current_container"}->get_sub_container('model');
+ $code->();
+}
+
+sub component {
+ my ($name, %args) = @_;
+ my $caller = caller;
+ $args{dependencies} ||= {};
+ $args{dependencies}{application_name} = depends_on( '/application_name' );
+
+ my $lifecycle = $args{lifecycle};
+ my %catalyst_lifecycles = map { $_ => 1 } qw/ COMPONENTSingleton Request /;
+ $args{lifecycle} = $lifecycle
+ ? $catalyst_lifecycles{$lifecycle} ? "+Catalyst::IOC::LifeCycle::$lifecycle" : $lifecycle
+ : 'Singleton'
+ ;
+
+ # FIXME - check $args{type} here!
+
+ my $component_name = join '::', (
+ ${"${caller}::current_container"}->resolve(service => '/application_name'),
+ ucfirst(${"${caller}::current_container"}->name),
+ $name
+ );
+
+ my $service = Catalyst::IOC::ConstructorInjection->new(
+ %args,
+ name => $name,
+ catalyst_component_name => $component_name,
+ );
+ ${"${caller}::current_container"}->add_service($service);
+}
+
+1;
+
+# FIXME - should the code example below be on this file or Catalyst::IOC::Container?
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::IOC - IOC for Catalyst, based on Bread::Board
+
+=head1 SYNOPSIS
+
+ package MyApp::Container;
+ use Catalyst::IOC;
+
+ sub BUILD {
+ my $self = shift;
+
+ container $self => as {
+ container model => as {
+
+ # 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',
+ );
+ };
+ }
+ }
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=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'));
+ warn("Added dependency for config in " . $self->class);
+}
+
+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);
+# use Data::Dumper;
+# warn("$self Resolve deps" . Data::Dumper::Dumper(\%deps));
+ 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;
+ warn("In get $component");
+
+ my $params = $self->params;
+ my %config = (%{ $self->config || {} }, %{ $params });
+# warn(Data::Dumper::Dumper(\%config));
+ $self->_clear_config;
+
+ # FIXME - Is depending on the application name to pass into constructors here a good idea?
+ # This makes app/ctx split harder I think.. Need to think more here, but I think
+ # we want to pass the application in as a parameter when building the service
+ # rather than depending on the app name, so that later, when the app becomes an instance
+ # then it'll get passed in, and components can stash themselves 'per app instance'
+ my $app_name = $self->param('application_name');
+
+ # 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_name, \%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;
+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 application_name => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has sub_container_class => (
+ isa => LoadableClass,
+ is => 'ro',
+ coerce => 1,
+ default => 'Catalyst::IOC::SubContainer',
+ handles => {
+ new_sub_container => 'new',
+ }
+);
+
+sub BUILD {
+ my ( $self, $params ) = @_;
+
+ $self->add_service(
+ $self->${\"build_${_}_service"}
+ ) for qw/
+ substitutions
+ file
+ driver
+ application_name
+ prefix
+ extensions
+ path
+ config
+ raw_config
+ global_files
+ local_files
+ global_config
+ local_config
+ class_config
+ config_local_suffix
+ config_path
+ locate_components
+ /;
+
+ my $config = $self->resolve( service => 'config' );
+
+ # 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;
+ warn("In build $class");
+ ${ $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_application_name_service {
+ my $self = shift;
+
+ return Bread::Board::Literal->new( name => 'application_name', value => $self->application_name );
+}
+
+sub build_driver_service {
+ my $self = shift;
+
+ return Bread::Board::Literal->new( name => 'driver', value => $self->driver );
+}
+
+sub build_file_service {
+ my $self = shift;
+
+ return Bread::Board::Literal->new( name => 'file', value => $self->file );
+}
+
+sub build_substitutions_service {
+ my $self = shift;
+
+ return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions );
+}
+
+sub build_extensions_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'extensions',
+ block => sub {
+ return \@{Config::Any->extensions};
+ },
+ );
+}
+
+sub build_prefix_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'prefix',
+ block => sub {
+ return Catalyst::Utils::appprefix( shift->param('application_name') );
+ },
+ dependencies => [ depends_on('application_name') ],
+ );
+}
+
+sub build_path_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'path',
+ block => sub {
+ my $s = shift;
+
+ return Catalyst::Utils::env_value( $s->param('application_name'), 'CONFIG' )
+ || $s->param('file')
+ || $s->param('application_name')->path_to( $s->param('prefix') );
+ },
+ dependencies => [ depends_on('file'), depends_on('application_name'), depends_on('prefix') ],
+ );
+}
+
+sub build_config_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'config',
+ block => sub {
+ my $s = shift;
+
+ my $v = Data::Visitor::Callback->new(
+ plain_value => sub {
+ return unless defined $_;
+ return $self->_config_substitutions( $s->param('application_name'), $s->param('substitutions'), $_ );
+ }
+
+ );
+ $v->visit( $s->param('raw_config') );
+ },
+ dependencies => [ depends_on('application_name'), depends_on('raw_config'), depends_on('substitutions') ],
+ );
+}
+
+sub build_raw_config_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'raw_config',
+ block => sub {
+ my $s = shift;
+
+ my @global = @{$s->param('global_config')};
+ my @locals = @{$s->param('local_config')};
+
+ my $config = $s->param('class_config');
+
+ for my $cfg (@global, @locals) {
+ for (keys %$cfg) {
+ $config = Catalyst::Utils::merge_hashes( $config, $cfg->{$_} );
+ }
+ }
+
+ return $config;
+ },
+ dependencies => [ depends_on('global_config'), depends_on('local_config'), depends_on('class_config') ],
+ );
+}
+
+sub build_global_files_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'global_files',
+ block => sub {
+ my $s = shift;
+
+ my ( $path, $extension ) = @{$s->param('config_path')};
+
+ my @extensions = @{$s->param('extensions')};
+
+ my @files;
+ if ( $extension ) {
+ die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
+ push @files, $path;
+ } else {
+ @files = map { "$path.$_" } @extensions;
+ }
+ return \@files;
+ },
+ dependencies => [ depends_on('extensions'), depends_on('config_path') ],
+ );
+}
+
+sub build_local_files_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'local_files',
+ block => sub {
+ my $s = shift;
+
+ my ( $path, $extension ) = @{$s->param('config_path')};
+ my $suffix = $s->param('config_local_suffix');
+
+ my @extensions = @{$s->param('extensions')};
+
+ my @files;
+ if ( $extension ) {
+ die "Unable to handle files with the extension '${extension}'" unless grep { $_ eq $extension } @extensions;
+ $path =~ s{\.$extension}{_$suffix.$extension};
+ push @files, $path;
+ } else {
+ @files = map { "${path}_${suffix}.$_" } @extensions;
+ }
+ return \@files;
+ },
+ dependencies => [ depends_on('extensions'), depends_on('config_path'), depends_on('config_local_suffix') ],
+ );
+}
+
+sub build_class_config_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'class_config',
+ block => sub {
+ my $s = shift;
+ my $app = $s->param('application_name');
+
+ # Container might be called outside Catalyst context
+ return {} unless Class::MOP::is_class_loaded($app);
+
+ # config might not have been defined
+ return $app->config || {};
+ },
+ dependencies => [ depends_on('application_name') ],
+ );
+}
+
+sub build_global_config_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'global_config',
+ block => sub {
+ my $s = shift;
+
+ return Config::Any->load_files({
+ files => $s->param('global_files'),
+ filter => \&_fix_syntax,
+ use_ext => 1,
+ driver_args => $s->param('driver'),
+ });
+ },
+ dependencies => [ depends_on('global_files') ],
+ );
+}
+
+sub build_local_config_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'local_config',
+ block => sub {
+ my $s = shift;
+
+ return Config::Any->load_files({
+ files => $s->param('local_files'),
+ filter => \&_fix_syntax,
+ use_ext => 1,
+ driver_args => $s->param('driver'),
+ });
+ },
+ dependencies => [ depends_on('local_files') ],
+ );
+}
+
+sub build_config_path_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'config_path',
+ block => sub {
+ my $s = shift;
+
+ my $path = $s->param('path');
+ my $prefix = $s->param('prefix');
+
+ my ( $extension ) = ( $path =~ m{\.(.{1,4})$} );
+
+ if ( -d $path ) {
+ $path =~ s{[\/\\]$}{};
+ $path .= "/$prefix";
+ }
+
+ return [ $path, $extension ];
+ },
+ dependencies => [ depends_on('prefix'), depends_on('path') ],
+ );
+}
+
+sub build_config_local_suffix_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'config_local_suffix',
+ block => sub {
+ my $s = shift;
+ my $suffix = Catalyst::Utils::env_value( $s->param('application_name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
+
+ return $suffix;
+ },
+ dependencies => [ depends_on('application_name') ],
+ );
+}
+
+sub build_locate_components_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'locate_components',
+ block => sub {
+ my $s = shift;
+ my $class = $s->param('application_name');
+ my $config = $s->param('config')->{ setup_components };
+
+ Catalyst::Exception->throw(
+ qq{You are using search_extra config option. That option is\n} .
+ qq{deprecated, please refer to the documentation for\n} .
+ qq{other ways of achieving the same results.\n}
+ ) if delete $config->{ search_extra };
+
+ my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
+
+ my $locator = Module::Pluggable::Object->new(
+ search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
+ %$config
+ );
+
+ return [ $locator->plugins ];
+ },
+ dependencies => [ depends_on('application_name'), depends_on('config') ],
+ );
+}
+
+sub setup_components {
+ my $self = shift;
+ warn("Setting up default components");
+ my $class = $self->resolve( service => 'application_name' );
+ 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) {
+ $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);
+
+ warn "getting $component in $class, type $type";
+
+ $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( '/application_name' ),
+ ],
+ )
+ );
+
+ $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 );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Container - IOC for Catalyst components
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head1 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
+subcontainer 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
+subcontainer. 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 Building Services
+
+=head2 build_application_name_service
+
+Name of the application (such as MyApp).
+
+=head2 build_driver_service
+
+Config options passed directly to the driver being used.
+
+=head2 build_file_service
+
+?
+
+=head2 build_substitutions_service
+
+This method substitutes macros found with calls to a function. There are a
+number of default macros:
+
+=over
+
+=item * C<__HOME__> - replaced with C<$c-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 lookup the
+config files (which will be in the format $prefix.$extension). If the app is
+MyApp::Foo, the prefix will be myapp_foo.
+
+=head2 build_path_service
+
+The path to the config file (or environment variable, if defined).
+
+=head2 build_config_service
+
+The resulting configuration for the application, after it has successfully
+been loaded, and all substitutions have been made.
+
+=head2 build_raw_config_service
+
+The merge of local_config and global_config hashes, before substitutions.
+
+=head2 build_global_files_service
+
+Gets all files for config that don't have the local_suffix, such as myapp.conf.
+
+=head2 build_local_files_service
+
+Gets all files for config that have the local_suffix, such as myapp_local.conf.
+
+=head2 build_global_config_service
+
+Reads config from global_files.
+
+=head2 build_local_config_service
+
+Reads config from local_files.
+
+=head2 build_class_config_service
+
+Reads config set from the application's class attribute config,
+i.e. MyApp->config( name => 'MyApp', ... )
+
+=head2 build_config_path_service
+
+Splits the path to the config file, and returns on array ref containing
+the path to the config file minus the extension in the first position,
+and the extension in the second.
+
+=head2 build_config_local_suffix_service
+
+Determines the suffix of files used to override the main config. By default
+this value is C<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 subcontainer (such as controller, model or
+view), and returns the searched component. If $name is undef, it returns the
+default component (such as default_view, if $sub_container is 'view'). If
+$name is a regexp, it returns an array of matching components. Otherwise, it
+looks for the component with name $name.
+
+=head2 get_all_components
+
+Fetches all the components, in each of the sub_containers model, view and
+controller, and returns a readonly hash. The keys are the class names, and
+the values are the blessed objects. This is what is returned by $c->components.
+
+=head2 add_component
+
+Adds a component to the appropriate subcontainer. The subcontainer is guessed
+by the component name given.
+
+=head2 find_component
+
+Searches for components in all containers. If $component is the full class
+name, the subcontainer is guessed, and it gets the searched component in there.
+Otherwise, it looks for a component with that name in all subcontainers. If
+$component is a regexp it calls _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
+
+=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) ) {
+ # FIXME - MADNESS!
+ # how the heck does this warn CODE???????????
+ warn ref $accept_context_args if ref $accept_context_args ne 'ARRAY';
+ 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 TestCustomContainer;
+
+TestCustomContainer->new(sugar => 0);
--- /dev/null
+use warnings;
+use strict;
+use FindBin '$Bin';
+use lib "$Bin/../lib";
+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 - OMG why should this even work?!!
+ok($appclass->model('TopLevel::GENERATED'), 'Have generated model');
+is(ref($appclass->model('TopLevel::GENERATED')), 'FooBarBazQuux',
'ACCEPT_CONTEXT in generated inner package fired as expected');
$appclass = "InnerComponent";
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');
+
+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;
+our $loaded = 0;
+
+Moose::Meta::Class->create('Some::Test::Object');
+Moose::Meta::Class->create(
+ 'MyMVCTestApp::Model::Test::Object' =>
+ superclasses => [ 'Catalyst::Model', 'Some::Test::Object' ],
+);
+
+{
package MyMVCTestApp;
use base qw/Catalyst/;
- __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @complist } );
+ no warnings 'redefine';
- my $thingie={};
- bless $thingie, 'Some::Test::Object';
- __PACKAGE__->components->{'MyMVCTestApp::Model::Test::Object'} = $thingie;
+ local *Catalyst::IOC::Container::build_locate_components_service = sub {
+ my $self = shift;
- # allow $c->log->warn to work
- __PACKAGE__->setup_log;
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'locate_components',
+ block => sub {
+ return [@complist, 'MyMVCTestApp::Model::Test::Object'];
+
+ },
+ );
+ };
+ local *Catalyst::Log::warn = sub { $warnings++ };
+ *Class::MOP::load_class = sub {
+ my $class = shift;
+ $loaded++
+ if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestApp/
+ };
+
+ __PACKAGE__->setup;
}
+ok( $warnings, 'Issues deprecated warnings' );
+is( $loaded, scalar @complist + 1, 'Loaded all components' );
+
is( MyMVCTestApp->view('View'), 'MyMVCTestApp::V::View', 'V::View ok' );
is( MyMVCTestApp->controller('Controller'),
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++ };
+ *Class::MOP::load_class = sub {
+ my $class = shift;
+ $loaded++
+ if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestAppDefaultView/
+ };
-MyMVCTestApp->config->{default_model} = 'M';
-is ( bless ({stash=>{}}, 'MyMVCTestApp')->model , 'MyMVCTestApp::Model::M', 'default_model ok');
-is ( MyMVCTestApp->model , 'MyMVCTestApp::Model::M', 'default_model in class method ok');
+ __PACKAGE__->config( default_view => 'V' );
+
+ __PACKAGE__->setup;
+}
+
+is( bless ({stash=>{}}, 'MyMVCTestAppDefaultView')->view, 'MyMVCTestAppDefaultView::View::V', 'default_view ok' );
+is( MyMVCTestAppDefaultView->view , 'MyMVCTestAppDefaultView::View::V', 'default_view in class method ok' );
+
+our @complist_default_model =
+ map { "MyMVCTestAppDefaultModel::$_" } @complist_suffix;
+
+{
+ package MyMVCTestAppDefaultModel;
+
+ use base qw/Catalyst/;
+
+ no warnings 'redefine';
+
+ local *Catalyst::IOC::Container::build_locate_components_service = sub {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ lifecycle => 'Singleton',
+ name => 'locate_components',
+ block => sub {
+ return \@complist_default_model;
+ },
+ );
+ };
+ local *Catalyst::Log::warn = sub { $warnings++ };
+ *Class::MOP::load_class = sub {
+ my $class = shift;
+ $loaded++
+ if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestAppDefaultModel/
+ };
+
+ __PACKAGE__->config( default_model => 'M' );
+
+ __PACKAGE__->setup;
+}
+
+is( bless ({stash=>{}}, 'MyMVCTestAppDefaultModel')->model , 'MyMVCTestAppDefaultModel::Model::M', 'default_model ok' );
+is( MyMVCTestAppDefaultModel->model , 'MyMVCTestAppDefaultModel::Model::M', 'default_model in class method ok' );
# regexp behavior tests
{
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';
+
+ *Class::MOP::load_class = sub {
+ $loaded++;
+ };
+
__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;
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 Moose;
-use strict;
use Catalyst qw/
Test::MangleDollarUnderScore
- Test::Errors
- Test::Headers
+ Test::Errors
+ Test::Headers
Test::Plugin
Test::Inline
+TestApp::Plugin::FullyQualified
+TestApp::Plugin::AddDispatchTypes
+TestApp::Role
/;
+extends 'Catalyst';
use Catalyst::Utils;
-use Moose;
use namespace::autoclean;
# -----------
# 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 } ) );
}
sub Catalyst::Log::error { }
}
-# 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 {
use Scalar::Util qw(blessed weaken);
sub dump {
- my ( $self, $reference ) = @_;
+ my ( $self, $reference, $purity ) = @_;
return unless $reference;
+ $purity = defined $purity ? $purity : 1;
+
my $dumper = Data::Dumper->new( [$reference] );
$dumper->Indent(1);
- $dumper->Purity(1);
+ $dumper->Purity($purity);
$dumper->Useqq(0);
$dumper->Deepcopy(1);
$dumper->Quotekeys(0);
}
sub process {
- my ( $self, $c, $reference ) = @_;
+ my ( $self, $c, $reference, $purity ) = @_;
# Force processing of on-demand data
$c->prepare_body;
my $context = delete $reference->{_context};
if ( my $output =
- $self->dump( $reference ) )
+ $self->dump( $reference, $purity ) )
{
$c->res->headers->content_type('text/plain');
sub process {
my ( $self, $c ) = @_;
- return $self->SUPER::process( $c, $c->action );
+ return $self->SUPER::process( $c, $c->action, 0 );
}
1;
--- /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};
+Class::MOP::load_class($ENV{TEST_APP_CURRENT_CONTAINER}); # FIXME!
+# Custom container name is silently ignored if the class doesn't exist!
+__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;
+
+ warn("Add SingletonLifeCycle to model");
+ $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 => {
+ application_name => depends_on( '/application_name' ),
+ },
+ )
+ );
+
+ warn("Add RequestLifeCycle to model");
+ $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 => {
+ application_name => depends_on( '/application_name' ),
+ },
+ )
+ );
+
+# warn("Add DependsOnDefaultSetup to model");
+# $self->get_sub_container('model')->add_service(
+# Catalyst::IOC::ConstructorInjection->new(
+# name => 'DependsOnDefaultSetup',
+# class => 'TestAppCustomContainer::Model::DependsOnDefaultSetup',
+# catalyst_component_name => 'TestAppCustomContainer::Model::DependsOnDefaultSetup',
+# dependencies => {
+# application_name => depends_on( '/application_name' ),
+# # 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( '/application_name' ),
+# ],
+# 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