Commit | Line | Data |
63fcc508 |
1 | package MooseX::ClassAttribute::Trait::Attribute; |
bb70fe3a |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
88412c09 |
6 | our $VERSION = '0.11'; |
f77be127 |
7 | |
bb70fe3a |
8 | use MooseX::ClassAttribute::Meta::Method::Accessor; |
9 | |
88b7f2c8 |
10 | use namespace::autoclean; |
a1ec1ff1 |
11 | use Moose::Role; |
bb70fe3a |
12 | |
a1ec1ff1 |
13 | # This is the worst role evar! Really, this should be a subclass, |
14 | # because it overrides a lot of behavior. However, as a subclass it |
8e988dc6 |
15 | # won't cooperate with _other_ subclasses. |
bb70fe3a |
16 | |
88b7f2c8 |
17 | around 'accessor_metaclass' => sub { |
a1ec1ff1 |
18 | return 'MooseX::ClassAttribute::Meta::Method::Accessor'; |
19 | }; |
bb70fe3a |
20 | |
88b7f2c8 |
21 | around '_process_options' => sub { |
a1ec1ff1 |
22 | my $orig = shift; |
bb70fe3a |
23 | my $class = shift; |
24 | my $name = shift; |
25 | my $options = shift; |
26 | |
27 | confess 'A class attribute cannot be required' |
28 | if $options->{required}; |
29 | |
a1ec1ff1 |
30 | return $class->$orig( $name, $options ); |
31 | }; |
bb70fe3a |
32 | |
88b7f2c8 |
33 | around attach_to_class => sub { |
a1ec1ff1 |
34 | my $orig = shift; |
bb70fe3a |
35 | my $self = shift; |
36 | my $meta = shift; |
37 | |
a1ec1ff1 |
38 | $self->$orig($meta); |
bb70fe3a |
39 | |
40 | $self->_initialize($meta) |
41 | unless $self->is_lazy(); |
a1ec1ff1 |
42 | }; |
bb70fe3a |
43 | |
88b7f2c8 |
44 | around 'detach_from_class' => sub { |
a1ec1ff1 |
45 | my $orig = shift; |
bb70fe3a |
46 | my $self = shift; |
47 | my $meta = shift; |
48 | |
49 | $self->clear_value($meta); |
50 | |
a1ec1ff1 |
51 | $self->$orig($meta); |
52 | }; |
bb70fe3a |
53 | |
88b7f2c8 |
54 | sub _initialize { |
6048a053 |
55 | my $self = shift; |
56 | my $metaclass = shift; |
bb70fe3a |
57 | |
88b7f2c8 |
58 | if ( $self->has_default() ) { |
d0785271 |
59 | $self->set_value( undef, $self->default() ); |
bb70fe3a |
60 | } |
88b7f2c8 |
61 | elsif ( $self->has_builder() ) { |
6048a053 |
62 | $self->set_value( undef, $self->_call_builder( $metaclass->name() ) ); |
bb70fe3a |
63 | } |
64 | } |
65 | |
88b7f2c8 |
66 | around 'default' => sub { |
a1ec1ff1 |
67 | my $orig = shift; |
bb70fe3a |
68 | my $self = shift; |
69 | |
a1ec1ff1 |
70 | my $default = $self->$orig(); |
bb70fe3a |
71 | |
88b7f2c8 |
72 | if ( $self->is_default_a_coderef() ) { |
bb70fe3a |
73 | return $default->( $self->associated_class() ); |
74 | } |
75 | |
76 | return $default; |
a1ec1ff1 |
77 | }; |
bb70fe3a |
78 | |
88b7f2c8 |
79 | around '_call_builder' => sub { |
a1ec1ff1 |
80 | shift; |
bb70fe3a |
81 | my $self = shift; |
82 | my $class = shift; |
83 | |
84 | my $builder = $self->builder(); |
85 | |
86 | return $class->$builder() |
87 | if $class->can( $self->builder ); |
88 | |
89 | confess( "$class does not support builder method '" |
90 | . $self->builder |
91 | . "' for attribute '" |
92 | . $self->name |
93 | . "'" ); |
a1ec1ff1 |
94 | }; |
bb70fe3a |
95 | |
88b7f2c8 |
96 | around 'set_value' => sub { |
a1ec1ff1 |
97 | shift; |
88b7f2c8 |
98 | my $self = shift; |
99 | shift; # ignoring instance or class name |
100 | my $value = shift; |
bb70fe3a |
101 | |
88b7f2c8 |
102 | $self->associated_class() |
103 | ->set_class_attribute_value( $self->name() => $value ); |
a1ec1ff1 |
104 | }; |
bb70fe3a |
105 | |
88b7f2c8 |
106 | around 'get_value' => sub { |
a1ec1ff1 |
107 | shift; |
88b7f2c8 |
108 | my $self = shift; |
bb70fe3a |
109 | |
88b7f2c8 |
110 | return $self->associated_class() |
111 | ->get_class_attribute_value( $self->name() ); |
a1ec1ff1 |
112 | }; |
bb70fe3a |
113 | |
88b7f2c8 |
114 | around 'has_value' => sub { |
a1ec1ff1 |
115 | shift; |
88b7f2c8 |
116 | my $self = shift; |
bb70fe3a |
117 | |
88b7f2c8 |
118 | return $self->associated_class() |
119 | ->has_class_attribute_value( $self->name() ); |
a1ec1ff1 |
120 | }; |
bb70fe3a |
121 | |
88b7f2c8 |
122 | around 'clear_value' => sub { |
a1ec1ff1 |
123 | shift; |
88b7f2c8 |
124 | my $self = shift; |
bb70fe3a |
125 | |
88b7f2c8 |
126 | return $self->associated_class() |
127 | ->clear_class_attribute_value( $self->name() ); |
a1ec1ff1 |
128 | }; |
bb70fe3a |
129 | |
bb70fe3a |
130 | 1; |
7a4a3b1e |
131 | |
132 | __END__ |
133 | |
134 | =pod |
135 | |
136 | =head1 NAME |
137 | |
04b89789 |
138 | MooseX::ClassAttribute::Trait::Attribute - A trait for class attributes |
7a4a3b1e |
139 | |
140 | =head1 DESCRIPTION |
141 | |
142 | This role modifies the behavior of class attributes in various |
143 | ways. It really should be a subclass of C<Moose::Meta::Attribute>, but |
144 | if it were then it couldn't be combined with other attribute |
145 | metaclasses, like C<MooseX::AttributeHelpers>. |
146 | |
147 | There are no new public methods implemented by this role. All it does |
148 | is change the behavior of a number of existing methods. |
149 | |
150 | =head1 AUTHOR |
151 | |
152 | Dave Rolsky, C<< <autarch@urth.org> >> |
153 | |
154 | =head1 BUGS |
155 | |
156 | See L<MooseX::ClassAttribute> for details. |
157 | |
158 | =head1 COPYRIGHT & LICENSE |
159 | |
0cee5df4 |
160 | Copyright 2007-2010 Dave Rolsky, All Rights Reserved. |
7a4a3b1e |
161 | |
162 | This program is free software; you can redistribute it and/or modify |
163 | it under the same terms as Perl itself. |
164 | |
165 | =cut |