Commit | Line | Data |
63fcc508 |
1 | package MooseX::ClassAttribute::Trait::Mixin::HasClassAttributes; |
aa639029 |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use namespace::autoclean; |
7 | use Moose::Role; |
8 | |
9 | has _class_attribute_map => ( |
10 | traits => ['Hash'], |
11 | is => 'ro', |
88b7f2c8 |
12 | isa => 'HashRef[Class::MOP::Mixin::AttributeCore]', |
aa639029 |
13 | handles => { |
14 | '_add_class_attribute' => 'set', |
15 | 'has_class_attribute' => 'exists', |
16 | 'get_class_attribute' => 'get', |
17 | '_remove_class_attribute' => 'delete', |
18 | 'get_class_attribute_list' => 'keys', |
19 | }, |
20 | default => sub { {} }, |
21 | init_arg => undef, |
22 | ); |
23 | |
deaffdd0 |
24 | # deprecated |
aa639029 |
25 | sub get_class_attribute_map { |
26 | return $_[0]->_class_attribute_map(); |
27 | } |
28 | |
deaffdd0 |
29 | sub add_class_attribute { |
30 | my $self = shift; |
31 | my $attribute = shift; |
32 | |
33 | ( $attribute->isa('Class::MOP::Mixin::AttributeCore') ) |
34 | || confess |
35 | "Your attribute must be an instance of Class::MOP::Mixin::AttributeCore (or a subclass)"; |
36 | |
37 | $self->_attach_class_attribute($attribute); |
38 | |
39 | my $attr_name = $attribute->name; |
40 | |
41 | $self->remove_class_attribute($attr_name) |
42 | if $self->has_class_attribute($attr_name); |
43 | |
44 | my $order = ( scalar keys %{ $self->_attribute_map } ); |
45 | $attribute->_set_insertion_order($order); |
46 | |
47 | $self->_add_class_attribute( $attr_name => $attribute ); |
48 | |
49 | # This method is called to allow for installing accessors. Ideally, we'd |
50 | # use method overriding, but then the subclass would be responsible for |
51 | # making the attribute, which would end up with lots of code |
52 | # duplication. Even more ideally, we'd use augment/inner, but this is |
53 | # Class::MOP! |
54 | $self->_post_add_class_attribute($attribute) |
55 | if $self->can('_post_add_class_attribute'); |
56 | |
57 | return $attribute; |
58 | } |
59 | |
ad109c62 |
60 | sub remove_class_attribute { |
61 | my $self = shift; |
62 | my $name = shift; |
63 | |
64 | ( defined $name && $name ) |
65 | || confess 'You must provide an attribute name'; |
66 | |
67 | my $removed_attr = $self->get_class_attribute($name); |
68 | return unless $removed_attr; |
69 | |
70 | $self->_remove_class_attribute($name); |
71 | |
72 | return $removed_attr; |
73 | } |
74 | |
aa639029 |
75 | 1; |
04b89789 |
76 | |
77 | __END__ |
78 | |
79 | =pod |
80 | |
81 | =head1 NAME |
82 | |
83 | MooseX::ClassAttribute::Trait::Mixin::HasClassAttributes - A mixin trait for things which have class attributes |
84 | |
85 | =head1 DESCRIPTION |
86 | |
87 | This trait is like L<Class::MOP::Mixin::HasAttributes>, except that it works |
88 | with class attributes instead of object attributes. |
89 | |
90 | See L<MooseX::ClassAttribute::Trait::Class> and |
91 | L<MooseX::ClassAttribute::Trait::Role> for API details. |
92 | |
93 | =head1 AUTHOR |
94 | |
95 | Dave Rolsky, C<< <autarch@urth.org> >> |
96 | |
97 | =head1 BUGS |
98 | |
99 | See L<MooseX::ClassAttribute> for details. |
100 | |
101 | =head1 COPYRIGHT & LICENSE |
102 | |
103 | Copyright 2007-2008 Dave Rolsky, All Rights Reserved. |
104 | |
105 | This program is free software; you can redistribute it and/or modify |
106 | it under the same terms as Perl itself. |
107 | |
108 | =cut |