From: t0m Date: Fri, 24 Apr 2009 22:51:16 +0000 (+0100) Subject: Did I mention that I'm rubbish at naming things. I'll start caring about that when... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8c228ad4c7212c188e6b9354efeeada8480d4d2c;hp=065fbd8103cf114bd97de10f0df0a5928c663b95;p=catagits%2FCatalystX-DynamicComponent.git Did I mention that I'm rubbish at naming things. I'll start caring about that when I start pulling this shit apart into components for the CPAN when it's past prototype stage. Add stuff to give me syntax to generate methods with a custom metaclass, so that when I introspect - I don't have to use a fucking regex to work out what methods to exclude. We could then sanely support role application, which would be nice - although doing modifiers right is hard. This is also waaay more involved than it should need to be. --- diff --git a/lib/CatalystX/ControllerGeneratingModel.pm b/lib/CatalystX/ControllerGeneratingModel.pm new file mode 100644 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 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 --- 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;