Add date for 1.04
[gitmo/Class-MOP.git] / lib / Class / MOP / Mixin / HasAttributes.pm
CommitLineData
9b871d79 1package Class::MOP::Mixin::HasAttributes;
2
3use strict;
4use warnings;
5
0e734d64 6our $VERSION = '1.03';
9b871d79 7$VERSION = eval $VERSION;
8our $AUTHORITY = 'cpan:STEVAN';
9
10use Carp 'confess';
11use Scalar::Util 'blessed';
12
13use base 'Class::MOP::Mixin';
14
15sub _attribute_map { $_[0]->{'attributes'} }
16sub attribute_metaclass { $_[0]->{'attribute_metaclass'} }
17
18sub add_attribute {
19 my $self = shift;
20
21 my $attribute
22 = blessed( $_[0] ) ? $_[0] : $self->attribute_metaclass->new(@_);
23
24 ( $attribute->isa('Class::MOP::Mixin::AttributeCore') )
25 || confess
26 "Your attribute must be an instance of Class::MOP::Mixin::AttributeCore (or a subclass)";
27
28 $self->_attach_attribute($attribute);
29
30 my $attr_name = $attribute->name;
31
32 $self->remove_attribute($attr_name)
33 if $self->has_attribute($attr_name);
34
35 my $order = ( scalar keys %{ $self->_attribute_map } );
36 $attribute->_set_insertion_order($order);
37
38 $self->_attribute_map->{$attr_name} = $attribute;
39
40 # This method is called to allow for installing accessors. Ideally, we'd
41 # use method overriding, but then the subclass would be responsible for
42 # making the attribute, which would end up with lots of code
43 # duplication. Even more ideally, we'd use augment/inner, but this is
44 # Class::MOP!
45 $self->_post_add_attribute($attribute)
46 if $self->can('_post_add_attribute');
47
48 return $attribute;
49}
50
51sub has_attribute {
52 my ( $self, $attribute_name ) = @_;
53
54 ( defined $attribute_name )
55 || confess "You must define an attribute name";
56
57 exists $self->_attribute_map->{$attribute_name};
58}
59
60sub get_attribute {
61 my ( $self, $attribute_name ) = @_;
62
63 ( defined $attribute_name )
64 || confess "You must define an attribute name";
65
66 return $self->_attribute_map->{$attribute_name};
67}
68
69sub remove_attribute {
70 my ( $self, $attribute_name ) = @_;
71
72 ( defined $attribute_name )
73 || confess "You must define an attribute name";
74
75 my $removed_attribute = $self->_attribute_map->{$attribute_name};
76 return unless defined $removed_attribute;
77
78 delete $self->_attribute_map->{$attribute_name};
79
80 return $removed_attribute;
81}
82
83sub get_attribute_list {
84 my $self = shift;
85 keys %{ $self->_attribute_map };
86}
87
881;
89
90__END__
91
92=pod
93
94=head1 NAME
95
96Class::MOP::Mixin::HasMethods - Methods for metaclasses which have attributes
97
98=head1 DESCRIPTION
99
100This class implements methods for metaclasses which have attributes
101(L<Class::MOP::Class> and L<Moose::Meta::Role>). See L<Class::MOP::Class> for
102API details.
103
104=head1 AUTHORS
105
106Dave Rolsky E<lt>autarch@urth.orgE<gt>
107
108=head1 COPYRIGHT AND LICENSE
109
3e2c8600 110Copyright 2006-2010 by Infinity Interactive, Inc.
9b871d79 111
112L<http://www.iinteractive.com>
113
114This library is free software; you can redistribute it and/or modify
115it under the same terms as Perl itself.
116
117=cut