Store the role which first defines an attribute, and pass that along when cloning.
[gitmo/Moose.git] / lib / Moose / Meta / Role / Attribute.pm
CommitLineData
f785aad8 1package Moose::Meta::Role::Attribute;
2
3use strict;
4use warnings;
5
6use Carp 'confess';
7use List::MoreUtils 'all';
8use Scalar::Util 'blessed', 'weaken';
9
be83e895 10use base 'Moose::Meta::Mixin::AttributeCore', 'Class::MOP::Object';
f785aad8 11
12__PACKAGE__->meta->add_attribute(
13 'metaclass' => (
14 reader => 'metaclass',
15 )
16);
17
18__PACKAGE__->meta->add_attribute(
19 'associated_role' => (
20 reader => 'associated_role',
21 )
22);
23
24__PACKAGE__->meta->add_attribute(
3cfeb291 25 '_original_role' => (
26 reader => '_original_role',
27 )
28);
29
30__PACKAGE__->meta->add_attribute(
f785aad8 31 'is' => (
32 reader => 'is',
33 )
34);
35
36__PACKAGE__->meta->add_attribute(
37 'original_options' => (
38 reader => 'original_options',
39 )
40);
41
42sub new {
43 my ( $class, $name, %options ) = @_;
44
45 (defined $name)
46 || confess "You must provide a name for the attribute";
47
3cfeb291 48 my $role = delete $options{_original_role};
49
f785aad8 50 return bless {
51 name => $name,
52 original_options => \%options,
3cfeb291 53 _original_role => $role,
f785aad8 54 %options,
55 }, $class;
56}
57
58sub attach_to_role {
59 my ( $self, $role ) = @_;
60
61 ( blessed($role) && $role->isa('Moose::Meta::Role') )
62 || confess
63 "You must pass a Moose::Meta::Role instance (or a subclass)";
64
65 weaken( $self->{'associated_role'} = $role );
66}
67
3cfeb291 68sub original_role {
69 my $self = shift;
70
71 return $self->_original_role || $self->associated_role;
72}
73
f785aad8 74sub attribute_for_class {
3cfeb291 75 my $self = shift;
76
77 my $metaclass = $self->original_role->applied_attribute_metaclass;
f785aad8 78
79 return $metaclass->interpolate_class_and_new(
80 $self->name => %{ $self->original_options } );
81}
82
83sub clone {
84 my $self = shift;
85
3cfeb291 86 my $role = $self->original_role;
87
88 return ( ref $self )->new(
89 $self->name,
90 %{ $self->original_options },
91 _original_role => $role,
92 );
f785aad8 93}
94
95sub is_same_as {
96 my $self = shift;
97 my $attr = shift;
98
99 my $self_options = $self->original_options;
100 my $other_options = $attr->original_options;
101
102 return 0
103 unless ( join q{|}, sort keys %{$self_options} ) eq ( join q{|}, sort keys %{$other_options} );
104
105 for my $key ( keys %{$self_options} ) {
106 return 0 if defined $self_options->{$key} && ! defined $other_options->{$key};
107 return 0 if ! defined $self_options->{$key} && defined $other_options->{$key};
108
109 next if all { ! defined } $self_options->{$key}, $other_options->{$key};
110
111 return 0 unless $self_options->{$key} eq $other_options->{$key};
112 }
113
114 return 1;
115}
116
1171;
118
119=pod
120
f785aad8 121=head1 DESCRIPTION
122
123This class implements the API for attributes in roles. Attributes in roles are
124more like attribute prototypes than full blown attributes. While they are
125introspectable, they have very little behavior.
126
127=head1 METHODS
128
129This class provides the following methods:
130
131=over 4
132
133=item B<< Moose::Meta::Role::Attribute->new(...) >>
134
135This method accepts all the options that would be passed to the constructor
136for L<Moose::Meta::Attribute>.
137
138=item B<< $attr->metaclass >>
139
140=item B<< $attr->is >>
141
142Returns the option as passed to the constructor.
143
144=item B<< $attr->associated_role >>
145
146Returns the L<Moose::Meta::Role> to which this attribute belongs, if any.
147
3cfeb291 148=item B<< $attr->original_role >>
149
150Returns the L<Moose::Meta::Role> in which this attribute was first
151defined. This may not be the same as the value C<associated_role()> in the
152case of composite role, or the case where one role consumes other roles.
153
f785aad8 154=item B<< $attr->original_options >>
155
156Returns a hash reference of options passed to the constructor. This is used
157when creating a L<Moose::Meta::Attribute> object from this object.
158
159=item B<< $attr->attach_to_role($role) >>
160
161Attaches the attribute to the given L<Moose::Meta::Role>.
162
163=item B<< $attr->attribute_for_class($metaclass) >>
164
165Given an attribute metaclass name, this method calls C<<
166$metaclass->interpolate_class_and_new >> to construct an attribute object
167which can be added to a L<Moose::Meta::Class>.
168
169=item B<< $attr->clone >>
170
171Creates a new object identical to the object on which the method is called.
172
173=item B<< $attr->is_same_as($other_attr) >>
174
175Compares two role attributes and returns true if they are identical.
176
177=back
178
179In addition, this class implements all informational predicates implements by
180L<Moose::Meta::Attribute> (and L<Class::MOP::Attribute>).
181
182=head1 BUGS
183
d4048ef3 184See L<Moose/BUGS> for details on reporting bugs.
f785aad8 185
f785aad8 186=cut