From: André Walker Date: Tue, 5 Jul 2011 14:48:38 +0000 (-0300) Subject: Merge branch 'master' into gsoc_breadboard X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=01c3d0f7451b25366ca49f6980d8584f8563a432;hp=f899107d00c9414a83e8a48386e298ba6e270af3;p=catagits%2FCatalyst-Runtime.git Merge branch 'master' into gsoc_breadboard --- diff --git a/Makefile.PL b/Makefile.PL index 0f1481d..0dee6c7 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -13,6 +13,7 @@ perl_version '5.008004'; name 'Catalyst-Runtime'; all_from 'lib/Catalyst/Runtime.pm'; +requires 'Bread::Board'; requires 'List::MoreUtils'; requires 'namespace::autoclean' => '0.09'; requires 'namespace::clean' => '0.13'; @@ -50,6 +51,7 @@ requires 'MRO::Compat'; requires 'MooseX::Getopt' => '0.30'; requires 'MooseX::Types'; requires 'MooseX::Types::Common::Numeric'; +requires 'MooseX::Types::LoadableClass'; requires 'String::RewritePrefix' => '0.004'; # Catalyst::Utils::resolve_namespace test_requires 'Class::Data::Inheritable'; diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 9e41ec6..ccc6853 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -67,7 +67,7 @@ our $GO = Catalyst::Exception::Go->new; #I imagine that very few of these really need to be class variables. if any. #maybe we should just make them attributes with a default? __PACKAGE__->mk_classdata($_) - for qw/components arguments dispatcher engine log dispatcher_class + for qw/container components arguments dispatcher engine log dispatcher_class engine_class context_class request_class response_class stats_class setup_finished/; @@ -548,9 +548,11 @@ sub _comp_names_search_prefixes { 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; @@ -653,9 +655,10 @@ sub controller { 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; @@ -691,9 +694,10 @@ sub model { 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; @@ -750,10 +754,11 @@ sub 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 ); + 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" ); @@ -794,7 +799,7 @@ Returns the available names which can be passed to $c->controller sub controllers { my ( $c ) = @_; - return $c->_comp_names(qw/Controller C/); + return $c->container->get_sub_container('controller')->get_service_list; } =head2 $c->models @@ -805,7 +810,7 @@ Returns the available names which can be passed to $c->model sub models { my ( $c ) = @_; - return $c->_comp_names(qw/Model M/); + return $c->container->get_sub_container('model')->get_service_list; } @@ -817,7 +822,7 @@ Returns the available names which can be passed to $c->view sub views { my ( $c ) = @_; - return $c->_comp_names(qw/View V/); + return $c->container->get_sub_container('view')->get_service_list; } =head2 $c->comp($name) @@ -1112,6 +1117,7 @@ sub setup { } } + $class->setup_config(); $class->setup_home( delete $flags->{home} ); $class->setup_log( delete $flags->{log} ); @@ -1592,6 +1598,35 @@ These methods are not meant to be used by end users. 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. @@ -2414,6 +2449,34 @@ Sets up actions for a component. 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. @@ -2451,18 +2514,45 @@ sub setup_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 @@ -2533,8 +2623,7 @@ sub setup_component { 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; @@ -2544,6 +2633,7 @@ sub setup_component { qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./ ); } + return $instance; } diff --git a/lib/Catalyst/Container.pm b/lib/Catalyst/Container.pm new file mode 100644 index 0000000..2e885e3 --- /dev/null +++ b/lib/Catalyst/Container.pm @@ -0,0 +1,395 @@ +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; diff --git a/t/aggregate/unit_core_component.t b/t/aggregate/unit_core_component.t index 69ac6c0..f823ef3 100644 --- a/t/aggregate/unit_core_component.t +++ b/t/aggregate/unit_core_component.t @@ -1,4 +1,4 @@ -use Test::More tests => 22; +use Test::More; use strict; use warnings; @@ -91,3 +91,4 @@ is_deeply([ MyApp->comp('Foo') ], \@complist, 'Fallthrough return ok'); is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok'); } +done_testing; diff --git a/t/aggregate/unit_core_component_generating.t b/t/aggregate/unit_core_component_generating.t index a518fce..79e3237 100644 --- a/t/aggregate/unit_core_component_generating.t +++ b/t/aggregate/unit_core_component_generating.t @@ -1,4 +1,4 @@ -use Test::More tests => 3; +use Test::More; use strict; use warnings; @@ -8,3 +8,5 @@ use TestApp; ok(TestApp->model('Generating'), 'knows about generating model'); ok(TestApp->model('Generated'), 'knows about the generated model'); is(TestApp->model('Generated')->foo, 'foo', 'can operate on generated model'); + +done_testing; diff --git a/t/aggregate/unit_core_component_layers.t b/t/aggregate/unit_core_component_layers.t index c15bc73..d603b0b 100644 --- a/t/aggregate/unit_core_component_layers.t +++ b/t/aggregate/unit_core_component_layers.t @@ -1,4 +1,4 @@ -use Test::More tests => 6; +use Test::More; use strict; use warnings; use lib 't/lib'; @@ -24,3 +24,4 @@ TestApp->setup; is($model_foo->model_quux_method, 'chunkybacon', 'Model method getting $self->{quux} from config'); +done_testing; diff --git a/t/aggregate/unit_core_component_loading.t b/t/aggregate/unit_core_component_loading.t index 2c53144..65fb67a 100644 --- a/t/aggregate/unit_core_component_loading.t +++ b/t/aggregate/unit_core_component_loading.t @@ -1,8 +1,5 @@ -# 2 initial tests, and 6 per component in the loop below -# (do not forget to update the number of components in test 3 as well) -# 5 extra tests for the loading options -# One test for components in inner packages -use Test::More tests => 2 + 6 * 24 + 8 + 1; +# way too many tests to count +use Test::More; use strict; use warnings; @@ -94,6 +91,11 @@ my $shut_up_deprecated_warnings = q{ eval "package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->setup"; +is_deeply( + [ sort $appclass->locate_components ], + [ map { $appclass . '::' . $_->{prefix} . '::' . $_->{name} } @components ], 'locate_components finds the components correctly' +); + can_ok( $appclass, 'components'); my $complist = $appclass->components; @@ -163,6 +165,24 @@ __PACKAGE__->config->{ setup_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; @@ -233,3 +253,5 @@ eval "package $appclass; use Catalyst; __PACKAGE__->setup"; isa_ok($appclass->controller('Test'), 'Catalyst::Controller'); rmtree($libdir); + +done_testing; diff --git a/t/aggregate/unit_core_component_mro.t b/t/aggregate/unit_core_component_mro.t index 8e9a064..3b0fae6 100644 --- a/t/aggregate/unit_core_component_mro.t +++ b/t/aggregate/unit_core_component_mro.t @@ -1,4 +1,4 @@ -use Test::More tests => 1; +use Test::More; use strict; use warnings; @@ -27,3 +27,4 @@ my $warn = ''; like($warn, qr/after Catalyst::Component in MyApp::Component/, 'correct warning thrown'); +done_testing; diff --git a/t/aggregate/unit_core_component_setup_component.t b/t/aggregate/unit_core_component_setup_component.t new file mode 100644 index 0000000..d5a9066 --- /dev/null +++ b/t/aggregate/unit_core_component_setup_component.t @@ -0,0 +1,98 @@ +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; diff --git a/t/aggregate/unit_core_component_setup_components.t b/t/aggregate/unit_core_component_setup_components.t new file mode 100644 index 0000000..5586b42 --- /dev/null +++ b/t/aggregate/unit_core_component_setup_components.t @@ -0,0 +1,123 @@ +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; +} diff --git a/t/aggregate/unit_core_container_custom_container.t b/t/aggregate/unit_core_container_custom_container.t new file mode 100644 index 0000000..647ddf0 --- /dev/null +++ b/t/aggregate/unit_core_container_custom_container.t @@ -0,0 +1,46 @@ +use strict; +use warnings; +use Test::More; + +# first, test if it loads Catalyst::Container when +# no custom container exists +{ + package ContainerTestApp; + use Moose; + 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; diff --git a/t/aggregate/unit_core_container_live_auto.t b/t/aggregate/unit_core_container_live_auto.t new file mode 100644 index 0000000..be1879d --- /dev/null +++ b/t/aggregate/unit_core_container_live_auto.t @@ -0,0 +1,25 @@ +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Test::More; + +use_ok('TestAppContainer'); + +is( TestAppContainer->controller('Config')->{foo}, 'foo', 'config ok' ); + +ok( TestAppContainer->config->{cache} !~ /^__HOME__/, + 'home dir substituted in config var' +); + +is( TestAppContainer->config->{foo}, 'bar', 'app finalize_config works' ); + +my $home = TestAppContainer->config->{ home }; +my $path = join ',', + $home, TestAppContainer->path_to( 'x' ), + $home, TestAppContainer->path_to( 'y' ); +is( TestAppContainer->config->{multi}, $path, 'vars substituted in config var, twice' ); + +done_testing; diff --git a/t/aggregate/unit_core_container_mock_load.t b/t/aggregate/unit_core_container_mock_load.t new file mode 100644 index 0000000..b2af3ae --- /dev/null +++ b/t/aggregate/unit_core_container_mock_load.t @@ -0,0 +1,31 @@ +package MockApp; + +use Test::More; +use Cwd; + +# Remove all relevant env variables to avoid accidental fail +foreach my $name ( grep { m{^(CATALYST)} } keys %ENV ) { + delete $ENV{ $name }; +} + +$ENV{ CATALYST_HOME } = cwd . '/t/lib/MockAppConfigLoader'; + +use_ok( 'Catalyst' ); + +__PACKAGE__->config->{ substitutions } = { + foo => sub { shift; join( '-', @_ ); } +}; + +__PACKAGE__->setup; + +ok( my $conf = __PACKAGE__->config, 'config loads' ); +is( $conf->{ 'Controller::Foo' }->{ foo }, 'bar' ); +is( $conf->{ 'Controller::Foo' }->{ new }, 'key' ); +is( $conf->{ 'Model::Baz' }->{ qux }, 'xyzzy' ); +is( $conf->{ 'Model::Baz' }->{ another }, 'new key' ); +is( $conf->{ 'view' }, 'View::TT::New' ); +is( $conf->{ 'foo_sub' }, 'x-y' ); +is( $conf->{ 'literal_macro' }, '__DATA__', 'literal macro' ); +is( $conf->{ 'Plugin::Zot' }->{ zoot }, 'zooot'); + +done_testing; diff --git a/t/aggregate/unit_core_container_mock_load_env.t b/t/aggregate/unit_core_container_mock_load_env.t new file mode 100644 index 0000000..88c3b0b --- /dev/null +++ b/t/aggregate/unit_core_container_mock_load_env.t @@ -0,0 +1,32 @@ +package MockAppEnv; + +use Test::More; +use Cwd; + +# Remove all relevant env variables to avoid accidental fail +foreach my $name ( grep { m{^(CATALYST|MOCKAPPENV)} } keys %ENV ) { + delete $ENV{ $name }; +} + +$ENV{ CATALYST_HOME } = cwd . '/t/lib/MockAppConfigLoader'; +$ENV{ MOCKAPPENV_CONFIG } = $ENV{ CATALYST_HOME } . '/mockapp.pl'; + +use_ok( 'Catalyst' ); + +__PACKAGE__->config->{substitutions} = { + foo => sub { shift; join( '-', @_ ); } +}; + +__PACKAGE__->setup; + +ok( my $conf = __PACKAGE__->config, 'config loads' ); +is( $conf->{ 'Controller::Foo' }->{ foo }, 'bar' ); +is( $conf->{ 'Controller::Foo' }->{ new }, 'key' ); +is( $conf->{ 'Model::Baz' }->{ qux }, 'xyzzy' ); +is( $conf->{ 'Model::Baz' }->{ another }, 'new key' ); +is( $conf->{ 'view' }, 'View::TT::New' ); +is( $conf->{ 'foo_sub' }, 'x-y' ); +is( $conf->{ 'literal_macro' }, '__DATA__', 'literal macro' ); +is( $conf->{ 'environment_macro' }, $ENV{ CATALYST_HOME }.'/mockapp.pl', 'environment macro' ); + +done_testing; diff --git a/t/aggregate/unit_core_container_path_env.t b/t/aggregate/unit_core_container_path_env.t new file mode 100644 index 0000000..11e3d81 --- /dev/null +++ b/t/aggregate/unit_core_container_path_env.t @@ -0,0 +1,17 @@ +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Test::More; + +$ENV{ TESTAPPCONTAINER_CONFIG } = 'test.perl'; + +use_ok 'Catalyst::Test', 'TestAppContainer'; + +ok my ( $res, $c ) = ctx_request( '/' ), 'context object'; + +is_deeply $c->container->resolve( service => 'config_path' ), [ qw( test.perl perl ) ], 'path is "test.perl"'; + +done_testing; diff --git a/t/aggregate/unit_core_container_suffix_env.t b/t/aggregate/unit_core_container_suffix_env.t new file mode 100644 index 0000000..2390ba6 --- /dev/null +++ b/t/aggregate/unit_core_container_suffix_env.t @@ -0,0 +1,16 @@ +use strict; +use warnings; + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Test::More; + +$ENV{ TESTAPPCONTAINER_CONFIG_LOCAL_SUFFIX } = 'test'; +use_ok 'Catalyst::Test', 'TestAppContainer'; + +ok my ( $res, $c ) = ctx_request( '/' ), 'context object'; + +is $c->container->resolve( service => 'config_local_suffix' ), 'test', 'suffix is "test"'; + +done_testing; diff --git a/t/lib/MockAppConfigLoader/mockapp.pl b/t/lib/MockAppConfigLoader/mockapp.pl new file mode 100644 index 0000000..73d17f9 --- /dev/null +++ b/t/lib/MockAppConfigLoader/mockapp.pl @@ -0,0 +1,10 @@ +{ + name => 'TestAppContainer', + view => 'View::TT', + 'Controller::Foo' => { foo => 'bar' }, + 'Model::Baz' => { qux => 'xyzzy' }, + foo_sub => '__foo(x,y)__', + literal_macro => '__literal(__DATA__)__', + environment_macro => '__ENV(CATALYST_HOME)__/mockapp.pl', + Plugin => { Zot => { zoot => 'zooot' } }, +} diff --git a/t/lib/MockAppConfigLoader/mockapp_local.pl b/t/lib/MockAppConfigLoader/mockapp_local.pl new file mode 100644 index 0000000..81660fe --- /dev/null +++ b/t/lib/MockAppConfigLoader/mockapp_local.pl @@ -0,0 +1,5 @@ +{ + view => 'View::TT::New', + 'Controller::Foo' => { new => 'key' }, + Component => { 'Model::Baz' => { 'another' => 'new key' } }, +} diff --git a/t/lib/TestAppContainer.pm b/t/lib/TestAppContainer.pm new file mode 100644 index 0000000..55975da --- /dev/null +++ b/t/lib/TestAppContainer.pm @@ -0,0 +1,20 @@ +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; diff --git a/t/lib/TestAppContainer/Controller/Config.pm b/t/lib/TestAppContainer/Controller/Config.pm new file mode 100644 index 0000000..9aa70bb --- /dev/null +++ b/t/lib/TestAppContainer/Controller/Config.pm @@ -0,0 +1,8 @@ +package TestAppContainer::Controller::Config; + +use strict; +use warnings; + +use base qw( Catalyst::Controller ); + +1; diff --git a/t/lib/TestAppContainer/Controller/Root.pm b/t/lib/TestAppContainer/Controller/Root.pm new file mode 100644 index 0000000..b628056 --- /dev/null +++ b/t/lib/TestAppContainer/Controller/Root.pm @@ -0,0 +1,16 @@ +package TestAppContainer::Controller::Root; + +use strict; +use warnings; + +use base 'Catalyst::Controller'; + +__PACKAGE__->config->{namespace} = ''; + +sub default :Path { + my ( $self, $c ) = @_; + $c->response->body( 'Page not found' ); + $c->response->status(404); +} + +1; diff --git a/t/lib/TestAppContainer/testappcontainer.pl b/t/lib/TestAppContainer/testappcontainer.pl new file mode 100644 index 0000000..e3856d2 --- /dev/null +++ b/t/lib/TestAppContainer/testappcontainer.pl @@ -0,0 +1,6 @@ +{ + name => 'TestAppContainer', + 'Controller::Config' => { foo => 'foo' }, + cache => '__HOME__/cache', + multi => '__HOME__,__path_to(x)__,__HOME__,__path_to(y)__', +}