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
test_requires 'Class::Data::Inheritable';
#I imagine that very few of these really need to be class variables. if any.
#maybe we should just make them attributes with a default?
__PACKAGE__->mk_classdata($_)
- for qw/components arguments dispatcher engine log dispatcher_class
+ for qw/container components arguments dispatcher engine log dispatcher_class
engine_class context_class request_class response_class stats_class
setup_finished/;
my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
$filter = qr/$filter/; # Compile regex now rather than once per loop
+ my @components = map { $c->container->get_sub_container($_)->get_service_list } qw(controller view model);
+
# 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 };
+ grep { /$filter/ } @components;
# undef for a name will return all
return keys %eligible if !defined $name;
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 $container = $c->container->get_sub_container('controller');
+ return $c->_filter_component( $container->resolve(service => "$check"), @args )
+ if $container->has_service($check);
}
my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
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 $container = $c->container->get_sub_container('model');
+ return $c->_filter_component( $container->resolve(service => "$check"), @args )
+ if $container->has_service($check);
}
my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
return map { $c->_filter_component( $_, @args ) } @result if ref $name;
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 );
+ my $container = $c->container->get_sub_container('view');
+ if ($container->has_service($check)) {
+
+ return $c->_filter_component( $container->resolve(service => $check), @args );
}
else {
$c->log->warn( "Attempted to use view '$check', but does not exist" );
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)
}
}
+ $class->setup_config();
$class->setup_home( delete $flags->{home} );
$class->setup_log( delete $flags->{log} );
Returns a hash of components.
+=cut
+
+around components => sub {
+ my $orig = shift;
+ my $class = shift;
+ my $comps = shift;
+
+ return $class->$orig if ( !$comps );
+
+# FIXME: should this ugly kludge exist?
+ $class->setup_config unless defined $class->container;
+
+# FIXME: should there be a warning here, not to use this accessor to create the components?
+ my $components = {};
+
+ my $containers;
+ $containers->{$_} = $class->container->get_sub_container($_) for qw(model view controller);
+
+ for my $component ( keys %$comps ) {
+ $components->{ $component } = $comps->{$component};
+
+ my $type = _get_component_type($component);
+
+ $containers->{$type}->add_service(Bread::Board::BlockInjection->new( name => $component, block => sub { return $class->setup_component($component) } ));
+ }
+
+ return $class->$orig($components);
+};
+
=head2 $c->context_class
Returns or sets the context class.
sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
+=head2 $c->setup_config
+
+=cut
+
+sub setup_config {
+ my $class = shift;
+
+ my %args = %{ $class->config || {} };
+
+ my @container_classes = ( "${class}::Container", 'Catalyst::Container');
+ unshift @container_classes, delete $args{container_class} if exists $args{container_class};
+
+ my $container_class = Class::MOP::load_first_existing_class(@container_classes);
+
+ my $container = $container_class->new( %args, name => "$class" );
+ $class->container($container);
+
+ my $config = $container->resolve(service => 'config');
+ $class->config($config);
+ $class->finalize_config; # back-compat
+}
+
+=head $c->finalize_config
+
+=cut
+
+sub finalize_config { }
+
=head2 $c->setup_components
This method is called internally to set up the application's components.
Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
}
+ my $containers;
+ $containers->{$_} = $class->container->get_sub_container($_) for qw(model view controller);
+
for my $component (@comps) {
my $instance = $class->components->{ $component } = $class->setup_component($component);
+ if ( my $type = _get_component_type($component) ) {
+ $containers->{$type}->add_service(Bread::Board::BlockInjection->new( name => $component, block => sub { return $instance } ));
+ }
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};
+
+ $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @expanded_components;
+ $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;
+
+ if (my $type = _get_component_type($component)) {
+ $containers->{$type}->add_service(Bread::Board::BlockInjection->new( name => $component, block => sub { return $class->setup_component($component) } ));
+ }
+
$class->components->{ $component } = $class->setup_component($component);
}
}
}
+sub _get_component_type {
+ my $component = shift;
+ my @parts = split /::/, $component;
+
+ for (@parts) {
+ return 'controller' if /^c|controller$/i;
+ return 'model' if /^m|model$/i;
+ return 'view' if /^v|view$/i;
+ }
+}
+
=head2 $c->locate_components( $setup_component_config )
This method is meant to provide a list of component modules that should be
message => qq/Couldn't instantiate component "$component", "$error"/
);
}
-
- unless (blessed $instance) {
+ elsif (!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;
qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
);
}
+
return $instance;
}
--- /dev/null
+package Catalyst::Container;
+use Bread::Board;
+use Moose;
+use Config::Any;
+use Data::Visitor::Callback;
+use Catalyst::Utils ();
+use MooseX::Types::LoadableClass qw/ LoadableClass /;
+
+extends 'Bread::Board::Container';
+
+has config_local_suffix => (
+ is => 'rw',
+ isa => 'Str',
+ default => 'local',
+);
+
+has driver => (
+ is => 'rw',
+ isa => 'HashRef',
+ default => sub { +{} },
+);
+
+has file => (
+ is => 'rw',
+ isa => 'Str',
+ default => '',
+);
+
+has substitutions => (
+ is => 'rw',
+ isa => 'HashRef',
+ default => sub { +{} },
+);
+
+has name => (
+ is => 'rw',
+ isa => 'Str',
+ default => 'TestApp',
+);
+
+has sub_container_class => (
+ isa => LoadableClass,
+ is => 'ro',
+ coerce => 1,
+ default => 'Bread::Board::Container',
+);
+
+sub BUILD {
+ my $self = shift;
+
+ $self->build_root_container;
+
+ $self->build_model_subcontainer;
+ $self->build_view_subcontainer;
+ $self->build_controller_subcontainer;
+}
+
+sub build_model_subcontainer {
+ my $self = shift;
+
+ $self->add_sub_container(
+ $self->sub_container_class->new( name => 'model' )
+ );
+}
+
+sub build_view_subcontainer {
+ my $self = shift;
+
+ $self->add_sub_container(
+ $self->sub_container_class->new( name => 'view' )
+ );
+}
+
+sub build_controller_subcontainer {
+ my $self = shift;
+
+ $self->add_sub_container(
+ $self->sub_container_class->new( name => 'controller' )
+ );
+}
+
+sub build_root_container {
+ my $self = shift;
+
+ $self->build_substitutions_service();
+ $self->build_file_service();
+ $self->build_driver_service();
+ $self->build_name_service();
+ $self->build_prefix_service();
+ $self->build_extensions_service();
+ $self->build_path_service();
+ $self->build_config_service();
+ $self->build_raw_config_service();
+ $self->build_global_files_service();
+ $self->build_local_files_service();
+ $self->build_global_config_service();
+ $self->build_local_config_service();
+ $self->build_config_local_suffix_service();
+ $self->build_config_path_service();
+}
+
+sub build_name_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::Literal->new( name => 'name', value => $self->name )
+ );
+}
+
+sub build_driver_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::Literal->new( name => 'driver', value => $self->driver )
+ );
+}
+
+sub build_file_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::Literal->new( name => 'file', value => $self->file )
+ );
+}
+
+sub build_substitutions_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions )
+ );
+}
+
+sub build_extensions_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ name => 'extensions',
+ block => sub {
+ return \@{Config::Any->extensions};
+ },
+ )
+ );
+}
+
+sub build_prefix_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ name => 'prefix',
+ block => sub {
+ return Catalyst::Utils::appprefix( shift->param('name') );
+ },
+ dependencies => [ depends_on('name') ],
+ )
+ );
+}
+
+sub build_path_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ name => 'path',
+ block => sub {
+ my $s = shift;
+
+ return Catalyst::Utils::env_value( $s->param('name'), 'CONFIG' )
+ || $s->param('file')
+ || $s->param('name')->path_to( $s->param('prefix') );
+ },
+ dependencies => [ depends_on('file'), depends_on('name'), depends_on('prefix') ],
+ )
+ );
+}
+
+sub build_config_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ 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('name'), $s->param('substitutions'), $_ );
+ }
+
+ );
+ $v->visit( $s->param('raw_config') );
+ },
+ dependencies => [ depends_on('name'), depends_on('raw_config'), depends_on('substitutions') ],
+ )
+ );
+}
+
+sub build_raw_config_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ name => 'raw_config',
+ block => sub {
+ my $s = shift;
+
+ my @global = @{$s->param('global_config')};
+ my @locals = @{$s->param('local_config')};
+
+ my $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') ],
+ )
+ );
+}
+
+sub build_global_files_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ 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;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ 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_global_config_service {
+ my $self = shift;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ 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;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ 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;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ 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;
+ $self->add_service(
+ Bread::Board::BlockInjection->new(
+ name => 'config_local_suffix',
+ block => sub {
+ my $s = shift;
+ my $suffix = Catalyst::Utils::env_value( $s->param('name'), 'CONFIG_LOCAL_SUFFIX' ) || $self->config_local_suffix;
+
+ return $suffix;
+ },
+ dependencies => [ depends_on('name') ],
+ )
+ );
+}
+
+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;
+}
+
+1;
-use Test::More tests => 22;
+use Test::More;
use strict;
use warnings;
is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok');
}
+done_testing;
-use Test::More tests => 3;
+use Test::More;
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;
__PACKAGE__->setup;
);
+{
+ 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'
+ );
+}
+
can_ok( $appclass, 'components');
$complist = $appclass->components;
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;
+use Test::More;
+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" );
+ is_deeply( \@comps, \@loaded_comps, 'all components loaded' );
+}
+
+my @controllers = @comps[0..7];
+my @models = @comps[8..15];
+my @views = @comps[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
+use strict;
+use warnings;
+use Test::More;
+
+# first, test if it loads Catalyst::Container when
+# no custom container exists
+{
+ package ContainerTestApp;
+ use Moose;
+ BEGIN { 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::Container', 'The container is Catalyst::Container, not a subclass');
+
+# now, check if it loads the subclass when it exists
+{
+ package CustomContainerTestApp::Container;
+ use Moose;
+ BEGIN { extends 'Catalyst::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::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;
--- /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' } },
+}
--- /dev/null
+package TestAppContainer;
+
+use strict;
+use warnings;
+
+use MRO::Compat;
+
+use Catalyst;
+
+our $VERSION = '0.01';
+
+__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)__',
+}
projects / catagits/Catalyst-Runtime.git / commitdiff