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
test_requires 'Class::Data::Inheritable';
- Profit! (Things like changing the complete app config per vhost, i.e.
writing a config loader / app class role which dispatches per vhost to
differently configured apps is piss easy)
+
+## GSOC
+
+### Next large steps:
+
+ - Moving setup_components etc into the container
+
+ - This is so that you can just load the container and get models etc from it,
+ without loading Catalyst.
+
+ - Finish moving setup_component
+ - $component->COMPONENT() is still called by setup_component
+ (should there be a Service::WithCOMPONENT to solve this?)
+ - make it a method, not function
+
+ - Break $instance->expand_modules() in setup_components and figure
+ out later how to bring it back
+
+ - Move expand_component_module
+
+ - Move locate_components
+
+ - Move contents of setup_components
+
+ - Finished documentation for ::IOC parts.
+
+ - 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
+
+ - Allowing people to change component lifecycles
+
+ - This is done by being able to use an alternate Service class..
+
+ I.E. We currently force everything to do Catalyst/IOC/Service/WithAcceptContext.pm, but
+ things without an ACCEPT_CONTEXT could just not bother, and it would be nice to have
+ one that cached the object in request scope (i.e. Catalyst::Component::InstancePerContext)
+ etc.
+
+ However we need to work out an interface for people to setup / configure this.
+
+### To polish off
+
+ - Document current methods
+ - + $class->container->get_sub_container('model')->make_single_default;
++ $class->container->get_sub_container('view')->make_single_default;
#I imagine that very few of these really need to be class variables. if any.
#maybe we should just make them attributes with a default?
__PACKAGE__->mk_classdata($_)
- for qw/components arguments dispatcher engine log dispatcher_class
+ for qw/container arguments dispatcher engine log dispatcher_class
engine_class context_class request_class response_class stats_class
setup_finished/;
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)
sub controller {
my ( $c, $name, @args ) = @_;
- my $appclass = ref($c) || $c;
- if( $name ) {
- unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
- my $comps = $c->components;
- my $check = $appclass."::Controller::".$name;
- return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
- }
- my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
- return map { $c->_filter_component( $_, @args ) } @result if ref $name;
- return $c->_filter_component( $result[ 0 ], @args );
- }
+ $name ||= Catalyst::Utils::class2classshortsuffix( $c->action->class );
- return $c->component( $c->action->class );
+ return $c->container->get_component_from_sub_container( 'controller', $name, $c, @args);
}
=head2 $c->model($name)
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) {
+ if (ref $c && !$name) {
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};
+ if $c->stash->{current_model_instance};
- 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.' );
+ $name = $c->stash->{current_model}
+ if $c->stash->{current_model};
}
- return $c->_filter_component( $comp );
+ return $c->container->get_component_from_sub_container( 'model', $name, $c, @args);
}
sub view {
my ( $c, $name, @args ) = @_;
- my $appclass = ref($c) || $c;
- if( $name ) {
- unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps
- my $comps = $c->components;
- my $check = $appclass."::View::".$name;
- if( exists $comps->{$check} ) {
- return $c->_filter_component( $comps->{$check}, @args );
- }
- else {
- $c->log->warn( "Attempted to use view '$check', but does not exist" );
- }
- }
- my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
- return map { $c->_filter_component( $_, @args ) } @result if ref $name;
- return $c->_filter_component( $result[ 0 ], @args );
- }
-
- if (ref $c) {
+ if (ref $c && !$name) {
return $c->stash->{current_view_instance}
- if $c->stash->{current_view_instance};
- return $c->view( $c->stash->{current_view} )
- if $c->stash->{current_view};
- }
- return $c->view( $appclass->config->{default_view} )
- if $appclass->config->{default_view};
-
- my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
+ if $c->stash->{current_view_instance};
- if( $rest ) {
- $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
- $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
- $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
- $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
- $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
+ $name = $c->stash->{current_view}
+ if $c->stash->{current_view};
}
- return $c->_filter_component( $comp );
+ return $c->container->get_component_from_sub_container( 'view', $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_types = $class->container->get_components_types
+ ) {
my $column_width = Catalyst::Utils::term_width() - 8 - 9;
my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
- for my $comp ( sort keys %{ $class->components } ) {
- my $type = ref $class->components->{$comp} ? 'instance' : 'class';
- $t->row( $comp, $type );
- }
- $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
- if ( keys %{ $class->components } );
- }
+ $t->row( @$_ ) for @comps_types;
- # Add our self to components, since we are also a component
- if( $class->isa('Catalyst::Controller') ){
- $class->components->{$class} = $class;
+ $class->log->debug( "Loaded components:\n" . $t->draw . "\n" );
}
$class->setup_actions;
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(
+ $_, $class
+ ) for keys %$comps;
+ }
+
+ return $container->get_all_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::IOC::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
+}
+
+=head2 $c->finalize_config
+
+=cut
+
+sub finalize_config { }
+
=head2 $c->setup_components
This method is called internally to set up the application's components.
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.
-
=cut
sub setup_components {
my $config = $class->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 @comps = $class->locate_components($config);
my %comps = map { $_ => 1 } @comps;
Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
}
+ my $container = $class->container;
+
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 );
+ $container->add_component( $component, $class );
+# FIXME - $instance->expand_modules() is broken
+ my @expanded_components = $class->expand_component_module( $component, $config );
for my $component (@expanded_components) {
next if $comps{$component};
- $class->components->{ $component } = $class->setup_component($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;
+
+ $container->add_component( $component, $class );
}
}
+
+ $container->get_sub_container('model')->make_single_default;
+ $container->get_sub_container('view')->make_single_default;
}
+
=head2 $c->locate_components( $setup_component_config )
This method is meant to provide a list of component modules that should be
setup for the application. By default, it will use L<Module::Pluggable>.
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.
+to L<Module::Pluggable>.
=cut
my $config = shift;
my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
- my $extra = delete $config->{ search_extra } || [];
-
- push @paths, @$extra;
my $locator = Module::Pluggable::Object->new(
search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
return Devel::InnerPackage::list_packages( $module );
}
-=head2 $c->setup_component
-
-=cut
-
-sub setup_component {
- my( $class, $component ) = @_;
-
- unless ( $component->can( 'COMPONENT' ) ) {
- return $component;
- }
-
- my $suffix = Catalyst::Utils::class2classsuffix( $component );
- my $config = $class->config->{ $suffix } || {};
- # Stash catalyst_component_name in the config here, so that custom COMPONENT
- # methods also pass it. local to avoid pointlessly shitting in config
- # for the debug screen, as $component is already the key name.
- local $config->{catalyst_component_name} = $component;
-
- my $instance = eval { $component->COMPONENT( $class, $config ); };
-
- if ( my $error = $@ ) {
- chomp $error;
- Catalyst::Exception->throw(
- message => qq/Couldn't instantiate component "$component", "$error"/
- );
- }
-
- unless (blessed $instance) {
- my $metaclass = Moose::Util::find_meta($component);
- my $method_meta = $metaclass->find_method_by_name('COMPONENT');
- my $component_method_from = $method_meta->associated_metaclass->name;
- my $value = defined($instance) ? $instance : 'undef';
- Catalyst::Exception->throw(
- message =>
- qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
- );
- }
- return $instance;
-}
-
=head2 $c->setup_dispatcher
Sets up 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
--- /dev/null
+package Catalyst::IOC::BlockInjection;
+use Moose;
+
+extends 'Bread::Board::BlockInjection';
+
+with 'Catalyst::IOC::Service::WithAcceptContext';
+
+__PACKAGE__->meta->make_immutable;
+
+no Moose;
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::IOC::BlockInjection
+
+=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 Hash::Util qw/lock_hash/;
+use MooseX::Types::LoadableClass qw/ LoadableClass /;
+use Moose::Util;
+use Catalyst::IOC::BlockInjection;
+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 name => (
+ is => 'ro',
+ isa => 'Str',
+ default => 'MyApp',
+);
+
+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
+ name
+ prefix
+ extensions
+ path
+ config
+ raw_config
+ global_files
+ local_files
+ global_config
+ local_config
+ config_local_suffix
+ config_path
+ /;
+
+ $self->add_sub_container(
+ $self->build_controller_subcontainer
+ );
+
+ # FIXME - the config should be merged at this point
+ my $config = $self->resolve( service => 'config' );
+ my $default_view = $params->{default_view} || $config->{default_view};
+ my $default_model = $params->{default_model} || $config->{default_model};
+
+ $self->add_sub_container(
+ $self->build_view_subcontainer(
+ default_component => $default_view,
+ )
+ );
+
+ $self->add_sub_container(
+ $self->build_model_subcontainer(
+ default_component => $default_model,
+ )
+ );
+}
+
+sub build_model_subcontainer {
+ my $self = shift;
+
+ return $self->new_sub_container( @_,
+ name => 'model',
+ );
+}
+
+sub build_view_subcontainer {
+ my $self = shift;
+
+ return $self->new_sub_container( @_,
+ name => 'view',
+ );
+}
+
+sub build_controller_subcontainer {
+ my $self = shift;
+
+ return $self->new_sub_container(
+ name => 'controller',
+ );
+}
+
+sub build_name_service {
+ my $self = shift;
+
+ return Bread::Board::Literal->new( name => 'name', value => $self->name );
+}
+
+sub build_driver_service {
+ my $self = shift;
+
+ return Bread::Board::Literal->new( name => 'driver', value => $self->driver );
+}
+
+sub build_file_service {
+ my $self = shift;
+
+ return Bread::Board::Literal->new( name => 'file', value => $self->file );
+}
+
+sub build_substitutions_service {
+ my $self = shift;
+
+ return Bread::Board::Literal->new( name => 'substitutions', value => $self->substitutions );
+}
+
+sub build_extensions_service {
+ my $self = shift;
+
+ return Bread::Board::BlockInjection->new(
+ name => 'extensions',
+ block => sub {
+ return \@{Config::Any->extensions};
+ },
+ );
+}
+
+sub build_prefix_service {
+ my $self = shift;
+
+ return 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;
+
+ return 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;
+
+ return 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;
+
+ return 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;
+
+ return 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;
+
+ return 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;
+
+ return 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;
+
+ return 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;
+
+ return 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;
+
+ return 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;
+}
+
+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, $c, @args ) = @_;
+ my ( $type, $name ) = _get_component_type_name($component);
+ my @result;
+
+ return $self->get_component_from_sub_container(
+ $type, $name, $c, @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( $_, $c, @args ) } @result
+ if @result;
+ }
+
+ # FIXME - I guess I shouldn't be calling $c->components here
+ # one last search for things like $c->comp(qr/::M::/)
+ @result = $self->find_component_regexp(
+ $c->components, $component, $c, @args
+ ) if !@result and ref $component;
+
+ # it expects an empty list on failed searches
+ return @result;
+}
+
+sub find_component_regexp {
+ my ( $self, $components, $component, @args ) = @_;
+ my @result;
+
+ my @components = grep { m{$component} } keys %{ $components };
+
+ for (@components) {
+ my ($type, $name) = _get_component_type_name($_);
+
+ push @result, $self->get_component_from_sub_container(
+ $type, $name, @args
+ ) if $type;
+ }
+
+ return @result;
+}
+
+# FIXME sorry for the name again :)
+sub get_components_types {
+ my ( $self ) = @_;
+ my @comps_types;
+
+ for my $sub_container_name (qw/model view controller/) {
+ my $sub_container = $self->get_sub_container($sub_container_name);
+ for my $service ( $sub_container->get_service_list ) {
+ my $comp = $self->resolve(service => $service);
+ my $compname = ref $comp || $comp;
+ my $type = ref $comp ? 'instance' : 'class';
+ push @comps_types, [ $compname, $type ];
+ }
+ }
+
+ return @comps_types;
+}
+
+sub get_all_components {
+ my $self = shift;
+ my %components;
+
+ my $containers = {
+ map { $_ => $self->get_sub_container($_) } qw(model view controller)
+ };
+
+ for my $container (keys %$containers) {
+ for my $component ($containers->{$container}->get_service_list) {
+ my $comp = $containers->{$container}->resolve(
+ service => $component
+ );
+ my $comp_name = ref $comp || $comp;
+ $components{$comp_name} = $comp;
+ }
+ }
+
+ return lock_hash %components;
+}
+
+sub add_component {
+ my ( $self, $component, $class ) = @_;
+ my ( $type, $name ) = _get_component_type_name($component);
+
+ return unless $type;
+
+ $self->get_sub_container($type)->add_service(
+ Catalyst::IOC::BlockInjection->new(
+ name => $name,
+ block => sub { $self->setup_component( $component, $class ) },
+ )
+ );
+}
+
+# FIXME: should this sub exist?
+# should it be moved to Catalyst::Utils,
+# or replaced by something already existing there?
+sub _get_component_type_name {
+ my ( $component ) = @_;
+
+ my @parts = split /::/, $component;
+
+ while (my $type = shift @parts) {
+ return ('controller', join '::', @parts)
+ if $type =~ /^(c|controller)$/i;
+
+ return ('model', join '::', @parts)
+ if $type =~ /^(m|model)$/i;
+
+ return ('view', join '::', @parts)
+ if $type =~ /^(v|view)$/i;
+ }
+
+ return (undef, $component);
+}
+
+# FIXME ugly and temporary
+# Just moved it here the way it was, so we can work on it here in the container
+sub setup_component {
+ my ( $self, $component, $class ) = @_;
+
+ unless ( $component->can( 'COMPONENT' ) ) {
+ return $component;
+ }
+
+ # FIXME I know this isn't the "Dependency Injection" way of doing things,
+ # its just temporary
+ my $suffix = Catalyst::Utils::class2classsuffix( $component );
+ my $config = $self->resolve(service => '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 ); };
+
+ if ( my $error = $@ ) {
+ chomp $error;
+ Catalyst::Exception->throw(
+ message => qq/Couldn't instantiate component "$component", "$error"/
+ );
+ }
+ elsif (!blessed $instance) {
+ my $metaclass = Moose::Util::find_meta($component);
+ my $method_meta = $metaclass->find_method_by_name('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;
+}
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Container - IOC for Catalyst components
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head1 Containers
+
+=head2 build_model_subcontainer
+
+Container that stores all models.
+
+=head2 build_view_subcontainer
+
+Container that stores all views.
+
+=head2 build_controller_subcontainer
+
+Container that stores all controllers.
+
+=head1 Services
+
+=head2 build_name_service
+
+Name of the application.
+
+=head2 build_driver_service
+
+Config options passed directly to the driver being used.
+
+=head2 build_file_service
+
+?
+
+=head2 build_substitutions_service
+
+Executes all the substitutions in config. See L</_config_substitutions> method.
+
+=head2 build_extensions_service
+
+=head2 build_prefix_service
+
+=head2 build_path_service
+
+=head2 build_config_service
+
+=head2 build_raw_config_service
+
+=head2 build_global_files_service
+
+=head2 build_local_files_service
+
+=head2 build_global_config_service
+
+=head2 build_local_config_service
+
+=head2 build_config_path_service
+
+=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 get_component_from_sub_container($sub_container, $name, $c, @args)
+
+Looks for components in a given subcontainer (such as controller, model or view), and returns the searched component. If $name is undef, it returns the default component (such as default_view, if $sub_container is 'view'). If $name is a regexp, it returns an array of matching components. Otherwise, it looks for the component with name $name.
+
+=head2 get_components_types
+
+=head2 get_all_components
+
+Fetches all the components, in each of the sub_containers model, view and controller, and returns a readonly hash. The keys are the class names, and the values are the blessed objects. This is what is returned by $c->components.
+
+=head2 add_component
+
+Adds a component to the appropriate subcontainer. The subcontainer is guessed by the component name given.
+
+=head2 find_component
+
+Searches for components in all containers. If $component is the full class name, the subcontainer is guessed, and it gets the searched component in there. Otherwise, it looks for a component with that name in all subcontainers. If $component is a regexp, it calls the method below, find_component_regexp, and matches all components against that regexp.
+
+=head2 find_component_regexp
+
+Finds components that match a given regexp. Used internally, by find_component.
+
+=head2 setup_component
+
+=head2 _fix_syntax
+
+=head2 _config_substitutions
+
+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-E<gt>config-E<gt>{ 'Plugin::ConfigLoader' }-E<gt>{ 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.
+
+=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;
+
+with 'Bread::Board::Service';
+
+has accept_context_sub => (
+ is => 'ro',
+ isa => 'Str',
+ default => 'ACCEPT_CONTEXT',
+);
+
+around 'get' => sub {
+ my ( $orig, $self, %params ) = @_;
+
+ my $accept_context_args = delete $params{accept_context_args};
+
+ my $instance = $self->$orig(%params);
+ my $ac_sub = $self->accept_context_sub;
+
+ if ( $accept_context_args && $instance->can($ac_sub) ) {
+ return $instance->$ac_sub( @$accept_context_args );
+ }
+
+ return $instance;
+};
+
+no Moose::Role;
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::Service::WithContext
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over
+
+=item B<accept_context_sub>
+
+=item B<get>
+
+=back
+
+=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;
+use Catalyst::IOC::BlockInjection;
+
+extends 'Bread::Board::Container';
+
+has default_component => (
+ isa => 'Str|Undef',
+ is => 'ro',
+ required => 0,
+ writer => '_set_default_component',
+);
+
+sub get_component {
+ my ( $self, $name, @args ) = @_;
+
+ return $self->resolve(
+ service => $name,
+ parameters => { accept_context_args => \@args },
+ );
+}
+
+sub get_component_regexp {
+ my ( $self, $query, $c, @args ) = @_;
+
+ my @result = map {
+ $self->get_component( $_, $c, @args )
+ } grep { m/$query/ } $self->get_service_list;
+
+ return @result;
+}
+
+# FIXME - is this sub ok?
+# is the name ok too?
+sub make_single_default {
+ my ( $self ) = @_;
+
+ my @complist = $self->get_service_list;
+
+ $self->_set_default_component( shift @complist )
+ if !$self->default_component && scalar @complist == 1;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catalyst::IOC::SubContainer - Container for models, controllers and views
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 get_component
+
+Gets the service of the container for the searched component. Also executes the ACCEPT_CONTEXT sub in the component, if it exists.
+
+=head2 get_component_regexp
+
+Gets all components from container that match a given regexp.
+
+=head2 make_single_default
+
+If the container has only one component, and no default has been defined, this method makes that one existing service the default.
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This library is free software. You can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
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 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;
-
-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 Test::More tests => 22;
+use Test::More;
use strict;
use warnings;
# 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( [ MyApp->comp( qr{Model} ) ], [ 'MyApp::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( [ MyApp->comp('::M::Model') ], \@complist, 'no reulsts for regexp fallback');
ok( $warnings, 'regexp fallback warnings' );
-
- $warnings = 0;
- is(MyApp->comp('::M::'), 'MyApp::M::Model', 'Regex return ok');
- ok( $warnings, 'regexp fallback for comp() warns' );
}
}
$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;
+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;
+# FIXME should the app class really be included in ->components?
# the +1 below is for the app class itself
is(scalar keys %$complist, 24+1, "Correct number of components loaded");
__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;
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',
+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;
+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 @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
+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');
+use Moose::Meta::Class;
-my @complist =
- map { "MyMVCTestApp::$_"; }
- qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/;
+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 } );
+ sub locate_components {
+ return (@complist, 'MyMVCTestApp::Model::Test::Object');
+ }
- my $thingie={};
- bless $thingie, 'Some::Test::Object';
- __PACKAGE__->components->{'MyMVCTestApp::Model::Test::Object'} = $thingie;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+ local *Catalyst::Utils::ensure_class_loaded = sub {
+ my $class = shift;
+ $loaded++
+ if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestApp/
+ };
- # allow $c->log->warn to work
- __PACKAGE__->setup_log;
+ __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/;
+
+ sub locate_components {
+ return @complist_default_view;
+ }
+
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+ local *Catalyst::Utils::ensure_class_loaded = sub {
+ my $class = shift;
+ $loaded++
+ if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestAppDefaultView/
+ };
+
+ __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/;
+
+ sub locate_components {
+ return @complist_default_model;
+ }
+
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+ local *Catalyst::Utils::ensure_class_loaded = sub {
+ my $class = shift;
+ $loaded++
+ if Class::MOP::is_class_loaded($class) && $class =~ /^MyMVCTestAppDefaultModel/
+ };
+
+ __PACKAGE__->config( default_model => 'M' );
+
+ __PACKAGE__->setup;
+}
-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');
+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' );
}
{
# 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;
--- /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',
--- /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)__',
+}
--- /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 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;
-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;
projects / catagits/Catalyst-Runtime.git / commitdiff