t/lib/CatalystX/ControllerGeneratingModel.pm

   1 package CatalystX::ControllerGeneratingModel;
   2
   3 # Stolen from doy - http://tozt.net/code/Bot-Games/lib/Bot/Games/OO.pm
   4 # Note, this code is not modifier safe, as it doesn't deal with wrapped methods.
   5
   6 use Moose ();
   7 use Moose::Exporter;
   8 use Moose::Util::MetaRole;
   9
  10 sub command { # This takes way too much code, surely there must be a better way to
  11               # do it?
  12     my $class = shift;
  13     my ($name, $code, %args) = @_;
  14     my $method_meta = $class->meta->get_method($name);
  15     my $superclass = Moose::blessed($method_meta) || 'Moose::Meta::Method';
  16     my $method_metaclass = Moose::Meta::Class->create_anon_class(
  17         superclasses => [$superclass],
  18         roles        => ['CatalystX::ControllerGeneratingModel::DispatchableMethod'],
  19         cache        => 1,
  20     );
  21     if ($method_meta) {
  22         $method_metaclass->rebless_instance($method_meta);
  23     }
  24     else {
  25         $method_meta = $method_metaclass->name->wrap(
  26             $code,
  27             package_name => $class,
  28             name         => $name,
  29         );
  30         $class->meta->add_method($name, $method_meta);
  31     }
  32 }
  33
  34 Moose::Exporter->setup_import_methods(
  35     with_caller => ['command'],
  36     also        => ['Moose'],
  37 );
  38
  39 sub init_meta {
  40     shift;
  41     my %options = @_;
  42     Moose->init_meta(%options);
  43 #    Moose::Util::MetaRole::apply_metaclass_roles(
  44 #        for_class                 => $options{for_class},
  45 #        attribute_metaclass_roles => ['FooBar::Meta::Role::Attribute'],
  46 #        metaclass_roles           => ['FooBar::Meta::Role::Class'],
  47 #    );
  48     return $options{for_class}->meta;
  49 }
  50
  51 1;
  52