1 package Class::MOP::Mixin::HasAttributes;
7 $VERSION = eval $VERSION;
8 our $AUTHORITY = 'cpan:STEVAN';
11 use Scalar::Util 'blessed';
13 use base 'Class::MOP::Mixin';
19 = blessed( $_[0] ) ? $_[0] : $self->attribute_metaclass->new(@_);
21 ( $attribute->isa('Class::MOP::Mixin::AttributeCore') )
23 "Your attribute must be an instance of Class::MOP::Mixin::AttributeCore (or a subclass)";
25 $self->_attach_attribute($attribute);
27 my $attr_name = $attribute->name;
29 $self->remove_attribute($attr_name)
30 if $self->has_attribute($attr_name);
32 my $order = ( scalar keys %{ $self->_attribute_map } );
33 $attribute->_set_insertion_order($order);
35 $self->_attribute_map->{$attr_name} = $attribute;
37 # This method is called to allow for installing accessors. Ideally, we'd
38 # use method overriding, but then the subclass would be responsible for
39 # making the attribute, which would end up with lots of code
40 # duplication. Even more ideally, we'd use augment/inner, but this is
42 $self->_post_add_attribute($attribute)
43 if $self->can('_post_add_attribute');
49 my ( $self, $attribute_name ) = @_;
51 ( defined $attribute_name )
52 || confess "You must define an attribute name";
54 exists $self->_attribute_map->{$attribute_name};
58 my ( $self, $attribute_name ) = @_;
60 ( defined $attribute_name )
61 || confess "You must define an attribute name";
63 return $self->_attribute_map->{$attribute_name};
66 sub remove_attribute {
67 my ( $self, $attribute_name ) = @_;
69 ( defined $attribute_name )
70 || confess "You must define an attribute name";
72 my $removed_attribute = $self->_attribute_map->{$attribute_name};
73 return unless defined $removed_attribute;
75 delete $self->_attribute_map->{$attribute_name};
77 return $removed_attribute;
80 sub get_attribute_list {
82 keys %{ $self->_attribute_map };
85 sub _restore_metaattributes_from {
89 for my $attr (sort { $a->insertion_order <=> $b->insertion_order }
90 map { $old_meta->get_attribute($_) }
91 $old_meta->get_attribute_list) {
92 $attr->_make_compatible_with($self->attribute_metaclass);
93 $self->add_attribute($attr);
105 Class::MOP::Mixin::HasMethods - Methods for metaclasses which have attributes
109 This class implements methods for metaclasses which have attributes
110 (L<Class::MOP::Class> and L<Moose::Meta::Role>). See L<Class::MOP::Class> for
115 Dave Rolsky E<lt>autarch@urth.orgE<gt>
117 =head1 COPYRIGHT AND LICENSE
119 Copyright 2006-2010 by Infinity Interactive, Inc.
121 L<http://www.iinteractive.com>
123 This library is free software; you can redistribute it and/or modify
124 it under the same terms as Perl itself.