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