From: Dave Rolsky <autarch@urth.org>
Date: Thu, 11 Sep 2008 20:39:22 +0000 (+0000)
Subject: Actually implement associated_attribute for delegation methods, and
X-Git-Tag: 0.58~34^2~18
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=01cd78f8093d58c0a9c8633ba0361a3340426e30;p=gitmo%2FMoose.git

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
--- 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
--- 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');