Fixes to model/view/controller methods from Brandon Black

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 981b20f..54ff187 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -346,6 +346,59 @@ sub stash {
 
 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)
@@ -374,29 +427,11 @@ sub component {
               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 };
@@ -412,9 +447,7 @@ Gets a L<Catalyst::Controller> instance by name.
 
 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)
@@ -427,9 +460,7 @@ Gets a L<Catalyst::Model> instance by 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)
@@ -442,9 +473,7 @@ Gets a L<Catalyst::View> instance by 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

diff --git a/t/unit_core_component_loading.t b/t/unit_core_component_loading.t
new file mode 100644 (file)
index 0000000..a01edf0
--- /dev/null
+++ b/t/unit_core_component_loading.t
@@ -0,0 +1,121 @@
+# 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);