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