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 | |
88b7f2c8 |
25 | around attach_to_class => sub { |
a1ec1ff1 |
26 | my $orig = shift; |
bb70fe3a |
27 | my $self = shift; |
28 | my $meta = shift; |
29 | |
a1ec1ff1 |
30 | $self->$orig($meta); |
bb70fe3a |
31 | |
32 | $self->_initialize($meta) |
33 | unless $self->is_lazy(); |
a1ec1ff1 |
34 | }; |
bb70fe3a |
35 | |
9e2d0ef1 |
36 | around detach_from_class => sub { |
a1ec1ff1 |
37 | my $orig = shift; |
bb70fe3a |
38 | my $self = shift; |
39 | my $meta = shift; |
40 | |
41 | $self->clear_value($meta); |
42 | |
a1ec1ff1 |
43 | $self->$orig($meta); |
44 | }; |
bb70fe3a |
45 | |
88b7f2c8 |
46 | sub _initialize { |
6048a053 |
47 | my $self = shift; |
48 | my $metaclass = shift; |
bb70fe3a |
49 | |
88b7f2c8 |
50 | if ( $self->has_default() ) { |
d0785271 |
51 | $self->set_value( undef, $self->default() ); |
bb70fe3a |
52 | } |
88b7f2c8 |
53 | elsif ( $self->has_builder() ) { |
6048a053 |
54 | $self->set_value( undef, $self->_call_builder( $metaclass->name() ) ); |
bb70fe3a |
55 | } |
56 | } |
57 | |
9e2d0ef1 |
58 | around default => sub { |
a1ec1ff1 |
59 | my $orig = shift; |
bb70fe3a |
60 | my $self = shift; |
61 | |
a1ec1ff1 |
62 | my $default = $self->$orig(); |
bb70fe3a |
63 | |
88b7f2c8 |
64 | if ( $self->is_default_a_coderef() ) { |
bb70fe3a |
65 | return $default->( $self->associated_class() ); |
66 | } |
67 | |
68 | return $default; |
a1ec1ff1 |
69 | }; |
bb70fe3a |
70 | |
9e2d0ef1 |
71 | around _call_builder => sub { |
a1ec1ff1 |
72 | shift; |
bb70fe3a |
73 | my $self = shift; |
74 | my $class = shift; |
75 | |
76 | my $builder = $self->builder(); |
77 | |
78 | return $class->$builder() |
79 | if $class->can( $self->builder ); |
80 | |
81 | confess( "$class does not support builder method '" |
82 | . $self->builder |
83 | . "' for attribute '" |
84 | . $self->name |
85 | . "'" ); |
a1ec1ff1 |
86 | }; |
bb70fe3a |
87 | |
9e2d0ef1 |
88 | around set_value => sub { |
a1ec1ff1 |
89 | shift; |
88b7f2c8 |
90 | my $self = shift; |
91 | shift; # ignoring instance or class name |
92 | my $value = shift; |
bb70fe3a |
93 | |
88b7f2c8 |
94 | $self->associated_class() |
95 | ->set_class_attribute_value( $self->name() => $value ); |
a1ec1ff1 |
96 | }; |
bb70fe3a |
97 | |
9e2d0ef1 |
98 | around get_value => sub { |
a1ec1ff1 |
99 | shift; |
88b7f2c8 |
100 | my $self = shift; |
bb70fe3a |
101 | |
88b7f2c8 |
102 | return $self->associated_class() |
103 | ->get_class_attribute_value( $self->name() ); |
a1ec1ff1 |
104 | }; |
bb70fe3a |
105 | |
9e2d0ef1 |
106 | around has_value => sub { |
a1ec1ff1 |
107 | shift; |
88b7f2c8 |
108 | my $self = shift; |
bb70fe3a |
109 | |
88b7f2c8 |
110 | return $self->associated_class() |
111 | ->has_class_attribute_value( $self->name() ); |
a1ec1ff1 |
112 | }; |
bb70fe3a |
113 | |
9e2d0ef1 |
114 | around clear_value => sub { |
a1ec1ff1 |
115 | shift; |
88b7f2c8 |
116 | my $self = shift; |
bb70fe3a |
117 | |
88b7f2c8 |
118 | return $self->associated_class() |
119 | ->clear_class_attribute_value( $self->name() ); |
a1ec1ff1 |
120 | }; |
bb70fe3a |
121 | |
9e2d0ef1 |
122 | around inline_get => sub { |
935982fc |
123 | shift; |
124 | my $self = shift; |
125 | |
126 | return $self->associated_class() |
127 | ->inline_get_class_slot_value( $self->slots() ); |
128 | }; |
129 | |
9e2d0ef1 |
130 | around inline_set => sub { |
935982fc |
131 | shift; |
132 | my $self = shift; |
133 | shift; |
134 | my $value = shift; |
135 | |
136 | my $meta = $self->associated_class(); |
137 | |
138 | my $code |
139 | = $meta->inline_set_class_slot_value( $self->slots(), $value ) . ";"; |
140 | $code |
141 | .= $meta->inline_weaken_class_slot_value( $self->slots(), $value ) |
142 | . " if ref $value;" |
143 | if $self->is_weak_ref(); |
144 | |
145 | return $code; |
146 | }; |
147 | |
9e2d0ef1 |
148 | around inline_has => sub { |
935982fc |
149 | shift; |
150 | my $self = shift; |
151 | |
152 | return $self->associated_class() |
153 | ->inline_is_class_slot_initialized( $self->slots() ); |
154 | }; |
155 | |
9e2d0ef1 |
156 | around inline_clear => sub { |
935982fc |
157 | shift; |
158 | my $self = shift; |
159 | |
160 | return $self->associated_class() |
161 | ->inline_deinitialize_class_slot( $self->slots() ); |
162 | }; |
163 | |
bb70fe3a |
164 | 1; |
7a4a3b1e |
165 | |
0d0bf8c3 |
166 | # ABSTRACT: A trait for class attributes |
167 | |
7a4a3b1e |
168 | __END__ |
169 | |
170 | =pod |
171 | |
7a4a3b1e |
172 | =head1 DESCRIPTION |
173 | |
174 | This role modifies the behavior of class attributes in various |
175 | ways. It really should be a subclass of C<Moose::Meta::Attribute>, but |
176 | if it were then it couldn't be combined with other attribute |
177 | metaclasses, like C<MooseX::AttributeHelpers>. |
178 | |
179 | There are no new public methods implemented by this role. All it does |
180 | is change the behavior of a number of existing methods. |
181 | |
7a4a3b1e |
182 | =head1 BUGS |
183 | |
184 | See L<MooseX::ClassAttribute> for details. |
185 | |
7a4a3b1e |
186 | =cut |