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