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