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 | |
619dd6df |
83 | override '_inline_instance_get' => sub { |
935982fc |
84 | my $self = shift; |
85 | |
86 | return $self->associated_class() |
87 | ->inline_get_class_slot_value( $self->slots() ); |
88 | }; |
89 | |
619dd6df |
90 | |
567f5231 |
91 | override '_inline_weaken_value' => sub { |
619dd6df |
92 | my $self = shift; |
93 | my ($instance, $value) = @_; |
94 | return unless $self->is_weak_ref; |
95 | |
96 | my $mi = $self->associated_class->get_meta_instance; |
97 | return ( |
98 | $self->associated_class->inline_weaken_class_slot_value( $self->slots(), $value ), |
99 | 'if ref ' . $value . ';', |
100 | ); |
101 | }; |
102 | |
103 | override '_inline_instance_set' => sub { |
935982fc |
104 | my $self = shift; |
105 | shift; |
106 | my $value = shift; |
107 | |
108 | my $meta = $self->associated_class(); |
109 | |
110 | my $code |
111 | = $meta->inline_set_class_slot_value( $self->slots(), $value ) . ";"; |
935982fc |
112 | |
113 | return $code; |
114 | }; |
115 | |
619dd6df |
116 | override '_inline_instance_has' => sub { |
935982fc |
117 | my $self = shift; |
118 | |
119 | return $self->associated_class() |
120 | ->inline_is_class_slot_initialized( $self->slots() ); |
121 | }; |
122 | |
619dd6df |
123 | override '_inline_clear_value' => sub { |
935982fc |
124 | my $self = shift; |
125 | |
126 | return $self->associated_class() |
127 | ->inline_deinitialize_class_slot( $self->slots() ); |
128 | }; |
129 | |
bb70fe3a |
130 | 1; |
7a4a3b1e |
131 | |
0d0bf8c3 |
132 | # ABSTRACT: A trait for class attributes |
133 | |
7a4a3b1e |
134 | __END__ |
135 | |
136 | =pod |
137 | |
7a4a3b1e |
138 | =head1 DESCRIPTION |
139 | |
140 | This role modifies the behavior of class attributes in various |
141 | ways. It really should be a subclass of C<Moose::Meta::Attribute>, but |
142 | if it were then it couldn't be combined with other attribute |
143 | metaclasses, like C<MooseX::AttributeHelpers>. |
144 | |
145 | There are no new public methods implemented by this role. All it does |
146 | is change the behavior of a number of existing methods. |
147 | |
7a4a3b1e |
148 | =head1 BUGS |
149 | |
150 | See L<MooseX::ClassAttribute> for details. |
151 | |
7a4a3b1e |
152 | =cut |