File Coverage

blib/lib/Class/MOP/Mixin/HasAttributes.pm
Criterion Covered Total %
statement 45 46 97.8
branch 16 16 100.0
condition n/a
subroutine 10 10 100.0
pod 0 5 0.0
total 71 77 92.2


line stmt bran cond sub pod time code
1             package Class::MOP::Mixin::HasAttributes;
2             our $VERSION = '2.2206';
3              
4 450     450   3292 use strict;
  450         1039  
  450         13330  
5 450     450   2401 use warnings;
  450         1054  
  450         12296  
6              
7 450     450   2550 use Scalar::Util 'blessed';
  450         1061  
  450         22440  
8              
9 450     450   2972 use parent 'Class::MOP::Mixin';
  450         1118  
  450         3562  
10              
11             sub add_attribute {
12 57513     57513 0 101750 my $self = shift;
13              
14 57513 100       282281 my $attribute
15             = blessed( $_[0] ) ? $_[0] : $self->attribute_metaclass->new(@_);
16              
17 57511 100       254683 ( $attribute->isa('Class::MOP::Mixin::AttributeCore') )
18             || $self->_throw_exception( AttributeMustBeAnClassMOPMixinAttributeCoreOrSubclass => attribute => $attribute,
19             class_name => $self->name,
20             );
21              
22 57509         195626 $self->_attach_attribute($attribute);
23              
24 57509         158237 my $attr_name = $attribute->name;
25              
26 57509 100       130223 $self->remove_attribute($attr_name)
27             if $self->has_attribute($attr_name);
28              
29 57509         101473 my $order = ( scalar keys %{ $self->_attribute_map } );
  57509         153859  
30 57509         185524 $attribute->_set_insertion_order($order);
31              
32 57509         152437 $self->_attribute_map->{$attr_name} = $attribute;
33              
34             # This method is called to allow for installing accessors. Ideally, we'd
35             # use method overriding, but then the subclass would be responsible for
36             # making the attribute, which would end up with lots of code
37             # duplication. Even more ideally, we'd use augment/inner, but this is
38             # Class::MOP!
39 57509 100       286007 $self->_post_add_attribute($attribute)
40             if $self->can('_post_add_attribute');
41              
42 57487         857272 return $attribute;
43             }
44              
45             sub has_attribute {
46 88818     88818 0 178397 my ( $self, $attribute_name ) = @_;
47              
48 88818 100       178298 ( defined $attribute_name )
49             || $self->_throw_exception( MustDefineAnAttributeName => class_name => $self->name );
50              
51 88816         366640 exists $self->_attribute_map->{$attribute_name};
52             }
53              
54             sub get_attribute {
55 54787     54787 0 110473 my ( $self, $attribute_name ) = @_;
56              
57 54787 100       111756 ( defined $attribute_name )
58             || $self->_throw_exception( MustDefineAnAttributeName => class_name => $self->name );
59              
60 54785         227460 return $self->_attribute_map->{$attribute_name};
61             }
62              
63             sub remove_attribute {
64 52     52 0 253 my ( $self, $attribute_name ) = @_;
65              
66 52 100       200 ( defined $attribute_name )
67             || $self->_throw_exception( MustDefineAnAttributeName => class_name => $self->name );
68              
69 50         227 my $removed_attribute = $self->_attribute_map->{$attribute_name};
70 49 100       197 return unless defined $removed_attribute;
71              
72 48         179 delete $self->_attribute_map->{$attribute_name};
73              
74 48         240 return $removed_attribute;
75             }
76              
77             sub get_attribute_list {
78 15336     15336 0 28341 my $self = shift;
79 15336         23059 keys %{ $self->_attribute_map };
  15336         99229  
80             }
81              
82             sub _restore_metaattributes_from {
83 128     128   319 my $self = shift;
84 128         779 my ($old_meta) = @_;
85              
86 128         390 for my $attr (sort { $a->insertion_order <=> $b->insertion_order }
  0         0  
87 23         72 map { $old_meta->get_attribute($_) }
88             $old_meta->get_attribute_list) {
89 23         159 $attr->_make_compatible_with($self->attribute_metaclass);
90 23         83 $self->add_attribute($attr);
91             }
92             }
93              
94             1;
95              
96             # ABSTRACT: Methods for metaclasses which have attributes
97              
98             __END__
99              
100             =pod
101              
102             =encoding UTF-8
103              
104             =head1 NAME
105              
106             Class::MOP::Mixin::HasAttributes - Methods for metaclasses which have attributes
107              
108             =head1 VERSION
109              
110             version 2.2206
111              
112             =head1 DESCRIPTION
113              
114             This class implements methods for metaclasses which have attributes
115             (L<Class::MOP::Class> and L<Moose::Meta::Role>). See L<Class::MOP::Class> for
116             API details.
117              
118             =head1 AUTHORS
119              
120             =over 4
121              
122             =item *
123              
124             Stevan Little <stevan@cpan.org>
125              
126             =item *
127              
128             Dave Rolsky <autarch@urth.org>
129              
130             =item *
131              
132             Jesse Luehrs <doy@cpan.org>
133              
134             =item *
135              
136             Shawn M Moore <sartak@cpan.org>
137              
138             =item *
139              
140             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
141              
142             =item *
143              
144             Karen Etheridge <ether@cpan.org>
145              
146             =item *
147              
148             Florian Ragwitz <rafl@debian.org>
149              
150             =item *
151              
152             Hans Dieter Pearcey <hdp@cpan.org>
153              
154             =item *
155              
156             Chris Prather <chris@prather.org>
157              
158             =item *
159              
160             Matt S Trout <mstrout@cpan.org>
161              
162             =back
163              
164             =head1 COPYRIGHT AND LICENSE
165              
166             This software is copyright (c) 2006 by Infinity Interactive, Inc.
167              
168             This is free software; you can redistribute it and/or modify it under
169             the same terms as the Perl 5 programming language system itself.
170              
171             =cut