From: Matt S Trout Date: Sun, 26 Feb 2006 02:04:00 +0000 (+0000) Subject: Fixes to model/view/controller methods from Brandon Black X-Git-Tag: 5.7099_04~692 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=0756fe3bdd265109d7dcba43f1bef6430b9bfa02 Fixes to model/view/controller methods from Brandon Black --- diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 981b20f..54ff187 100644 --- 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 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 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 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 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 <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);