From: Matt S Trout Date: Fri, 6 Apr 2012 20:02:09 +0000 (+0000) Subject: with "MooseRole"; X-Git-Tag: v0.009_015~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a84066c7ced4f66e5e5c3bbd1c9ac549528cf165;p=gitmo%2FMoo.git with "MooseRole"; --- diff --git a/Changes b/Changes index 80cdb94..ff86051 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,4 @@ + - Allow Moo classes to compose Moose roles - Introduce Moo::HandleMoose, which should allow Moo classes and roles to be treated as Moose classes/roles. Supported so far: - Some level of attributes and methods for both classes and roles diff --git a/lib/Moo/Role.pm b/lib/Moo/Role.pm index 71ee793..e55836d 100644 --- a/lib/Moo/Role.pm +++ b/lib/Moo/Role.pm @@ -28,8 +28,55 @@ sub import { goto &Role::Tiny::import; } +sub _inhale_if_moose { + my ($self, $role) = @_; + _load_module($role); + if (!$INFO{$role} and $INC{"Moose.pm"}) { + if (my $meta = Class::MOP::class_of($role)) { + $INFO{$role}{methods} = { + map +($_ => $role->can($_)), $meta->get_method_list + }; + $Role::Tiny::APPLIED_TO{$role} = { + map +($_->name => 1), $meta->calculate_all_roles + }; + $INFO{$role}{requires} = [ $meta->get_required_method_list ]; + $INFO{$role}{attributes} = { + map +($_ => $meta->get_attribute($_)), $meta->get_attribute_list + }; + my $mods = $INFO{$role}{modifiers} = []; + foreach my $type (qw(before after around)) { + my $map = $meta->${\"get_${type}_method_modifiers_map"}; + foreach my $method (keys %$map) { + foreach my $mod (@{$map->{$method}}) { + push @$mods, [ $type => $method => $mod ]; + } + } + } + require Class::Method::Modifiers if @$mods; + $INFO{$role}{inhaled_from_moose} = 1; + } + } +} + +sub _make_accessors_if_moose { + my ($self, $role, $target) = @_; + if ($INFO{$role}{inhaled_from_moose}) { + if (my $attrs = $INFO{$role}{attributes}) { + my $acc_gen = ($Moo::MAKERS{$target}{accessor} ||= do { + require Method::Generate::Accessor; + Method::Generate::Accessor->new + }); + foreach my $name (keys %{$attrs}) { + $acc_gen->generate_method($target, $name, $attrs->{$name}); + } + } + } +} + sub apply_role_to_package { my ($me, $to, $role) = @_; + $me->_inhale_if_moose($role); + $me->_make_accessors_if_moose($role, $to); $me->SUPER::apply_role_to_package($to, $role); $me->_handle_constructor($to, $INFO{$role}{attributes}); } @@ -43,6 +90,8 @@ sub create_class_with_roles { return $new_name if $Role::Tiny::COMPOSED{class}{$new_name}; + $me->_inhale_if_moose($_) for @roles; + require Sub::Quote; $me->SUPER::create_class_with_roles($superclass, @roles); @@ -60,6 +109,14 @@ sub create_class_with_roles { return $new_name; } +sub _composable_package_for { + my ($self, $role) = @_; + my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role; + return $composed_name if $Role::Tiny::COMPOSED{role}{$composed_name}; + $self->_make_accessors_if_moose($role, $composed_name); + $self->SUPER::_composable_package_for($role); +} + sub _install_single_modifier { my ($me, @args) = @_; _install_modifier(@args); diff --git a/xt/moo-does-moose-role.t b/xt/moo-does-moose-role.t new file mode 100644 index 0000000..6db3919 --- /dev/null +++ b/xt/moo-does-moose-role.t @@ -0,0 +1,39 @@ +use strictures 1; +use Test::More; + +BEGIN { + package Splat; + + use Moose::Role; + + requires 'monkey'; + + sub punch { 1 } + + sub jab { 0 } + + around monkey => sub { 'OW' }; + + has trap => (is => 'ro', default => sub { -1 }); +} + +BEGIN { + package Splattered; + + use Moo; + + sub monkey { 'WHAT' } + + with 'Splat'; + + sub jab { 3 } +} + +my $s = Splattered->new; + +is($s->punch, 1, 'punch'); +is($s->jab, 3, 'jab'); +is($s->monkey, 'OW', 'monkey'); +is($s->trap, -1, 'trap'); + +done_testing;