1package Moose::Meta::Role::Attribute;
2our $VERSION = '2.2201';
3
4use strict;
5use warnings;
6
7use List::Util 1.33 'all';
8use Scalar::Util 'blessed', 'weaken';
9
10use parent 'Moose::Meta::Mixin::AttributeCore', 'Class::MOP::Object';
11
12use Moose::Util 'throw_exception';
13
14__PACKAGE__->meta->add_attribute(
15    'metaclass' => (
16        reader => 'metaclass',
17        Class::MOP::_definition_context(),
18    )
19);
20
21__PACKAGE__->meta->add_attribute(
22    'associated_role' => (
23        reader => 'associated_role',
24        Class::MOP::_definition_context(),
25    )
26);
27
28__PACKAGE__->meta->add_attribute(
29    '_original_role' => (
30        reader => '_original_role',
31        Class::MOP::_definition_context(),
32    )
33);
34
35__PACKAGE__->meta->add_attribute(
36    'is' => (
37        reader => 'is',
38        Class::MOP::_definition_context(),
39    )
40);
41
42__PACKAGE__->meta->add_attribute(
43    'original_options' => (
44        reader => 'original_options',
45        Class::MOP::_definition_context(),
46    )
47);
48
49sub new {
50    my ( $class, $name, %options ) = @_;
51
52    (defined $name)
53        || throw_exception( MustProvideANameForTheAttribute => params => \%options,
54                                                               class  => $class
55                          );
56
57    my $role = delete $options{_original_role};
58
59    return bless {
60        name             => $name,
61        original_options => \%options,
62        _original_role   => $role,
63        %options,
64    }, $class;
65}
66
67sub attach_to_role {
68    my ( $self, $role ) = @_;
69
70    ( blessed($role) && $role->isa('Moose::Meta::Role') )
71        || throw_exception( MustPassAMooseMetaRoleInstanceOrSubclass => class  => $self,
72                                                                        role   => $role
73                          );
74
75    weaken( $self->{'associated_role'} = $role );
76}
77
78sub original_role {
79    my $self = shift;
80
81    return $self->_original_role || $self->associated_role;
82}
83
84sub attribute_for_class {
85    my $self = shift;
86
87    my $metaclass = $self->original_role->applied_attribute_metaclass;
88
89    return $metaclass->interpolate_class_and_new(
90        $self->name    => %{ $self->original_options },
91        role_attribute => $self,
92    );
93}
94
95sub clone {
96    my $self = shift;
97
98    my $role = $self->original_role;
99
100    return ( ref $self )->new(
101        $self->name,
102        %{ $self->original_options },
103        _original_role => $role,
104    );
105}
106
107sub is_same_as {
108    my $self = shift;
109    my $attr = shift;
110
111    my $self_options = $self->original_options;
112    my $other_options = $attr->original_options;
113
114    return 0
115        unless ( join q{|}, sort keys %{$self_options} ) eq ( join q{|}, sort keys %{$other_options} );
116
117    for my $key ( keys %{$self_options} ) {
118        return 0 if defined $self_options->{$key} && ! defined $other_options->{$key};
119        return 0 if ! defined $self_options->{$key} && defined $other_options->{$key};
120
121        next if all { ! defined } $self_options->{$key}, $other_options->{$key};
122
123        return 0 unless $self_options->{$key} eq $other_options->{$key};
124    }
125
126    return 1;
127}
128
1291;
130
131# ABSTRACT: The Moose attribute metaclass for Roles
132
133__END__
134
135=pod
136
137=encoding UTF-8
138
139=head1 NAME
140
141Moose::Meta::Role::Attribute - The Moose attribute metaclass for Roles
142
143=head1 VERSION
144
145version 2.2201
146
147=head1 DESCRIPTION
148
149This class implements the API for attributes in roles. Attributes in roles are
150more like attribute prototypes than full blown attributes. While they are
151introspectable, they have very little behavior.
152
153=head1 METHODS
154
155=head2 Moose::Meta::Role::Attribute->new(...)
156
157This method accepts all the options that would be passed to the constructor
158for L<Moose::Meta::Attribute>.
159
160=head2 $attr->metaclass
161
162=head2 $attr->is
163
164Returns the option as passed to the constructor.
165
166=head2 $attr->associated_role
167
168Returns the L<Moose::Meta::Role> to which this attribute belongs, if any.
169
170=head2 $attr->original_role
171
172Returns the L<Moose::Meta::Role> in which this attribute was first
173defined. This may not be the same as the value of C<associated_role()> for
174attributes in a composite role, or when one role consumes other roles.
175
176=head2 $attr->original_options
177
178Returns a hash reference of options passed to the constructor. This is used
179when creating a L<Moose::Meta::Attribute> object from this object.
180
181=head2 $attr->attach_to_role($role)
182
183Attaches the attribute to the given L<Moose::Meta::Role>.
184
185=head2 $attr->attribute_for_class($metaclass)
186
187Given an attribute metaclass name, this method calls C<<
188$metaclass->interpolate_class_and_new >> to construct an attribute object
189which can be added to a L<Moose::Meta::Class>.
190
191=head2 $attr->clone
192
193Creates a new object identical to the object on which the method is called.
194
195=head2 $attr->is_same_as($other_attr)
196
197Compares two role attributes and returns true if they are identical.
198
199In addition, this class implements all informational predicates implements by
200L<Moose::Meta::Attribute> (and L<Class::MOP::Attribute>).
201
202=head1 BUGS
203
204See L<Moose/BUGS> for details on reporting bugs.
205
206=head1 AUTHORS
207
208=over 4
209
210=item *
211
212Stevan Little <stevan@cpan.org>
213
214=item *
215
216Dave Rolsky <autarch@urth.org>
217
218=item *
219
220Jesse Luehrs <doy@cpan.org>
221
222=item *
223
224Shawn M Moore <sartak@cpan.org>
225
226=item *
227
228יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
229
230=item *
231
232Karen Etheridge <ether@cpan.org>
233
234=item *
235
236Florian Ragwitz <rafl@debian.org>
237
238=item *
239
240Hans Dieter Pearcey <hdp@cpan.org>
241
242=item *
243
244Chris Prather <chris@prather.org>
245
246=item *
247
248Matt S Trout <mstrout@cpan.org>
249
250=back
251
252=head1 COPYRIGHT AND LICENSE
253
254This software is copyright (c) 2006 by Infinity Interactive, Inc.
255
256This is free software; you can redistribute it and/or modify it under
257the same terms as the Perl 5 programming language system itself.
258
259=cut
260