Did I mention that I'm rubbish at naming things. I'll start caring about that when...

diff --git a/lib/CatalystX/ControllerGeneratingModel.pm b/lib/CatalystX/ControllerGeneratingModel.pm
new file mode 100644 (file)
index 0000000..8b0e7d9
--- /dev/null
+++ b/lib/CatalystX/ControllerGeneratingModel.pm
@@ -0,0 +1,52 @@
+package CatalystX::ControllerGeneratingModel;
+
+# Stolen from doy - http://tozt.net/code/Bot-Games/lib/Bot/Games/OO.pm
+# Note, this code is not modifier safe, as it doesn't deal with wrapped methods.
+
+use Moose ();
+use Moose::Exporter;
+use Moose::Util::MetaRole;
+
+sub command { # This takes way too much code, surely there must be a better way to 
+              # do it?
+    my $class = shift;
+    my ($name, $code, %args) = @_;
+    my $method_meta = $class->meta->get_method($name);
+    my $superclass = Moose::blessed($method_meta) || 'Moose::Meta::Method';
+    my $method_metaclass = Moose::Meta::Class->create_anon_class(
+        superclasses => [$superclass],
+        roles        => ['CatalystX::ControllerGeneratingModel::DispatchableMethod'],
+        cache        => 1,
+    );
+    if ($method_meta) {
+        $method_metaclass->rebless_instance($method_meta);
+    }
+    else {
+        $method_meta = $method_metaclass->name->wrap(
+            $code,
+            package_name => $class,
+            name         => $name,
+        );
+        $class->meta->add_method($name, $method_meta);
+    }
+}
+
+Moose::Exporter->setup_import_methods(
+    with_caller => ['command'],
+    also        => ['Moose'],
+);
+
+sub init_meta {
+    shift;
+    my %options = @_;
+    Moose->init_meta(%options);
+#    Moose::Util::MetaRole::apply_metaclass_roles(
+#        for_class                 => $options{for_class},
+#        attribute_metaclass_roles => ['FooBar::Meta::Role::Attribute'],
+#        metaclass_roles           => ['FooBar::Meta::Role::Class'],
+#    );
+    return $options{for_class}->meta;
+}
+
+1;
+

diff --git a/lib/CatalystX/ControllerGeneratingModel/DispatchableMethod.pm b/lib/CatalystX/ControllerGeneratingModel/DispatchableMethod.pm
new file mode 100644 (file)
index 0000000..5d93095
--- /dev/null
+++ b/lib/CatalystX/ControllerGeneratingModel/DispatchableMethod.pm
@@ -0,0 +1,5 @@
+package CatalystX::ControllerGeneratingModel::DispatchableMethod;
+use Moose::Role;
+
+1;
+

diff --git a/lib/SomeModelClass.pm b/lib/SomeModelClass.pm
index 58ae394..e956815 100644 (file)
--- a/lib/SomeModelClass.pm
+++ b/lib/SomeModelClass.pm
@@ -1,5 +1,6 @@
 package SomeModelClass;
 use Moose;
+use CatalystX::ControllerGeneratingModel;
 use namespace::autoclean;
 
 # Note trivial calling convention.
@@ -8,10 +9,10 @@ use namespace::autoclean;
 # Introspection should only reflect methods which satisfy the calling convention
 # This is left as an exercise to the reader. :)
 
-sub say_hello {
+command say_hello => sub {
     my ($self, $name) = @_;
     return("Hello $name");
-}
+};
 
 __PACKAGE__->meta->make_immutable;