Contains the return value of the last executed action.
+=cut
+
+# search via regex
+sub _comp_search {
+ my ($c, @names) = @_;
+
+ foreach my $name (@names) {
+ foreach my $component ( keys %{ $c->components } ) {
+ my $comp = $c->components->{$component} if $component =~ /$name/i;
+ if ($comp) {
+ if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
+ return $comp->ACCEPT_CONTEXT($c);
+ }
+ else { return $comp }
+ }
+ }
+ }
+
+ return undef;
+}
+
+# try explicit component names
+sub _comp_explicit {
+ my ($c, @names) = @_;
+
+ foreach my $try (@names) {
+ if ( exists $c->components->{$try} ) {
+ my $comp = $c->components->{$try};
+ if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
+ return $comp->ACCEPT_CONTEXT($c);
+ }
+ else { return $comp }
+ }
+ }
+
+ return undef;
+}
+
+# like component, but try just these prefixes before regex searching,
+# and do not try to return "sort keys %{ $c->components }"
+sub _comp_prefixes {
+ my ($c, $name, @prefixes) = @_;
+
+ my $appclass = ref $c || $c;
+
+ my @names = map { "${appclass}::${_}::${name}" } @prefixes;
+
+ my $comp = $c->_comp_explicit(@names);
+ return $comp if defined($comp);
+ $comp = $c->_comp_search($name);
+ return $comp;
+}
+
=head2 Component Accessors
=head2 $c->comp($name)
qw/Model M Controller C View V/
);
- foreach my $try (@names) {
-
- if ( exists $c->components->{$try} ) {
-
- my $comp = $c->components->{$try};
- if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
- return $comp->ACCEPT_CONTEXT($c);
- }
- else { return $comp }
- }
- }
-
- foreach my $component ( keys %{ $c->components } ) {
- my $comp;
- $comp = $c->components->{$component} if $component =~ /$name/i;
- if ($comp) {
- if ( ref $comp && $comp->can('ACCEPT_CONTEXT') ) {
- return $comp->ACCEPT_CONTEXT($c);
- }
- else { return $comp }
- }
- }
+ my $comp = $c->_comp_explicit(@names);
+ return $comp if defined($comp);
+ $comp = $c->_comp_search($name);
+ return $comp if defined($comp);
}
return sort keys %{ $c->components };
sub controller {
my ( $c, $name ) = @_;
- my $controller = $c->comp("Controller::$name");
- return $controller if defined $controller;
- return $c->comp("C::$name");
+ return $c->_comp_prefixes($name, qw/Controller C/);
}
=head2 $c->model($name)
sub model {
my ( $c, $name ) = @_;
- my $model = $c->comp("Model::$name");
- return $model if defined $model;
- return $c->comp("M::$name");
+ return $c->_comp_prefixes($name, qw/Model M/);
}
=head2 $c->view($name)
sub view {
my ( $c, $name ) = @_;
- my $view = $c->comp("View::$name");
- return $view if defined $view;
- return $c->comp("V::$name");
+ return $c->_comp_prefixes($name, qw/View V/);
}
=head2 Class data and helper classes
--- /dev/null
+# 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)
+use Test::More tests => 2 + 6 * 24;
+
+use strict;
+use warnings;
+
+use File::Spec;
+use File::Path;
+
+my $libdir = 'test_trash';
+unshift(@INC, $libdir);
+
+my $appclass = 'TestComponents';
+my @components = (
+ { type => 'Controller', prefix => 'C', name => 'Bar' },
+ { type => 'Controller', prefix => 'C', name => 'Foo::Bar' },
+ { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Bar' },
+ { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Foo::Bar' },
+ { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Bar::Foo' },
+ { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Foo' },
+ { type => 'Controller', prefix => 'Controller', name => 'Bar::Foo' },
+ { type => 'Controller', prefix => 'Controller', name => 'Foo' },
+ { type => 'Model', prefix => 'M', name => 'Bar' },
+ { type => 'Model', prefix => 'M', name => 'Foo::Bar' },
+ { type => 'Model', prefix => 'M', name => 'Foo::Foo::Bar' },
+ { type => 'Model', prefix => 'M', name => 'Foo::Foo::Foo::Bar' },
+ { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Bar::Foo' },
+ { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Foo' },
+ { type => 'Model', prefix => 'Model', name => 'Bar::Foo' },
+ { type => 'Model', prefix => 'Model', name => 'Foo' },
+ { type => 'View', prefix => 'V', name => 'Bar' },
+ { type => 'View', prefix => 'V', name => 'Foo::Bar' },
+ { type => 'View', prefix => 'V', name => 'Foo::Foo::Bar' },
+ { type => 'View', prefix => 'V', name => 'Foo::Foo::Foo::Bar' },
+ { type => 'View', prefix => 'View', name => 'Bar::Bar::Bar::Foo' },
+ { type => 'View', prefix => 'View', name => 'Bar::Bar::Foo' },
+ { type => 'View', prefix => 'View', name => 'Bar::Foo' },
+ { type => 'View', prefix => 'View', name => 'Foo' },
+);
+
+sub make_component_file {
+ my ($type, $prefix, $name) = @_;
+
+ my $compbase = "Catalyst::${type}";
+ my $fullname = "${appclass}::${prefix}::${name}";
+ my @namedirs = split(/::/, $name);
+ my $name_final = pop(@namedirs);
+ my @dir_list = ($libdir, $appclass, $prefix, @namedirs);
+ my $dir_ux = join(q{/}, @dir_list);
+ my $dir = File::Spec->catdir(@dir_list);
+ my $file = File::Spec->catfile($dir, $name_final . '.pm');
+
+ mkpath($dir_ux); # mkpath wants unix '/' seperators :p
+ open(my $fh, '>', $file) or die "Could not open file $file for writing: $!";
+ print $fh <<EOF;
+package $fullname;
+use base '$compbase';
+sub COMPONENT {
+ my \$self = shift->NEXT::COMPONENT(\@_);
+ no strict 'refs';
+ *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; };
+ \$self;
+}
+1;
+
+EOF
+
+ close($fh);
+}
+
+foreach my $component (@components) {
+ make_component_file($component->{type},
+ $component->{prefix},
+ $component->{name});
+}
+
+eval "package $appclass; use Catalyst; __PACKAGE__->setup";
+
+can_ok( $appclass, 'components');
+
+my $complist = $appclass->components;
+
+# the +1 below is for the app class itself
+is(scalar keys %$complist, 24+1, "Correct number of components loaded");
+
+foreach (keys %$complist) {
+
+ # Skip the component which happens to be the app itself
+ next if $_ eq $appclass;
+
+ my $instance = $appclass->component($_);
+ isa_ok($instance, $_);
+ can_ok($instance, 'whoami');
+ is($instance->whoami, $_);
+
+ if($_ =~ /^${appclass}::(?:V|View)::(.*)/) {
+ my $moniker = $1;
+ isa_ok($instance, 'Catalyst::View');
+ can_ok($appclass->view($moniker), 'whoami');
+ is($appclass->view($moniker)->whoami, $_);
+ }
+ elsif($_ =~ /^${appclass}::(?:M|Model)::(.*)/) {
+ my $moniker = $1;
+ isa_ok($instance, 'Catalyst::Model');
+ can_ok($appclass->model($moniker), 'whoami');
+ is($appclass->model($moniker)->whoami, $_);
+ }
+ elsif($_ =~ /^${appclass}::(?:C|Controller)::(.*)/) {
+ my $moniker = $1;
+ isa_ok($instance, 'Catalyst::Controller');
+ can_ok($appclass->controller($moniker), 'whoami');
+ is($appclass->controller($moniker)->whoami, $_);
+ }
+ else {
+ die "Something is wrong with this test, this should"
+ . " have been unreachable";
+ }
+}
+
+rmtree($libdir);