1 package Class::MOP::HasAttributes;
7 use Scalar::Util 'blessed';
10 use base 'Class::MOP::Object';
12 sub _attribute_map { $_[0]->{'attributes'} }
13 sub attribute_metaclass { $_[0]->{'attribute_metaclass'} }
18 # either we have an attribute object already
19 # or we need to create one from the args provided
21 = blessed( $_[0] ) ? $_[0] : $self->attribute_metaclass->new(@_);
23 # make sure it is derived from the correct type though
24 ( $attribute->isa('Class::MOP::Attribute') )
26 "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
28 # first we attach our new attribute
29 # because it might need certain information
30 # about the class which it is attached to
31 $attribute->attach_to_class($self);
33 my $attr_name = $attribute->name;
35 # then we remove attributes of a conflicting
36 # name here so that we can properly detach
37 # the old attr object, and remove any
38 # accessors it would have generated
39 if ( $self->has_attribute($attr_name) ) {
40 $self->remove_attribute($attr_name);
43 $self->invalidate_meta_instances();
46 # get our count of previously inserted attributes and
47 # increment by one so this attribute knows its order
48 my $order = ( scalar keys %{ $self->_attribute_map } );
49 $attribute->_set_insertion_order($order);
51 # then onto installing the new accessors
52 $self->_attribute_map->{$attr_name} = $attribute;
54 # invalidate package flag here
57 $attribute->install_accessors();
60 $self->remove_attribute($attr_name);
68 my ( $self, $attribute_name ) = @_;
70 ( defined $attribute_name )
71 || confess "You must define an attribute name";
73 exists $self->_attribute_map->{$attribute_name};
77 my ( $self, $attribute_name ) = @_;
79 ( defined $attribute_name )
80 || confess "You must define an attribute name";
82 return $self->_attribute_map->{$attribute_name};
85 sub remove_attribute {
86 my ( $self, $attribute_name ) = @_;
88 ( defined $attribute_name )
89 || confess "You must define an attribute name";
91 my $removed_attribute = $self->_attribute_map->{$attribute_name};
92 return unless defined $removed_attribute;
94 delete $self->_attribute_map->{$attribute_name};
95 $self->invalidate_meta_instances();
96 $removed_attribute->remove_accessors();
97 $removed_attribute->detach_from_class();
99 return $removed_attribute;
102 sub get_attribute_list {
104 keys %{ $self->_attribute_map };
107 sub get_all_attributes {
109 my %attrs = map { %{ $self->initialize($_)->_attribute_map } }
110 reverse $self->linearized_isa;
111 return values %attrs;
114 sub find_attribute_by_name {
115 my ( $self, $attr_name ) = @_;
117 foreach my $class ( $self->linearized_isa ) {
118 # fetch the meta-class ...
119 my $meta = $self->initialize($class);
120 return $meta->get_attribute($attr_name)
121 if $meta->has_attribute($attr_name);