From: Dave Rolsky <autarch@urth.org>
Date: Thu, 17 Dec 2009 20:01:52 +0000 (-0600)
Subject: Give role attributes stub methods, which could be useful for future improvements... 
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2c2c1d21b0f84c74f5ebfb17d3fea830e556d28e;p=gitmo%2FMoose.git

Give role attributes stub methods, which could be useful for future improvements to attrs in roles
---

diff --git a/lib/Moose/Meta/Attribute/Trait/InRole.pm b/lib/Moose/Meta/Attribute/Trait/InRole.pm
index f464098..803376f 100644
--- a/lib/Moose/Meta/Attribute/Trait/InRole.pm
+++ b/lib/Moose/Meta/Attribute/Trait/InRole.pm
@@ -8,6 +8,8 @@ use Scalar::Util 'blessed', 'weaken';
 our $VERSION   = '0.93';
 our $AUTHORITY = 'cpan:STEVAN';
 
+use Moose::Meta::Method::Stub;
+
 around attach_to_class => sub {
     shift;
     my ( $self, $class ) = @_;
@@ -19,10 +21,13 @@ around attach_to_class => sub {
     weaken( $self->{'associated_class'} = $class );
 };
 
-# XXX - This is a no-op, since trying to add accessors to a role just blows
-# up. Ideally, we _would_ add accessors, or somehow make the role aware that
-# they exist for the purposes of method conflict checking, etc.
-around install_accessors => sub { };
+around 'accessor_metaclass' => sub {
+    return 'Moose::Meta::Method::Stub';
+};
+
+around 'delegation_metaclass' => sub {
+    return 'Moose::Meta::Method::Stub';
+};
 
 around _check_associated_methods => sub { };
 
diff --git a/lib/Moose/Meta/Method/Stub.pm b/lib/Moose/Meta/Method/Stub.pm
new file mode 100644
index 0000000..ab5d1ae
--- /dev/null
+++ b/lib/Moose/Meta/Method/Stub.pm
@@ -0,0 +1,70 @@
+package Moose::Meta::Method::Stub;
+
+use strict;
+use warnings;
+
+use Carp 'confess';
+
+our $VERSION   = '0.93';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method';
+
+sub new {
+    my $class   = shift;
+    my %options = @_;
+
+    ( $options{package_name} && $options{name} )
+        || confess "You must supply the package_name and name parameters";
+
+    return bless {
+
+        # inherited from Class::MOP::Method
+        body         => sub { },
+        package_name => $options{package_name},
+        name         => $options{name},
+    }, $class;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Meta::Method::Accessor - A Moose Method metaclass for accessors
+
+=head1 DESCRIPTION
+
+This class is a subclass of L<Class::MOP::Method::Accessor> that
+provides additional Moose-specific functionality, all of which is
+private.
+
+To understand this class, you should read the the
+L<Class::MOP::Method::Accessor> documentation.
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2009 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/t/030_roles/044_accessor_methods.t b/t/030_roles/044_accessor_methods.t
new file mode 100644
index 0000000..83327a7
--- /dev/null
+++ b/t/030_roles/044_accessor_methods.t
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+    package Role;
+
+    use Moose::Role;
+
+    has foo => ( reader => 'foo', writer => 'set_foo', handles => ['bar'] );
+}
+
+my $meta = Role->meta;
+ok( $meta->has_method('foo'), 'Role has a meta method for foo reader' );
+ok(
+    $meta->get_method('foo')->isa('Moose::Meta::Method::Stub'),
+    'meta method is a Stub'
+);
+
+ok( $meta->has_method('set_foo'), 'Role has a meta method for foo writer' );
+ok(
+    $meta->get_method('set_foo')->isa('Moose::Meta::Method::Stub'),
+    'meta method is a Stub'
+);
+
+ok( $meta->has_method('bar'), 'Role has a meta method for foo delegation' );
+ok(
+    $meta->get_method('bar')->isa('Moose::Meta::Method::Stub'),
+    'meta method is a Stub'
+);
+
+done_testing;