[Catalyst] Config-only components

[Dagfinn Ilmari Mannsåker]

Hi all,

Castaway mentioned the idea of having components defined entirely by
config entries, without the need for any actual class files on disk, and
I was bored, so I went ahead and implemented it.

For each config key matching ^([MVC]|Model|View|Controller):: it checks
if the corresponding component already exists, and if it doesn't it
creates it on the fly. The base class is set to
->config->{$component}->{base_class} if it exists, Catalyst::$component
(with [MVC] expanded to the full component type) otherwise.

Here's the patch against 5.70/trunk, feedback welcome.

 lib/Catalyst.pm                       |   51 ++++++++++++++++++++++++++--------
 lib/Catalyst/Utils.pm                 |   23 +++++++++++++++
 t/lib/Catalyst/Component/Implicit.pm  |   16 ++++++++++
 t/lib/Catalyst/Controller/Implicit.pm |    4 ++
 t/lib/Catalyst/Model/Implicit.pm      |    4 ++
 t/lib/Catalyst/View/Implicit.pm       |    4 ++
 t/unit_core_component_dynamic.t       |   31 ++++++++++++++++++++
 7 files changed, 121 insertions(+), 12 deletions(-)

=== lib/Catalyst/Utils.pm
==================================================================
--- lib/Catalyst/Utils.pm	(revision 36505)
+++ lib/Catalyst/Utils.pm	(local)
@@ -79,6 +79,29 @@
     return $class;
 }
 
+=head2 expand_component_type( $class );
+
+Replaces M, V and C components of the class name with Model, View and
+Controller, respectively.
+
+     MyApp::C::Foo becomes MyApp::Controller::Foo
+     My::App::C::Foo becomes Mapp::Controller::Foo
+
+=cut
+
+sub expand_component_type {
+    my ($class) = @_;
+
+    my %expand = qw/ M Model
+                     V View
+                     C Controller
+                   /;
+
+    $class =~ s/(?<=::)([MVC])(?=::)/$expand{$1}/;
+
+    return $class;
+}
+
 =head2 class2env($class);
 
 Returns the environment name for class.
=== lib/Catalyst.pm
==================================================================
--- lib/Catalyst.pm	(revision 36505)
+++ lib/Catalyst.pm	(local)
@@ -1878,19 +1878,46 @@
 
         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
 
-        my $module  = $class->setup_component( $component );
-        my %modules = (
-            $component => $module,
-            map {
-                $_ => $class->setup_component( $_ )
-            } grep { 
-              not exists $comps{$_}
-            } Devel::InnerPackage::list_packages( $component )
-        );
+        $class->_load_component_and_children( $component, \%comps );
+    }
+
+    # For component-esque config keys with no corresponding module yet
+    # loaded, try to create it on the fly.
+
+    my $prefix = join '|', map { m/::(.*)/ } @paths;
+    my @config_comps =  grep /^(?:$prefix)::/, keys %{ $class->config };
+    $comps{"$class\::$_"} = 1 for @config_comps;
+
+    for my $suffix ( @config_comps  ) {
+        my $component = "$class\::$suffix";
+
+        next if $class->components->{ $component };
+
+        my $base = delete $class->config->{ $suffix }->{ base_class }
+            || Catalyst::Utils::expand_component_type("Catalyst::$suffix");
+
+        Catalyst::Utils::ensure_class_loaded( $base );
+        { no strict 'refs'; unshift @{"$component\::ISA"}, $base }
+
+        $class->_load_component_and_children( $component, \%comps );
+    }
+}
+
+sub _load_component_and_children {
+    my ($class, $component, $comps) = @_;
+
+    my $module  = $class->setup_component( $component );
+    my %modules = (
+        $component => $module,
+        map {
+            $_ => $class->setup_component( $_ )
+        } grep { 
+            not exists $comps->{$_}
+        } Devel::InnerPackage::list_packages( $component )
+    );
         
-        for my $key ( keys %modules ) {
-            $class->components->{ $key } = $modules{ $key };
-        }
+    for my $key ( keys %modules ) {
+        $class->components->{ $key } = $modules{ $key };
     }
 }
 
=== t/lib/Catalyst/Component	(new directory)
==================================================================
=== t/lib/Catalyst/Component/Implicit.pm
==================================================================
--- t/lib/Catalyst/Component/Implicit.pm	(revision 36505)
+++ t/lib/Catalyst/Component/Implicit.pm	(local)
@@ -0,0 +1,16 @@
+package Catalyst::Component::Implicit;
+use base qw/Catalyst::Component/;
+
+use Catalyst::Utils;
+
+sub COMPONENT {
+    my ($self, $c, $arguments) = @_;
+    my $class = ref $self || $self;
+
+    # Inject an inner package intoto the subclass
+    { no strict 'refs'; @{"$class\::Sub::ISA"} = @{"$class\::ISA"} }
+
+    return $self->NEXT::COMPONENT( $c, $arguments );
+}
+
+1;
=== t/lib/Catalyst/Controller	(new directory)
==================================================================
=== t/lib/Catalyst/Controller/Implicit.pm
==================================================================
--- t/lib/Catalyst/Controller/Implicit.pm	(revision 36505)
+++ t/lib/Catalyst/Controller/Implicit.pm	(local)
@@ -0,0 +1,4 @@
+package Catalyst::Controller::Implicit;
+use base qw/Catalyst::Component::Implicit Catalyst::Controller/;
+
+1;
=== t/lib/Catalyst/Model	(new directory)
==================================================================
=== t/lib/Catalyst/Model/Implicit.pm
==================================================================
--- t/lib/Catalyst/Model/Implicit.pm	(revision 36505)
+++ t/lib/Catalyst/Model/Implicit.pm	(local)
@@ -0,0 +1,4 @@
+package Catalyst::Model::Implicit;
+use base qw/Catalyst::Component::Implicit Catalyst::Model/;
+
+1;
=== t/lib/Catalyst/View	(new directory)
==================================================================
=== t/lib/Catalyst/View/Implicit.pm
==================================================================
--- t/lib/Catalyst/View/Implicit.pm	(revision 36505)
+++ t/lib/Catalyst/View/Implicit.pm	(local)
@@ -0,0 +1,4 @@
+package Catalyst::View::Implicit;
+use base qw/Catalyst::Component::Implicit Catalyst::View/;
+
+1;
=== t/unit_core_component_dynamic.t
==================================================================
--- t/unit_core_component_dynamic.t	(revision 36505)
+++ t/unit_core_component_dynamic.t	(local)
@@ -0,0 +1,31 @@
+use Test::More tests => 24;
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+{
+    package MyApp;
+
+    use base qw/Catalyst/;
+
+    __PACKAGE__->config(
+        map { +"$_\::Explicit" => { base_class => "Catalyst::$_" },
+              +"$_\::Explicit::Sub" => { base_class => "Catalyst::$_" },
+              +"$_\::Implicit" => {},
+            } qw/Model View Controller/
+    );
+    __PACKAGE__->setup;
+}
+
+for my $comp (qw/Model View Controller/) {
+    my  $method = lc $comp;
+    for my $type (qw/Explicit Implicit/) {
+        isa_ok(MyApp->$method("$type"), "MyApp::$comp\::$type");
+        isa_ok(MyApp->$method("$type"), "Catalyst::$comp");
+        isa_ok(MyApp->$method("$type\::Sub"), "MyApp::$comp\::$type\::Sub");
+        isa_ok(MyApp->$method("$type\::Sub"), "Catalyst::$comp");
+    }
+}



-- 
ilmari
"A disappointingly low fraction of the human race is,
 at any given time, on fire." - Stig Sandbeck Mathisen