Actually implement associated_attribute for delegation methods, and

test it.

Add docs for Moose::Meta::Method::Delegation.

diff --git a/lib/Moose/Meta/Method/Delegation.pm b/lib/Moose/Meta/Method/Delegation.pm
index b24579b..49449ce 100644 (file)
--- a/lib/Moose/Meta/Method/Delegation.pm
+++ b/lib/Moose/Meta/Method/Delegation.pm
@@ -21,8 +21,8 @@ sub new {
     (exists $options{attribute})
         || confess "You must supply an attribute to construct with";
 
-    (blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
-        || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
+    (blessed($options{attribute}) && $options{attribute}->isa('Moose::Meta::Attribute'))
+        || confess "You must supply an attribute which is a 'Moose::Meta::Attribute' instance";
 
     ($options{package_name} && $options{name})
         || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
@@ -34,4 +34,71 @@ sub new {
     return $self;
 }
 
+sub _new {
+    my $class = shift;
+    my $options = @_ == 1 ? $_[0] : {@_};
+
+    return bless $options, $class;
+}
+
+sub associated_attribute { (shift)->{'attribute'} }
+
 1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Moose::Meta::Method::Delegation - A Moose Method metaclass for delegation methods
+
+=head1 DESCRIPTION
+
+This is a subclass of L<Moose::Meta::Method> for delegation
+methods.
+
+=head1 METHODS
+
+=over 4
+
+=item B<new (%options)>
+
+This creates the method based on the criteria in C<%options>,
+these options are:
+
+=over 4
+
+=item I<attribute>
+
+This must be an instance of C<Moose::Meta::Attribute> which this
+accessor is being generated for. This paramter is B<required>.
+
+=back
+
+=item B<associated_attribute>
+
+Returns the attribute associated with this method.
+
+=back
+
+=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
+
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2008 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/020_attributes/010_attribute_delegation.t b/t/020_attributes/010_attribute_delegation.t
index 6eaf355..ed75c6f 100644 (file)
--- a/t/020_attributes/010_attribute_delegation.t
+++ b/t/020_attributes/010_attribute_delegation.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 85;
+use Test::More tests => 86;
 use Test::Exception;
 
 
@@ -37,7 +37,10 @@ isa_ok($bar, 'Bar');
 ok($bar->foo, '... we have something in bar->foo');
 isa_ok($bar->foo, 'Foo');
 
-isa_ok(Bar->meta->get_method('foo_bar'), 'Moose::Meta::Method::Delegation');
+my $meth = Bar->meta->get_method('foo_bar');
+isa_ok($meth, 'Moose::Meta::Method::Delegation');
+is($meth->associated_attribute->name, 'foo',
+   'associated_attribute->name for this method is foo');
 
 is($bar->foo->bar, 10, '... bar->foo->bar returned the right default');