From: Stevan Little Date: Tue, 3 Jul 2007 05:56:13 +0000 (+0000) Subject: handles => A::Role X-Git-Tag: 0_24~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c84f324f828ad00e6ccf2ace23d56d6bedecdfa3;p=gitmo%2FMoose.git handles => A::Role --- diff --git a/Changes b/Changes index b632be5..857e0b3 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,13 @@ Revision history for Perl extension Moose 0.24 + ~ doc updates ~ + + * Moose::Meta::Attribute + - added support for roles to be given as parameters + to the 'handles' option. + - added tests and docs for this + * Moose::Meta::Role - required methods are now fetched using find_method_by_name so that required methods can come from superclasses diff --git a/lib/Moose.pm b/lib/Moose.pm index 4921992..a4e670b 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -454,7 +454,7 @@ updated value and the attribute meta-object (this is for more advanced fiddling and can typically be ignored). You B have a trigger on a read-only attribute. -=item I ARRAY | HASH | REGEXP | CODE> +=item I ARRAY | HASH | REGEXP | ROLE | CODE> The I option provides Moose classes with automated delegation features. This is a pretty complex and powerful option. It accepts many different option @@ -537,6 +537,14 @@ B An I option is required when using the regexp option format. This is so that we can determine (at compile time) the method list from the class. Without an I this is just not possible. +=item C + +With the role option, you specify the name of a role whose "interface" then +becomes the list of methods to handle. The "interface" can be defined as; the +methods of the role and any required methods of the role. It should be noted +that this does B include any method modifiers or generated attribute +methods (which is consistent with role composition). + =item C This is the option to use when you really want to do something funky. You should @@ -676,32 +684,6 @@ to work. Here is an example: no Moose; # keywords are removed from the Person package -=head1 MISC. - -=head2 What does Moose stand for?? - -Moose doesn't stand for one thing in particular. However, if you -want, here are a few of my favorites; feel free to contribute -more :) - -=over 4 - -=item Make Other Object Systems Envious - -=item Makes Object Orientation So Easy - -=item Makes Object Orientation Spiffy- Er (sorry ingy) - -=item Most Other Object Systems Emasculate - -=item Moose Often Ovulate Sorta Early - -=item Moose Offers Often Super Extensions - -=item Meta Object Orientation Syntax Extensions - -=back - =head1 CAVEATS =over 4 @@ -720,7 +702,7 @@ when searching for its appropriate C. This might seem like a restriction, but I am of the opinion that keeping these two features separate (yet interoperable) actually makes them easy to use, since their behavior is then easier to predict. Time will tell whether I am right or -not. +not (UPDATE: so far so good). =back @@ -739,7 +721,7 @@ and it certainly wouldn't have this name ;P originally, I just ran with it. =item Thanks to mst & chansen and the whole #moose poose for all the -ideas/feature-requests/encouragement/bug-finding. +early ideas/feature-requests/encouragement/bug-finding. =item Thanks to David "Theory" Wheeler for meta-discussions and spelling fixes. @@ -749,13 +731,25 @@ ideas/feature-requests/encouragement/bug-finding. =over 4 +=item L + +This is the official web home of Moose, it contains links to our public SVN repo +as well as links to a number of talks and articles on Moose and Moose related +technologies. + =item L documentation =item The #moose channel on irc.perl.org =item The Moose mailing list - moose@perl.org -=item L +=item Moose stats on ohloh.net - L + +=back + +=head2 Papers + +=over 4 =item L diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 74ba8bf..a8365a4 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -7,7 +7,7 @@ use warnings; use Scalar::Util 'blessed', 'weaken', 'reftype'; use Carp 'confess'; -our $VERSION = '0.10'; +our $VERSION = '0.11'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Accessor; @@ -378,23 +378,39 @@ sub install_accessors { sub _canonicalize_handles { my $self = shift; my $handles = $self->handles; - if (ref($handles) eq 'HASH') { - return %{$handles}; - } - elsif (ref($handles) eq 'ARRAY') { - return map { $_ => $_ } @{$handles}; - } - elsif (ref($handles) eq 'Regexp') { - ($self->has_type_constraint) - || confess "Cannot delegate methods based on a RegExpr without a type constraint (isa)"; - return map { ($_ => $_) } - grep { /$handles/ } $self->_get_delegate_method_list; - } - elsif (ref($handles) eq 'CODE') { - return $handles->($self, $self->_find_delegate_metaclass); + if (my $handle_type = ref($handles)) { + if ($handle_type eq 'HASH') { + return %{$handles}; + } + elsif ($handle_type eq 'ARRAY') { + return map { $_ => $_ } @{$handles}; + } + elsif ($handle_type eq 'Regexp') { + ($self->has_type_constraint) + || confess "Cannot delegate methods based on a RegExpr without a type constraint (isa)"; + return map { ($_ => $_) } + grep { /$handles/ } $self->_get_delegate_method_list; + } + elsif ($handle_type eq 'CODE') { + return $handles->($self, $self->_find_delegate_metaclass); + } + else { + confess "Unable to canonicalize the 'handles' option with $handles"; + } } else { - confess "Unable to canonicalize the 'handles' option with $handles"; + my $role_meta = eval { $handles->meta }; + if ($@) { + confess "Unable to canonicalize the 'handles' option with $handles because : $@"; + } + + (blessed $role_meta && $role_meta->isa('Moose::Meta::Role')) + || confess "Unable to canonicalize the 'handles' option with $handles because ->meta is not a Moose::Meta::Role"; + + return map { $_ => $_ } ( + $role_meta->get_method_list, + $role_meta->get_required_method_list + ); } } diff --git a/t/039_attribute_delegation.t b/t/039_attribute_delegation.t index 0857453..c9237cd 100644 --- a/t/039_attribute_delegation.t +++ b/t/039_attribute_delegation.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 46; +use Test::More tests => 54; use Test::Exception; BEGIN { @@ -175,4 +175,47 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop'); is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value'); } +{ + package Foo::Bar; + use Moose::Role; + + requires 'foo'; + requires 'bar'; + + package Foo::Baz; + use Moose; + + sub foo { 'Foo::Baz::FOO' } + sub bar { 'Foo::Baz::BAR' } + sub baz { 'Foo::Baz::BAZ' } + + package Foo::Thing; + use Moose; + + has 'thing' => ( + is => 'rw', + isa => 'Foo::Baz', + handles => 'Foo::Bar', + ); + +} + +{ + my $foo = Foo::Thing->new(thing => Foo::Baz->new); + isa_ok($foo, 'Foo::Thing'); + isa_ok($foo->thing, 'Foo::Baz'); + + ok($foo->meta->has_method('foo'), '... we have the method we expect'); + ok($foo->meta->has_method('bar'), '... we have the method we expect'); + ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect'); + + is($foo->foo, 'Foo::Baz::FOO', '... got the right value'); + is($foo->bar, 'Foo::Baz::BAR', '... got the right value'); + is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value'); +} + + + + +