Commit | Line | Data |
63fcc508 |
1 | package MooseX::ClassAttribute::Trait::Attribute; |
bb70fe3a |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
88b7f2c8 |
6 | use namespace::autoclean; |
a1ec1ff1 |
7 | use Moose::Role; |
bb70fe3a |
8 | |
a1ec1ff1 |
9 | # This is the worst role evar! Really, this should be a subclass, |
10 | # because it overrides a lot of behavior. However, as a subclass it |
8e988dc6 |
11 | # won't cooperate with _other_ subclasses. |
bb70fe3a |
12 | |
9e2d0ef1 |
13 | around _process_options => sub { |
a1ec1ff1 |
14 | my $orig = shift; |
bb70fe3a |
15 | my $class = shift; |
16 | my $name = shift; |
17 | my $options = shift; |
18 | |
19 | confess 'A class attribute cannot be required' |
20 | if $options->{required}; |
21 | |
a1ec1ff1 |
22 | return $class->$orig( $name, $options ); |
23 | }; |
bb70fe3a |
24 | |
549cbfd2 |
25 | after attach_to_class => sub { |
bb70fe3a |
26 | my $self = shift; |
27 | my $meta = shift; |
28 | |
bb70fe3a |
29 | $self->_initialize($meta) |
30 | unless $self->is_lazy(); |
a1ec1ff1 |
31 | }; |
bb70fe3a |
32 | |
549cbfd2 |
33 | before detach_from_class => sub { |
bb70fe3a |
34 | my $self = shift; |
35 | my $meta = shift; |
36 | |
37 | $self->clear_value($meta); |
a1ec1ff1 |
38 | }; |
bb70fe3a |
39 | |
88b7f2c8 |
40 | sub _initialize { |
6048a053 |
41 | my $self = shift; |
42 | my $metaclass = shift; |
bb70fe3a |
43 | |
88b7f2c8 |
44 | if ( $self->has_default() ) { |
3e9e5aef |
45 | $self->set_value( |
46 | undef, |
47 | $self->default( $self->associated_class() ) |
48 | ); |
bb70fe3a |
49 | } |
88b7f2c8 |
50 | elsif ( $self->has_builder() ) { |
6048a053 |
51 | $self->set_value( undef, $self->_call_builder( $metaclass->name() ) ); |
bb70fe3a |
52 | } |
53 | } |
54 | |
9e2d0ef1 |
55 | around default => sub { |
a1ec1ff1 |
56 | my $orig = shift; |
bb70fe3a |
57 | my $self = shift; |
58 | |
a1ec1ff1 |
59 | my $default = $self->$orig(); |
bb70fe3a |
60 | |
e5fa95ba |
61 | if ( $self->is_default_a_coderef() && @_ ) { |
62 | return $default->(@_); |
bb70fe3a |
63 | } |
64 | |
65 | return $default; |
a1ec1ff1 |
66 | }; |
bb70fe3a |
67 | |
9e2d0ef1 |
68 | around _call_builder => sub { |
a1ec1ff1 |
69 | shift; |
bb70fe3a |
70 | my $self = shift; |
71 | my $class = shift; |
72 | |
73 | my $builder = $self->builder(); |
74 | |
75 | return $class->$builder() |
76 | if $class->can( $self->builder ); |
77 | |
78 | confess( "$class does not support builder method '" |
79 | . $self->builder |
80 | . "' for attribute '" |
81 | . $self->name |
82 | . "'" ); |
a1ec1ff1 |
83 | }; |
bb70fe3a |
84 | |
9e2d0ef1 |
85 | around set_value => sub { |
a1ec1ff1 |
86 | shift; |
88b7f2c8 |
87 | my $self = shift; |
88 | shift; # ignoring instance or class name |
89 | my $value = shift; |
bb70fe3a |
90 | |
88b7f2c8 |
91 | $self->associated_class() |
92 | ->set_class_attribute_value( $self->name() => $value ); |
a1ec1ff1 |
93 | }; |
bb70fe3a |
94 | |
9e2d0ef1 |
95 | around get_value => sub { |
a1ec1ff1 |
96 | shift; |
88b7f2c8 |
97 | my $self = shift; |
bb70fe3a |
98 | |
88b7f2c8 |
99 | return $self->associated_class() |
100 | ->get_class_attribute_value( $self->name() ); |
a1ec1ff1 |
101 | }; |
bb70fe3a |
102 | |
9e2d0ef1 |
103 | around has_value => sub { |
a1ec1ff1 |
104 | shift; |
88b7f2c8 |
105 | my $self = shift; |
bb70fe3a |
106 | |
88b7f2c8 |
107 | return $self->associated_class() |
108 | ->has_class_attribute_value( $self->name() ); |
a1ec1ff1 |
109 | }; |
bb70fe3a |
110 | |
9e2d0ef1 |
111 | around clear_value => sub { |
a1ec1ff1 |
112 | shift; |
88b7f2c8 |
113 | my $self = shift; |
bb70fe3a |
114 | |
88b7f2c8 |
115 | return $self->associated_class() |
116 | ->clear_class_attribute_value( $self->name() ); |
a1ec1ff1 |
117 | }; |
bb70fe3a |
118 | |
28c23808 |
119 | if ( $Moose::VERSION < 1.99 ) { |
120 | around inline_get => sub { |
121 | shift; |
122 | my $self = shift; |
123 | |
124 | return $self->associated_class() |
a5ed69bc |
125 | ->_inline_get_class_slot_value( $self->slots() ); |
28c23808 |
126 | }; |
127 | |
128 | around inline_set => sub { |
129 | shift; |
130 | my $self = shift; |
131 | shift; |
132 | my $value = shift; |
133 | |
134 | my $meta = $self->associated_class(); |
135 | |
136 | my $code |
a5ed69bc |
137 | = $meta->_inline_set_class_slot_value( $self->slots(), $value ) |
28c23808 |
138 | . ";"; |
3e9e5aef |
139 | $code .= $meta->_inline_weaken_class_slot_value( |
140 | $self->slots(), |
141 | $value |
142 | ) |
28c23808 |
143 | . " if ref $value;" |
144 | if $self->is_weak_ref(); |
145 | |
146 | return $code; |
147 | }; |
148 | |
149 | around inline_has => sub { |
150 | shift; |
151 | my $self = shift; |
152 | |
153 | return $self->associated_class() |
a5ed69bc |
154 | ->_inline_is_class_slot_initialized( $self->slots() ); |
28c23808 |
155 | }; |
156 | |
157 | around inline_clear => sub { |
158 | shift; |
159 | my $self = shift; |
160 | |
161 | return $self->associated_class() |
a5ed69bc |
162 | ->_inline_deinitialize_class_slot( $self->slots() ); |
28c23808 |
163 | }; |
164 | } |
165 | else { |
166 | around _inline_instance_get => sub { |
167 | shift; |
168 | my $self = shift; |
169 | |
170 | return $self->associated_class() |
a5ed69bc |
171 | ->_inline_get_class_slot_value( $self->slots() ); |
28c23808 |
172 | }; |
173 | |
174 | around _inline_instance_set => sub { |
175 | shift; |
176 | my $self = shift; |
177 | shift; |
178 | my $value = shift; |
179 | |
180 | return $self->associated_class() |
a5ed69bc |
181 | ->_inline_set_class_slot_value( $self->slots(), $value ); |
28c23808 |
182 | }; |
183 | |
184 | around _inline_instance_has => sub { |
185 | shift; |
186 | my $self = shift; |
187 | |
188 | return $self->associated_class() |
a5ed69bc |
189 | ->_inline_is_class_slot_initialized( $self->slots() ); |
28c23808 |
190 | }; |
191 | |
192 | around _inline_instance_clear => sub { |
193 | shift; |
194 | my $self = shift; |
195 | |
196 | return $self->associated_class() |
a5ed69bc |
197 | ->_inline_deinitialize_class_slot( $self->slots() ); |
28c23808 |
198 | }; |
199 | |
200 | around _inline_weaken_value => sub { |
201 | shift; |
202 | my $self = shift; |
203 | shift; |
204 | my $value = shift; |
205 | |
206 | return unless $self->is_weak_ref(); |
207 | |
208 | return ( |
a5ed69bc |
209 | $self->associated_class->_inline_weaken_class_slot_value( |
28c23808 |
210 | $self->slots(), $value |
211 | ), |
212 | 'if ref ' . $value . ';', |
213 | ); |
214 | }; |
215 | } |
935982fc |
216 | |
bb70fe3a |
217 | 1; |
7a4a3b1e |
218 | |
0d0bf8c3 |
219 | # ABSTRACT: A trait for class attributes |
220 | |
7a4a3b1e |
221 | __END__ |
222 | |
223 | =pod |
224 | |
7a4a3b1e |
225 | =head1 DESCRIPTION |
226 | |
227 | This role modifies the behavior of class attributes in various |
228 | ways. It really should be a subclass of C<Moose::Meta::Attribute>, but |
229 | if it were then it couldn't be combined with other attribute |
230 | metaclasses, like C<MooseX::AttributeHelpers>. |
231 | |
232 | There are no new public methods implemented by this role. All it does |
233 | is change the behavior of a number of existing methods. |
234 | |
7a4a3b1e |
235 | =head1 BUGS |
236 | |
237 | See L<MooseX::ClassAttribute> for details. |
238 | |
7a4a3b1e |
239 | =cut |