File | /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm |
Statements Executed | 847 |
Total Time | 0.008775 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
9 | 2 | 2 | 1.18ms | 5.69ms | new | Moose::Meta::Attribute::
26 | 3 | 3 | 422µs | 2.92ms | inline_set | Moose::Meta::Attribute::
11 | 3 | 1 | 301µs | 17.1ms | _process_accessors | Moose::Meta::Attribute::
9 | 1 | 1 | 207µs | 605µs | _process_options | Moose::Meta::Attribute::
8 | 1 | 1 | 157µs | 4.15ms | interpolate_class_and_new | Moose::Meta::Attribute::
10 | 2 | 1 | 141µs | 19.7ms | install_accessors | Moose::Meta::Attribute::
8 | 1 | 1 | 89µs | 89µs | interpolate_class | Moose::Meta::Attribute::
11 | 1 | 1 | 57µs | 57µs | accessor_metaclass | Moose::Meta::Attribute::
8 | 1 | 1 | 55µs | 91µs | _check_associated_methods | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | BEGIN | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | register_implementation | Moose::Meta::Attribute::Custom::Moose::
0 | 0 | 0 | 0s | 0s | __ANON__[:277] | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | __ANON__[:39] | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | __ANON__[:438] | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | __ANON__[:642] | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | _call_builder | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | _canonicalize_handles | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | _coerce_and_verify | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | _find_delegate_metaclass | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | _get_delegate_method_list | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | _make_delegation_method | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | _set_initial_slot_value | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | _weaken_value | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | clone | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | clone_and_inherit_options | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | delegation_metaclass | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | does | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | get_value | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | illegal_options_for_inheritance | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | initialize_instance_slot | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | install_delegation | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | remove_accessors | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | remove_delegation | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | set_value | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | throw_error | Moose::Meta::Attribute::
0 | 0 | 0 | 0s | 0s | verify_against_type_constraint | Moose::Meta::Attribute::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | ||||
2 | package Moose::Meta::Attribute; | |||
3 | ||||
4 | 3 | 28µs | 9µs | use strict; # spent 9µs making 1 call to strict::import |
5 | 3 | 38µs | 13µs | use warnings; # spent 25µs making 1 call to warnings::import |
6 | ||||
7 | 3 | 31µs | 10µs | use Scalar::Util 'blessed', 'weaken'; # spent 50µs making 1 call to Exporter::import |
8 | 3 | 27µs | 9µs | use List::MoreUtils 'any'; # spent 41µs making 1 call to Exporter::import |
9 | 3 | 30µs | 10µs | use Try::Tiny; # spent 58µs making 1 call to Exporter::import |
10 | 3 | 45µs | 15µs | use overload (); |
11 | ||||
12 | 1 | 1µs | 1µs | our $VERSION = '1.15'; |
13 | 1 | 700ns | 700ns | our $AUTHORITY = 'cpan:STEVAN'; |
14 | ||||
15 | 3 | 27µs | 9µs | use Moose::Deprecated; # spent 15µs making 1 call to Package::DeprecationManager::__ANON__[/usr/local/share/perl/5.10.0/Package/DeprecationManager.pm:61] |
16 | 3 | 127µs | 42µs | use Moose::Meta::Method::Accessor; # spent 6µs making 1 call to import |
17 | 3 | 115µs | 38µs | use Moose::Meta::Method::Delegation; # spent 9µs making 1 call to import |
18 | 3 | 16µs | 5µs | use Moose::Util (); |
19 | 3 | 119µs | 40µs | use Moose::Util::TypeConstraints (); |
20 | 3 | 34µs | 11µs | use Class::MOP::MiniTrait; # spent 5µs making 1 call to import |
21 | ||||
22 | 3 | 4.52ms | 1.51ms | use base 'Class::MOP::Attribute', 'Moose::Meta::Mixin::AttributeCore'; # spent 9.73ms making 1 call to base::import |
23 | ||||
24 | 1 | 11µs | 11µs | Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait'); # spent 3.15ms making 1 call to Class::MOP::MiniTrait::apply |
25 | ||||
26 | 1 | 18µs | 18µs | __PACKAGE__->meta->add_attribute('traits' => ( # spent 813µs making 1 call to Class::MOP::Mixin::HasAttributes::add_attribute
# spent 24µs making 1 call to Class::MOP::Object::meta |
27 | reader => 'applied_traits', | |||
28 | predicate => 'has_applied_traits', | |||
29 | )); | |||
30 | ||||
31 | # we need to have a ->does method in here to | |||
32 | # more easily support traits, and the introspection | |||
33 | # of those traits. We extend the does check to look | |||
34 | # for metatrait aliases. | |||
35 | sub does { | |||
36 | my ($self, $role_name) = @_; | |||
37 | my $name = try { | |||
38 | Moose::Util::resolve_metatrait_alias(Attribute => $role_name) | |||
39 | }; | |||
40 | return 0 if !defined($name); # failed to load class | |||
41 | return $self->Moose::Object::does($name); | |||
42 | } | |||
43 | ||||
44 | sub throw_error { | |||
45 | my $self = shift; | |||
46 | my $class = ( ref $self && $self->associated_class ) || "Moose::Meta::Class"; | |||
47 | unshift @_, "message" if @_ % 2 == 1; | |||
48 | unshift @_, attr => $self if ref $self; | |||
49 | unshift @_, $class; | |||
50 | my $handler = $class->can("throw_error"); # to avoid incrementing depth by 1 | |||
51 | goto $handler; | |||
52 | } | |||
53 | ||||
54 | # spent 5.69ms (1.18+4.51) within Moose::Meta::Attribute::new which was called 9 times, avg 633µs/call:
# 8 times (1.03ms+2.87ms) by Moose::Meta::Attribute::interpolate_class_and_new at line 82, avg 487µs/call
# once (152µs+1.64ms) at line 20 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeCoercion.pm | |||
55 | 9 | 44µs | 5µs | my ($class, $name, %options) = @_; |
56 | 9 | 63µs | 7µs | $class->_process_options($name, \%options) unless $options{__hack_no_process_options}; # used from clone()... YECHKKK FIXME ICKY YUCK GROSS # spent 605µs making 9 calls to Moose::Meta::Attribute::_process_options, avg 67µs/call |
57 | ||||
58 | 9 | 12µs | 1µs | delete $options{__hack_no_process_options}; |
59 | ||||
60 | my %attrs = | |||
61 | ( map { $_ => 1 } | |||
62 | 252 | 752µs | 3µs | grep { defined } # spent 1.14ms making 252 calls to Class::MOP::Mixin::AttributeCore::init_arg, avg 5µs/call |
63 | 9 | 618µs | 69µs | map { $_->init_arg() } # spent 393µs making 8 calls to Class::MOP::Class::Immutable::Class::MOP::Class::get_all_attributes, avg 49µs/call
# spent 218µs making 9 calls to Class::MOP::Object::meta, avg 24µs/call
# spent 182µs making 1 call to Class::MOP::Class::get_all_attributes |
64 | $class->meta()->get_all_attributes() | |||
65 | ); | |||
66 | ||||
67 | 9 | 74µs | 8µs | my @bad = sort grep { ! $attrs{$_} } keys %options; |
68 | ||||
69 | 9 | 5µs | 544ns | if (@bad) |
70 | { | |||
71 | Carp::cluck "Found unknown argument(s) passed to '$name' attribute constructor in '$class': @bad"; | |||
72 | } | |||
73 | ||||
74 | 9 | 145µs | 16µs | return $class->SUPER::new($name, %options); # spent 1.98ms making 9 calls to Class::MOP::Attribute::new, avg 220µs/call |
75 | } | |||
76 | ||||
77 | # spent 4.15ms (157µs+3.99) within Moose::Meta::Attribute::interpolate_class_and_new which was called 8 times, avg 518µs/call:
# 8 times (157µs+3.99ms) by Moose::Meta::Class::_process_new_attribute at line 431 of /usr/local/lib/perl/5.10.0/Moose/Meta/Class.pm, avg 518µs/call | |||
78 | 8 | 48µs | 6µs | my ($class, $name, %args) = @_; |
79 | ||||
80 | 8 | 61µs | 8µs | my ( $new_class, @traits ) = $class->interpolate_class(\%args); # spent 89µs making 8 calls to Moose::Meta::Attribute::interpolate_class, avg 11µs/call |
81 | ||||
82 | 8 | 66µs | 8µs | $new_class->new($name, %args, ( scalar(@traits) ? ( traits => \@traits ) : () ) ); # spent 3.90ms making 8 calls to Moose::Meta::Attribute::new, avg 487µs/call |
83 | } | |||
84 | ||||
85 | # spent 89µs within Moose::Meta::Attribute::interpolate_class which was called 8 times, avg 11µs/call:
# 8 times (89µs+0s) by Moose::Meta::Attribute::interpolate_class_and_new at line 80, avg 11µs/call | |||
86 | 8 | 14µs | 2µs | my ($class, $options) = @_; |
87 | ||||
88 | 8 | 4µs | 537ns | $class = ref($class) || $class; |
89 | ||||
90 | 8 | 10µs | 1µs | if ( my $metaclass_name = delete $options->{metaclass} ) { |
91 | my $new_class = Moose::Util::resolve_metaclass_alias( Attribute => $metaclass_name ); | |||
92 | ||||
93 | if ( $class ne $new_class ) { | |||
94 | if ( $new_class->can("interpolate_class") ) { | |||
95 | return $new_class->interpolate_class($options); | |||
96 | } else { | |||
97 | $class = $new_class; | |||
98 | } | |||
99 | } | |||
100 | } | |||
101 | ||||
102 | 8 | 4µs | 537ns | my @traits; |
103 | ||||
104 | 8 | 8µs | 963ns | if (my $traits = $options->{traits}) { |
105 | my $i = 0; | |||
106 | while ($i < @$traits) { | |||
107 | my $trait = $traits->[$i++]; | |||
108 | next if ref($trait); # options to a trait we discarded | |||
109 | ||||
110 | $trait = Moose::Util::resolve_metatrait_alias(Attribute => $trait) | |||
111 | || $trait; | |||
112 | ||||
113 | next if $class->does($trait); | |||
114 | ||||
115 | push @traits, $trait; | |||
116 | ||||
117 | # are there options? | |||
118 | push @traits, $traits->[$i++] | |||
119 | if $traits->[$i] && ref($traits->[$i]); | |||
120 | } | |||
121 | ||||
122 | if (@traits) { | |||
123 | my $anon_class = Moose::Meta::Class->create_anon_class( | |||
124 | superclasses => [ $class ], | |||
125 | roles => [ @traits ], | |||
126 | cache => 1, | |||
127 | ); | |||
128 | ||||
129 | $class = $anon_class->name; | |||
130 | } | |||
131 | } | |||
132 | ||||
133 | 8 | 19µs | 2µs | return ( wantarray ? ( $class, @traits ) : $class ); |
134 | } | |||
135 | ||||
136 | # ... | |||
137 | ||||
138 | # method-generating options shouldn't be overridden | |||
139 | sub illegal_options_for_inheritance { | |||
140 | qw(reader writer accessor clearer predicate) | |||
141 | } | |||
142 | ||||
143 | # NOTE/TODO | |||
144 | # This method *must* be able to handle | |||
145 | # Class::MOP::Attribute instances as | |||
146 | # well. Yes, I know that is wrong, but | |||
147 | # apparently we didn't realize it was | |||
148 | # doing that and now we have some code | |||
149 | # which is dependent on it. The real | |||
150 | # solution of course is to push this | |||
151 | # feature back up into Class::MOP::Attribute | |||
152 | # but I not right now, I am too lazy. | |||
153 | # However if you are reading this and | |||
154 | # looking for something to do,.. please | |||
155 | # be my guest. | |||
156 | # - stevan | |||
157 | sub clone_and_inherit_options { | |||
158 | my ($self, %options) = @_; | |||
159 | ||||
160 | # NOTE: | |||
161 | # we may want to extends a Class::MOP::Attribute | |||
162 | # in which case we need to be able to use the | |||
163 | # core set of legal options that have always | |||
164 | # been here. But we allows Moose::Meta::Attribute | |||
165 | # instances to changes them. | |||
166 | # - SL | |||
167 | my @illegal_options = $self->can('illegal_options_for_inheritance') | |||
168 | ? $self->illegal_options_for_inheritance | |||
169 | : (); | |||
170 | ||||
171 | my @found_illegal_options = grep { exists $options{$_} && exists $self->{$_} ? $_ : undef } @illegal_options; | |||
172 | (scalar @found_illegal_options == 0) | |||
173 | || $self->throw_error("Illegal inherited options => (" . (join ', ' => @found_illegal_options) . ")", data => \%options); | |||
174 | ||||
175 | if ($options{isa}) { | |||
176 | my $type_constraint; | |||
177 | if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) { | |||
178 | $type_constraint = $options{isa}; | |||
179 | } | |||
180 | else { | |||
181 | $type_constraint = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options{isa}); | |||
182 | (defined $type_constraint) | |||
183 | || $self->throw_error("Could not find the type constraint '" . $options{isa} . "'", data => $options{isa}); | |||
184 | } | |||
185 | ||||
186 | $options{type_constraint} = $type_constraint; | |||
187 | } | |||
188 | ||||
189 | if ($options{does}) { | |||
190 | my $type_constraint; | |||
191 | if (blessed($options{does}) && $options{does}->isa('Moose::Meta::TypeConstraint')) { | |||
192 | $type_constraint = $options{does}; | |||
193 | } | |||
194 | else { | |||
195 | $type_constraint = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options{does}); | |||
196 | (defined $type_constraint) | |||
197 | || $self->throw_error("Could not find the type constraint '" . $options{does} . "'", data => $options{does}); | |||
198 | } | |||
199 | ||||
200 | $options{type_constraint} = $type_constraint; | |||
201 | } | |||
202 | ||||
203 | # NOTE: | |||
204 | # this doesn't apply to Class::MOP::Attributes, | |||
205 | # so we can ignore it for them. | |||
206 | # - SL | |||
207 | if ($self->can('interpolate_class')) { | |||
208 | ( $options{metaclass}, my @traits ) = $self->interpolate_class(\%options); | |||
209 | ||||
210 | my %seen; | |||
211 | my @all_traits = grep { $seen{$_}++ } @{ $self->applied_traits || [] }, @traits; | |||
212 | $options{traits} = \@all_traits if @all_traits; | |||
213 | } | |||
214 | ||||
215 | $self->clone(%options); | |||
216 | } | |||
217 | ||||
218 | sub clone { | |||
219 | my ( $self, %params ) = @_; | |||
220 | ||||
221 | my $class = delete $params{metaclass} || ref $self; | |||
222 | ||||
223 | my ( @init, @non_init ); | |||
224 | ||||
225 | foreach my $attr ( grep { $_->has_value($self) } Class::MOP::class_of($self)->get_all_attributes ) { | |||
226 | push @{ $attr->has_init_arg ? \@init : \@non_init }, $attr; | |||
227 | } | |||
228 | ||||
229 | my %new_params = ( ( map { $_->init_arg => $_->get_value($self) } @init ), %params ); | |||
230 | ||||
231 | my $name = delete $new_params{name}; | |||
232 | ||||
233 | my $clone = $class->new($name, %new_params, __hack_no_process_options => 1 ); | |||
234 | ||||
235 | foreach my $attr ( @non_init ) { | |||
236 | $attr->set_value($clone, $attr->get_value($self)); | |||
237 | } | |||
238 | ||||
239 | return $clone; | |||
240 | } | |||
241 | ||||
242 | # spent 605µs (207+398) within Moose::Meta::Attribute::_process_options which was called 9 times, avg 67µs/call:
# 9 times (207µs+398µs) by Moose::Meta::Attribute::new at line 56, avg 67µs/call | |||
243 | 9 | 21µs | 2µs | my ($class, $name, $options) = @_; |
244 | ||||
245 | 9 | 12µs | 1µs | if (exists $options->{is}) { |
246 | ||||
247 | ### ------------------------- | |||
248 | ## is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before | |||
249 | ## is => rw, writer => _foo # turns into (reader => foo, writer => _foo) | |||
250 | ## is => rw, accessor => _foo # turns into (accessor => _foo) | |||
251 | ## is => ro, accessor => _foo # error, accesor is rw | |||
252 | ### ------------------------- | |||
253 | ||||
254 | 8 | 18µs | 2µs | if ($options->{is} eq 'ro') { |
255 | 1 | 800ns | 800ns | $class->throw_error("Cannot define an accessor name on a read-only attribute, accessors are read/write", data => $options) |
256 | if exists $options->{accessor}; | |||
257 | 1 | 2µs | 2µs | $options->{reader} ||= $name; |
258 | } | |||
259 | elsif ($options->{is} eq 'rw') { | |||
260 | if ($options->{writer}) { | |||
261 | $options->{reader} ||= $name; | |||
262 | } | |||
263 | else { | |||
264 | 7 | 11µs | 2µs | $options->{accessor} ||= $name; |
265 | } | |||
266 | } | |||
267 | elsif ($options->{is} eq 'bare') { | |||
268 | # do nothing, but don't complain (later) about missing methods | |||
269 | } | |||
270 | else { | |||
271 | $class->throw_error("I do not understand this option (is => " . $options->{is} . ") on attribute ($name)", data => $options->{is}); | |||
272 | } | |||
273 | } | |||
274 | ||||
275 | 9 | 13µs | 1µs | if (exists $options->{isa}) { |
276 | 6 | 3µs | 517ns | if (exists $options->{does}) { |
277 | if (try { $options->{isa}->can('does') }) { | |||
278 | ($options->{isa}->does($options->{does})) | |||
279 | || $class->throw_error("Cannot have an isa option and a does option if the isa does not do the does on attribute ($name)", data => $options); | |||
280 | } | |||
281 | else { | |||
282 | $class->throw_error("Cannot have an isa option which cannot ->does() on attribute ($name)", data => $options); | |||
283 | } | |||
284 | } | |||
285 | ||||
286 | # allow for anon-subtypes here ... | |||
287 | 6 | 33µs | 5µs | if (blessed($options->{isa}) && $options->{isa}->isa('Moose::Meta::TypeConstraint')) { # spent 18µs making 6 calls to Scalar::Util::blessed, avg 3µs/call |
288 | $options->{type_constraint} = $options->{isa}; | |||
289 | } | |||
290 | else { | |||
291 | 6 | 43µs | 7µs | $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($options->{isa}); # spent 380µs making 6 calls to Moose::Util::TypeConstraints::find_or_create_isa_type_constraint, avg 63µs/call |
292 | } | |||
293 | } | |||
294 | elsif (exists $options->{does}) { | |||
295 | # allow for anon-subtypes here ... | |||
296 | if (blessed($options->{does}) && $options->{does}->isa('Moose::Meta::TypeConstraint')) { | |||
297 | $options->{type_constraint} = $options->{does}; | |||
298 | } | |||
299 | else { | |||
300 | $options->{type_constraint} = Moose::Util::TypeConstraints::find_or_create_does_type_constraint($options->{does}); | |||
301 | } | |||
302 | } | |||
303 | ||||
304 | 9 | 7µs | 822ns | if (exists $options->{coerce} && $options->{coerce}) { |
305 | (exists $options->{type_constraint}) | |||
306 | || $class->throw_error("You cannot have coercion without specifying a type constraint on attribute ($name)", data => $options); | |||
307 | $class->throw_error("You cannot have a weak reference to a coerced value on attribute ($name)", data => $options) | |||
308 | if $options->{weak_ref}; | |||
309 | ||||
310 | unless ( $options->{type_constraint}->has_coercion ) { | |||
311 | my $type = $options->{type_constraint}->name; | |||
312 | ||||
313 | Moose::Deprecated::deprecated( | |||
314 | feature => 'coerce without coercion', | |||
315 | message => | |||
316 | "You cannot coerce an attribute ($name) unless its type ($type) has a coercion" | |||
317 | ); | |||
318 | } | |||
319 | } | |||
320 | ||||
321 | 9 | 12µs | 1µs | if (exists $options->{trigger}) { |
322 | ('CODE' eq ref $options->{trigger}) | |||
323 | || $class->throw_error("Trigger must be a CODE ref on attribute ($name)", data => $options->{trigger}); | |||
324 | } | |||
325 | ||||
326 | 9 | 8µs | 856ns | if (exists $options->{auto_deref} && $options->{auto_deref}) { |
327 | (exists $options->{type_constraint}) | |||
328 | || $class->throw_error("You cannot auto-dereference without specifying a type constraint on attribute ($name)", data => $options); | |||
329 | ($options->{type_constraint}->is_a_type_of('ArrayRef') || | |||
330 | $options->{type_constraint}->is_a_type_of('HashRef')) | |||
331 | || $class->throw_error("You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute ($name)", data => $options); | |||
332 | } | |||
333 | ||||
334 | 9 | 7µs | 756ns | if (exists $options->{lazy_build} && $options->{lazy_build} == 1) { |
335 | $class->throw_error("You can not use lazy_build and default for the same attribute ($name)", data => $options) | |||
336 | if exists $options->{default}; | |||
337 | $options->{lazy} = 1; | |||
338 | $options->{builder} ||= "_build_${name}"; | |||
339 | if ($name =~ /^_/) { | |||
340 | $options->{clearer} ||= "_clear${name}"; | |||
341 | $options->{predicate} ||= "_has${name}"; | |||
342 | } | |||
343 | else { | |||
344 | $options->{clearer} ||= "clear_${name}"; | |||
345 | $options->{predicate} ||= "has_${name}"; | |||
346 | } | |||
347 | } | |||
348 | ||||
349 | 9 | 6µs | 667ns | if (exists $options->{lazy} && $options->{lazy}) { |
350 | (exists $options->{default} || defined $options->{builder} ) | |||
351 | || $class->throw_error("You cannot have lazy attribute ($name) without specifying a default value for it", data => $options); | |||
352 | } | |||
353 | ||||
354 | 9 | 15µs | 2µs | if ( $options->{required} && !( ( !exists $options->{init_arg} || defined $options->{init_arg} ) || exists $options->{default} || defined $options->{builder} ) ) { |
355 | $class->throw_error("You cannot have a required attribute ($name) without a default, builder, or an init_arg", data => $options); | |||
356 | } | |||
357 | ||||
358 | } | |||
359 | ||||
360 | sub initialize_instance_slot { | |||
361 | my ($self, $meta_instance, $instance, $params) = @_; | |||
362 | my $init_arg = $self->init_arg(); | |||
363 | # try to fetch the init arg from the %params ... | |||
364 | ||||
365 | my $val; | |||
366 | my $value_is_set; | |||
367 | if ( defined($init_arg) and exists $params->{$init_arg}) { | |||
368 | $val = $params->{$init_arg}; | |||
369 | $value_is_set = 1; | |||
370 | } | |||
371 | else { | |||
372 | # skip it if it's lazy | |||
373 | return if $self->is_lazy; | |||
374 | # and die if it's required and doesn't have a default value | |||
375 | $self->throw_error("Attribute (" . $self->name . ") is required", object => $instance, data => $params) | |||
376 | if $self->is_required && !$self->has_default && !$self->has_builder; | |||
377 | ||||
378 | # if nothing was in the %params, we can use the | |||
379 | # attribute's default value (if it has one) | |||
380 | if ($self->has_default) { | |||
381 | $val = $self->default($instance); | |||
382 | $value_is_set = 1; | |||
383 | } | |||
384 | elsif ($self->has_builder) { | |||
385 | $val = $self->_call_builder($instance); | |||
386 | $value_is_set = 1; | |||
387 | } | |||
388 | } | |||
389 | ||||
390 | return unless $value_is_set; | |||
391 | ||||
392 | $val = $self->_coerce_and_verify( $val, $instance ); | |||
393 | ||||
394 | $self->set_initial_value($instance, $val); | |||
395 | ||||
396 | if ( ref $val && $self->is_weak_ref ) { | |||
397 | $self->_weaken_value($instance); | |||
398 | } | |||
399 | } | |||
400 | ||||
401 | sub _call_builder { | |||
402 | my ( $self, $instance ) = @_; | |||
403 | ||||
404 | my $builder = $self->builder(); | |||
405 | ||||
406 | return $instance->$builder() | |||
407 | if $instance->can( $self->builder ); | |||
408 | ||||
409 | $self->throw_error( blessed($instance) | |||
410 | . " does not support builder method '" | |||
411 | . $self->builder | |||
412 | . "' for attribute '" | |||
413 | . $self->name | |||
414 | . "'", | |||
415 | object => $instance, | |||
416 | ); | |||
417 | } | |||
418 | ||||
419 | ## Slot management | |||
420 | ||||
421 | # FIXME: | |||
422 | # this duplicates too much code from | |||
423 | # Class::MOP::Attribute, we need to | |||
424 | # refactor these bits eventually. | |||
425 | # - SL | |||
426 | sub _set_initial_slot_value { | |||
427 | my ($self, $meta_instance, $instance, $value) = @_; | |||
428 | ||||
429 | my $slot_name = $self->name; | |||
430 | ||||
431 | return $meta_instance->set_slot_value($instance, $slot_name, $value) | |||
432 | unless $self->has_initializer; | |||
433 | ||||
434 | my $callback = sub { | |||
435 | my $val = $self->_coerce_and_verify( shift, $instance );; | |||
436 | ||||
437 | $meta_instance->set_slot_value($instance, $slot_name, $val); | |||
438 | }; | |||
439 | ||||
440 | my $initializer = $self->initializer; | |||
441 | ||||
442 | # most things will just want to set a value, so make it first arg | |||
443 | $instance->$initializer($value, $callback, $self); | |||
444 | } | |||
445 | ||||
446 | sub set_value { | |||
447 | my ($self, $instance, @args) = @_; | |||
448 | my $value = $args[0]; | |||
449 | ||||
450 | my $attr_name = $self->name; | |||
451 | ||||
452 | if ($self->is_required and not @args) { | |||
453 | $self->throw_error("Attribute ($attr_name) is required", object => $instance); | |||
454 | } | |||
455 | ||||
456 | $value = $self->_coerce_and_verify( $value, $instance ); | |||
457 | ||||
458 | my @old; | |||
459 | if ( $self->has_trigger && $self->has_value($instance) ) { | |||
460 | @old = $self->get_value($instance, 'for trigger'); | |||
461 | } | |||
462 | ||||
463 | $self->SUPER::set_value($instance, $value); | |||
464 | ||||
465 | if ( ref $value && $self->is_weak_ref ) { | |||
466 | $self->_weaken_value($instance); | |||
467 | } | |||
468 | ||||
469 | if ($self->has_trigger) { | |||
470 | $self->trigger->($instance, $value, @old); | |||
471 | } | |||
472 | } | |||
473 | ||||
474 | sub _weaken_value { | |||
475 | my ( $self, $instance ) = @_; | |||
476 | ||||
477 | my $meta_instance = Class::MOP::Class->initialize( blessed($instance) ) | |||
478 | ->get_meta_instance; | |||
479 | ||||
480 | $meta_instance->weaken_slot_value( $instance, $self->name ); | |||
481 | } | |||
482 | ||||
483 | sub get_value { | |||
484 | my ($self, $instance, $for_trigger) = @_; | |||
485 | ||||
486 | if ($self->is_lazy) { | |||
487 | unless ($self->has_value($instance)) { | |||
488 | my $value; | |||
489 | if ($self->has_default) { | |||
490 | $value = $self->default($instance); | |||
491 | } elsif ( $self->has_builder ) { | |||
492 | $value = $self->_call_builder($instance); | |||
493 | } | |||
494 | ||||
495 | $value = $self->_coerce_and_verify( $value, $instance ); | |||
496 | ||||
497 | $self->set_initial_value($instance, $value); | |||
498 | } | |||
499 | } | |||
500 | ||||
501 | if ( $self->should_auto_deref && ! $for_trigger ) { | |||
502 | ||||
503 | my $type_constraint = $self->type_constraint; | |||
504 | ||||
505 | if ($type_constraint->is_a_type_of('ArrayRef')) { | |||
506 | my $rv = $self->SUPER::get_value($instance); | |||
507 | return unless defined $rv; | |||
508 | return wantarray ? @{ $rv } : $rv; | |||
509 | } | |||
510 | elsif ($type_constraint->is_a_type_of('HashRef')) { | |||
511 | my $rv = $self->SUPER::get_value($instance); | |||
512 | return unless defined $rv; | |||
513 | return wantarray ? %{ $rv } : $rv; | |||
514 | } | |||
515 | else { | |||
516 | $self->throw_error("Can not auto de-reference the type constraint '" . $type_constraint->name . "'", object => $instance, type_constraint => $type_constraint); | |||
517 | } | |||
518 | ||||
519 | } | |||
520 | else { | |||
521 | ||||
522 | return $self->SUPER::get_value($instance); | |||
523 | } | |||
524 | } | |||
525 | ||||
526 | ## installing accessors | |||
527 | ||||
528 | 11 | 22µs | 2µs | # spent 57µs within Moose::Meta::Attribute::accessor_metaclass which was called 11 times, avg 5µs/call:
# 11 times (57µs+0s) by Class::MOP::Attribute::_process_accessors or Class::MOP::Attribute::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm:342] at line 334 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 5µs/call |
529 | ||||
530 | # spent 19.7ms (141µs+19.5) within Moose::Meta::Attribute::install_accessors which was called 10 times, avg 1.97ms/call:
# 9 times (123µs+17.6ms) by Class::MOP::Class::_post_add_attribute or Class::MOP::Class::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Class.pm:768] at line 767 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 1.97ms/call
# once (18µs+1.94ms) by Class::MOP::Class::_inline_accessors at line 1273 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm | |||
531 | 10 | 6µs | 610ns | my $self = shift; |
532 | 10 | 81µs | 8µs | $self->SUPER::install_accessors(@_); # spent 19.3ms making 10 calls to Class::MOP::Attribute::install_accessors, avg 1.93ms/call |
533 | 10 | 64µs | 6µs | $self->install_delegation if $self->has_handles; # spent 175µs making 10 calls to Moose::Meta::Mixin::AttributeCore::has_handles, avg 17µs/call |
534 | 10 | 10µs | 980ns | return; |
535 | } | |||
536 | ||||
537 | # spent 91µs (55+36) within Moose::Meta::Attribute::_check_associated_methods which was called 8 times, avg 11µs/call:
# 8 times (55µs+36µs) by Moose::Meta::Class::add_attribute at line 301 of /usr/local/lib/perl/5.10.0/Moose/Meta/Class.pm, avg 11µs/call | |||
538 | 8 | 6µs | 750ns | my $self = shift; |
539 | 8 | 43µs | 5µs | unless ( # spent 36µs making 8 calls to Class::MOP::Attribute::associated_methods, avg 4µs/call |
540 | @{ $self->associated_methods } | |||
541 | || ($self->_is_metadata || '') eq 'bare' | |||
542 | ) { | |||
543 | Carp::cluck( | |||
544 | 'Attribute (' . $self->name . ') of class ' | |||
545 | . $self->associated_class->name | |||
546 | . ' has no associated methods' | |||
547 | . ' (did you mean to provide an "is" argument?)' | |||
548 | . "\n" | |||
549 | ) | |||
550 | } | |||
551 | } | |||
552 | ||||
553 | # spent 17.1ms (301µs+16.8) within Moose::Meta::Attribute::_process_accessors which was called 11 times, avg 1.56ms/call:
# 7 times (186µs+9.44ms) by Class::MOP::Attribute::install_accessors at line 356 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 1.38ms/call
# 3 times (91µs+6.25ms) by Class::MOP::Attribute::install_accessors at line 360 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm, avg 2.11ms/call
# once (25µs+1.15ms) by Class::MOP::Attribute::install_accessors at line 364 of /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm | |||
554 | 11 | 7µs | 618ns | my $self = shift; |
555 | 11 | 23µs | 2µs | my ($type, $accessor, $generate_as_inline_methods) = @_; |
556 | 11 | 10µs | 873ns | $accessor = (keys %$accessor)[0] if (ref($accessor)||'') eq 'HASH'; |
557 | 11 | 101µs | 9µs | my $method = $self->associated_class->get_method($accessor); # spent 993µs making 11 calls to Class::MOP::Mixin::HasMethods::get_method, avg 90µs/call
# spent 40µs making 11 calls to Class::MOP::Attribute::associated_class, avg 4µs/call |
558 | 11 | 26µs | 2µs | if ($method && !$method->isa('Class::MOP::Method::Accessor') # spent 10µs making 1 call to UNIVERSAL::isa |
559 | && (!$self->definition_context | |||
560 | || $method->package_name eq $self->definition_context->{package})) { | |||
561 | Carp::cluck( | |||
562 | "You are overwriting a locally defined method ($accessor) with " | |||
563 | . "an accessor" | |||
564 | ); | |||
565 | } | |||
566 | 11 | 215µs | 20µs | if (!$self->associated_class->has_method($accessor) # spent 581µs making 11 calls to Class::MOP::Mixin::HasMethods::has_method, avg 53µs/call
# spent 471µs making 10 calls to Class::MOP::Package::has_package_symbol, avg 47µs/call
# spent 74µs making 21 calls to Class::MOP::Attribute::associated_class, avg 4µs/call |
567 | && $self->associated_class->has_package_symbol('&' . $accessor)) { | |||
568 | Carp::cluck( | |||
569 | "You are overwriting a locally defined function ($accessor) with " | |||
570 | . "an accessor" | |||
571 | ); | |||
572 | } | |||
573 | 11 | 98µs | 9µs | $self->SUPER::_process_accessors(@_); # spent 14.7ms making 11 calls to Class::MOP::Attribute::_process_accessors, avg 1.33ms/call |
574 | } | |||
575 | ||||
576 | sub remove_accessors { | |||
577 | my $self = shift; | |||
578 | $self->SUPER::remove_accessors(@_); | |||
579 | $self->remove_delegation if $self->has_handles; | |||
580 | return; | |||
581 | } | |||
582 | ||||
583 | # spent 2.92ms (422µs+2.49) within Moose::Meta::Attribute::inline_set which was called 26 times, avg 112µs/call:
# 16 times (222µs+572µs) by Moose::Meta::Method::Constructor::_generate_slot_assignment at line 281 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Constructor.pm, avg 50µs/call
# 8 times (141µs+1.66ms) by Moose::Meta::Method::Accessor::_inline_store at line 252 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Accessor.pm, avg 226µs/call
# 2 times (58µs+257µs) by Class::MOP::Method::Constructor::_generate_slot_initializer at line 142 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Constructor.pm, avg 158µs/call | |||
584 | 26 | 13µs | 508ns | my $self = shift; |
585 | 26 | 45µs | 2µs | my ( $instance, $value ) = @_; |
586 | ||||
587 | 26 | 202µs | 8µs | my $mi = $self->associated_class->get_meta_instance; # spent 1.46ms making 23 calls to Class::MOP::Class::get_meta_instance, avg 64µs/call
# spent 106µs making 26 calls to Class::MOP::Attribute::associated_class, avg 4µs/call
# spent 42µs making 2 calls to Class::MOP::Class::Immutable::Moose::Meta::Class::get_meta_instance, avg 21µs/call
# spent 30µs making 1 call to Class::MOP::Class::Immutable::Class::MOP::Class::get_meta_instance |
588 | ||||
589 | 26 | 254µs | 10µs | my $code # spent 407µs making 26 calls to Class::MOP::Instance::inline_set_slot_value, avg 16µs/call
# spent 182µs making 26 calls to Class::MOP::Attribute::slots, avg 7µs/call |
590 | = $mi->inline_set_slot_value( $instance, $self->slots, $value ) . ";"; | |||
591 | 26 | 154µs | 6µs | $code # spent 221µs making 26 calls to Moose::Meta::Mixin::AttributeCore::is_weak_ref, avg 9µs/call
# spent 32µs making 2 calls to Class::MOP::Instance::inline_weaken_slot_value, avg 16µs/call
# spent 13µs making 2 calls to Class::MOP::Attribute::slots, avg 6µs/call |
592 | .= $mi->inline_weaken_slot_value( $instance, $self->slots, $value ) | |||
593 | . " if ref $value;" | |||
594 | if $self->is_weak_ref; | |||
595 | ||||
596 | 26 | 41µs | 2µs | return $code; |
597 | } | |||
598 | ||||
599 | sub install_delegation { | |||
600 | my $self = shift; | |||
601 | ||||
602 | # NOTE: | |||
603 | # Here we canonicalize the 'handles' option | |||
604 | # this will sort out any details and always | |||
605 | # return an hash of methods which we want | |||
606 | # to delagate to, see that method for details | |||
607 | my %handles = $self->_canonicalize_handles; | |||
608 | ||||
609 | ||||
610 | # install the delegation ... | |||
611 | my $associated_class = $self->associated_class; | |||
612 | foreach my $handle (keys %handles) { | |||
613 | my $method_to_call = $handles{$handle}; | |||
614 | my $class_name = $associated_class->name; | |||
615 | my $name = "${class_name}::${handle}"; | |||
616 | ||||
617 | (!$associated_class->has_method($handle)) | |||
618 | || $self->throw_error("You cannot overwrite a locally defined method ($handle) with a delegation", method_name => $handle); | |||
619 | ||||
620 | # NOTE: | |||
621 | # handles is not allowed to delegate | |||
622 | # any of these methods, as they will | |||
623 | # override the ones in your class, which | |||
624 | # is almost certainly not what you want. | |||
625 | ||||
626 | # FIXME warn when $handle was explicitly specified, but not if the source is a regex or something | |||
627 | #cluck("Not delegating method '$handle' because it is a core method") and | |||
628 | next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle); | |||
629 | ||||
630 | my $method = $self->_make_delegation_method($handle, $method_to_call); | |||
631 | ||||
632 | $self->associated_class->add_method($method->name, $method); | |||
633 | $self->associate_method($method); | |||
634 | } | |||
635 | } | |||
636 | ||||
637 | sub remove_delegation { | |||
638 | my $self = shift; | |||
639 | my %handles = $self->_canonicalize_handles; | |||
640 | my $associated_class = $self->associated_class; | |||
641 | foreach my $handle (keys %handles) { | |||
642 | next unless any { $handle eq $_ } | |||
643 | map { $_->name } | |||
644 | @{ $self->associated_methods }; | |||
645 | $self->associated_class->remove_method($handle); | |||
646 | } | |||
647 | } | |||
648 | ||||
649 | # private methods to help delegation ... | |||
650 | ||||
651 | sub _canonicalize_handles { | |||
652 | my $self = shift; | |||
653 | my $handles = $self->handles; | |||
654 | if (my $handle_type = ref($handles)) { | |||
655 | if ($handle_type eq 'HASH') { | |||
656 | return %{$handles}; | |||
657 | } | |||
658 | elsif ($handle_type eq 'ARRAY') { | |||
659 | return map { $_ => $_ } @{$handles}; | |||
660 | } | |||
661 | elsif ($handle_type eq 'Regexp') { | |||
662 | ($self->has_type_constraint) | |||
663 | || $self->throw_error("Cannot delegate methods based on a Regexp without a type constraint (isa)", data => $handles); | |||
664 | return map { ($_ => $_) } | |||
665 | grep { /$handles/ } $self->_get_delegate_method_list; | |||
666 | } | |||
667 | elsif ($handle_type eq 'CODE') { | |||
668 | return $handles->($self, $self->_find_delegate_metaclass); | |||
669 | } | |||
670 | elsif (blessed($handles) && $handles->isa('Moose::Meta::TypeConstraint::DuckType')) { | |||
671 | return map { $_ => $_ } @{ $handles->methods }; | |||
672 | } | |||
673 | elsif (blessed($handles) && $handles->isa('Moose::Meta::TypeConstraint::Role')) { | |||
674 | $handles = $handles->role; | |||
675 | } | |||
676 | else { | |||
677 | $self->throw_error("Unable to canonicalize the 'handles' option with $handles", data => $handles); | |||
678 | } | |||
679 | } | |||
680 | ||||
681 | Class::MOP::load_class($handles); | |||
682 | my $role_meta = Class::MOP::class_of($handles); | |||
683 | ||||
684 | (blessed $role_meta && $role_meta->isa('Moose::Meta::Role')) | |||
685 | || $self->throw_error("Unable to canonicalize the 'handles' option with $handles because its metaclass is not a Moose::Meta::Role", data => $handles); | |||
686 | ||||
687 | return map { $_ => $_ } | |||
688 | map { $_->name } | |||
689 | grep { !$_->isa('Class::MOP::Method::Meta') } ( | |||
690 | $role_meta->_get_local_methods, | |||
691 | $role_meta->get_required_method_list, | |||
692 | ); | |||
693 | } | |||
694 | ||||
695 | sub _find_delegate_metaclass { | |||
696 | my $self = shift; | |||
697 | if (my $class = $self->_isa_metadata) { | |||
698 | # we might be dealing with a non-Moose class, | |||
699 | # and need to make our own metaclass. if there's | |||
700 | # already a metaclass, it will be returned | |||
701 | return Class::MOP::Class->initialize($class); | |||
702 | } | |||
703 | elsif (my $role = $self->_does_metadata) { | |||
704 | return Class::MOP::class_of($role); | |||
705 | } | |||
706 | else { | |||
707 | $self->throw_error("Cannot find delegate metaclass for attribute " . $self->name); | |||
708 | } | |||
709 | } | |||
710 | ||||
711 | sub _get_delegate_method_list { | |||
712 | my $self = shift; | |||
713 | my $meta = $self->_find_delegate_metaclass; | |||
714 | if ($meta->isa('Class::MOP::Class')) { | |||
715 | return map { $_->name } # NOTE: !never! delegate &meta | |||
716 | grep { $_->package_name ne 'Moose::Object' && !$_->isa('Class::MOP::Method::Meta') } | |||
717 | $meta->get_all_methods; | |||
718 | } | |||
719 | elsif ($meta->isa('Moose::Meta::Role')) { | |||
720 | return $meta->get_method_list; | |||
721 | } | |||
722 | else { | |||
723 | $self->throw_error("Unable to recognize the delegate metaclass '$meta'", data => $meta); | |||
724 | } | |||
725 | } | |||
726 | ||||
727 | sub delegation_metaclass { 'Moose::Meta::Method::Delegation' } | |||
728 | ||||
729 | sub _make_delegation_method { | |||
730 | my ( $self, $handle_name, $method_to_call ) = @_; | |||
731 | ||||
732 | my @curried_arguments; | |||
733 | ||||
734 | ($method_to_call, @curried_arguments) = @$method_to_call | |||
735 | if 'ARRAY' eq ref($method_to_call); | |||
736 | ||||
737 | return $self->delegation_metaclass->new( | |||
738 | name => $handle_name, | |||
739 | package_name => $self->associated_class->name, | |||
740 | attribute => $self, | |||
741 | delegate_to_method => $method_to_call, | |||
742 | curried_arguments => \@curried_arguments, | |||
743 | ); | |||
744 | } | |||
745 | ||||
746 | sub _coerce_and_verify { | |||
747 | my $self = shift; | |||
748 | my $val = shift; | |||
749 | my $instance = shift; | |||
750 | ||||
751 | return $val unless $self->has_type_constraint; | |||
752 | ||||
753 | $val = $self->type_constraint->coerce($val) | |||
754 | if $self->should_coerce && $self->type_constraint->has_coercion; | |||
755 | ||||
756 | $self->verify_against_type_constraint($val, instance => $instance); | |||
757 | ||||
758 | return $val; | |||
759 | } | |||
760 | ||||
761 | sub verify_against_type_constraint { | |||
762 | my $self = shift; | |||
763 | my $val = shift; | |||
764 | ||||
765 | return 1 if !$self->has_type_constraint; | |||
766 | ||||
767 | my $type_constraint = $self->type_constraint; | |||
768 | ||||
769 | $type_constraint->check($val) | |||
770 | || $self->throw_error("Attribute (" | |||
771 | . $self->name | |||
772 | . ") does not pass the type constraint because: " | |||
773 | . $type_constraint->get_message($val), data => $val, @_); | |||
774 | } | |||
775 | ||||
776 | package Moose::Meta::Attribute::Custom::Moose; | |||
777 | sub register_implementation { 'Moose::Meta::Attribute' } | |||
778 | ||||
779 | 1 | 11µs | 11µs | 1; |
780 | ||||
781 | __END__ | |||
782 | ||||
783 | =pod | |||
784 | ||||
785 | =head1 NAME | |||
786 | ||||
787 | Moose::Meta::Attribute - The Moose attribute metaclass | |||
788 | ||||
789 | =head1 DESCRIPTION | |||
790 | ||||
791 | This class is a subclass of L<Class::MOP::Attribute> that provides | |||
792 | additional Moose-specific functionality. | |||
793 | ||||
794 | To really understand this class, you will need to start with the | |||
795 | L<Class::MOP::Attribute> documentation. This class can be understood | |||
796 | as a set of additional features on top of the basic feature provided | |||
797 | by that parent class. | |||
798 | ||||
799 | =head1 INHERITANCE | |||
800 | ||||
801 | C<Moose::Meta::Attribute> is a subclass of L<Class::MOP::Attribute>. | |||
802 | ||||
803 | =head1 METHODS | |||
804 | ||||
805 | Many of the documented below override methods in | |||
806 | L<Class::MOP::Attribute> and add Moose specific features. | |||
807 | ||||
808 | =head2 Creation | |||
809 | ||||
810 | =over 4 | |||
811 | ||||
812 | =item B<< Moose::Meta::Attribute->new(%options) >> | |||
813 | ||||
814 | This method overrides the L<Class::MOP::Attribute> constructor. | |||
815 | ||||
816 | Many of the options below are described in more detail in the | |||
817 | L<Moose::Manual::Attributes> document. | |||
818 | ||||
819 | It adds the following options to the constructor: | |||
820 | ||||
821 | =over 8 | |||
822 | ||||
823 | =item * is => 'ro', 'rw', 'bare' | |||
824 | ||||
825 | This provides a shorthand for specifying the C<reader>, C<writer>, or | |||
826 | C<accessor> names. If the attribute is read-only ('ro') then it will | |||
827 | have a C<reader> method with the same attribute as the name. | |||
828 | ||||
829 | If it is read-write ('rw') then it will have an C<accessor> method | |||
830 | with the same name. If you provide an explicit C<writer> for a | |||
831 | read-write attribute, then you will have a C<reader> with the same | |||
832 | name as the attribute, and a C<writer> with the name you provided. | |||
833 | ||||
834 | Use 'bare' when you are deliberately not installing any methods | |||
835 | (accessor, reader, etc.) associated with this attribute; otherwise, | |||
836 | Moose will issue a deprecation warning when this attribute is added to a | |||
837 | metaclass. | |||
838 | ||||
839 | =item * isa => $type | |||
840 | ||||
841 | This option accepts a type. The type can be a string, which should be | |||
842 | a type name. If the type name is unknown, it is assumed to be a class | |||
843 | name. | |||
844 | ||||
845 | This option can also accept a L<Moose::Meta::TypeConstraint> object. | |||
846 | ||||
847 | If you I<also> provide a C<does> option, then your C<isa> option must | |||
848 | be a class name, and that class must do the role specified with | |||
849 | C<does>. | |||
850 | ||||
851 | =item * does => $role | |||
852 | ||||
853 | This is short-hand for saying that the attribute's type must be an | |||
854 | object which does the named role. | |||
855 | ||||
856 | =item * coerce => $bool | |||
857 | ||||
858 | This option is only valid for objects with a type constraint | |||
859 | (C<isa>) that defined a coercion. If this is true, then coercions will be applied whenever | |||
860 | this attribute is set. | |||
861 | ||||
862 | You can make both this and the C<weak_ref> option true. | |||
863 | ||||
864 | =item * trigger => $sub | |||
865 | ||||
866 | This option accepts a subroutine reference, which will be called after | |||
867 | the attribute is set. | |||
868 | ||||
869 | =item * required => $bool | |||
870 | ||||
871 | An attribute which is required must be provided to the constructor. An | |||
872 | attribute which is required can also have a C<default> or C<builder>, | |||
873 | which will satisfy its required-ness. | |||
874 | ||||
875 | A required attribute must have a C<default>, C<builder> or a | |||
876 | non-C<undef> C<init_arg> | |||
877 | ||||
878 | =item * lazy => $bool | |||
879 | ||||
880 | A lazy attribute must have a C<default> or C<builder>. When an | |||
881 | attribute is lazy, the default value will not be calculated until the | |||
882 | attribute is read. | |||
883 | ||||
884 | =item * weak_ref => $bool | |||
885 | ||||
886 | If this is true, the attribute's value will be stored as a weak | |||
887 | reference. | |||
888 | ||||
889 | =item * auto_deref => $bool | |||
890 | ||||
891 | If this is true, then the reader will dereference the value when it is | |||
892 | called. The attribute must have a type constraint which defines the | |||
893 | attribute as an array or hash reference. | |||
894 | ||||
895 | =item * lazy_build => $bool | |||
896 | ||||
897 | Setting this to true makes the attribute lazy and provides a number of | |||
898 | default methods. | |||
899 | ||||
900 | has 'size' => ( | |||
901 | is => 'ro', | |||
902 | lazy_build => 1, | |||
903 | ); | |||
904 | ||||
905 | is equivalent to this: | |||
906 | ||||
907 | has 'size' => ( | |||
908 | is => 'ro', | |||
909 | lazy => 1, | |||
910 | builder => '_build_size', | |||
911 | clearer => 'clear_size', | |||
912 | predicate => 'has_size', | |||
913 | ); | |||
914 | ||||
915 | =item * documentation | |||
916 | ||||
917 | An arbitrary string that can be retrieved later by calling C<< | |||
918 | $attr->documentation >>. | |||
919 | ||||
920 | =back | |||
921 | ||||
922 | =item B<< $attr->clone(%options) >> | |||
923 | ||||
924 | This creates a new attribute based on attribute being cloned. You must | |||
925 | supply a C<name> option to provide a new name for the attribute. | |||
926 | ||||
927 | The C<%options> can only specify options handled by | |||
928 | L<Class::MOP::Attribute>. | |||
929 | ||||
930 | =back | |||
931 | ||||
932 | =head2 Value management | |||
933 | ||||
934 | =over 4 | |||
935 | ||||
936 | =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >> | |||
937 | ||||
938 | This method is used internally to initialize the attribute's slot in | |||
939 | the object C<$instance>. | |||
940 | ||||
941 | This overrides the L<Class::MOP::Attribute> method to handle lazy | |||
942 | attributes, weak references, and type constraints. | |||
943 | ||||
944 | =item B<get_value> | |||
945 | ||||
946 | =item B<set_value> | |||
947 | ||||
948 | eval { $point->meta->get_attribute('x')->set_value($point, 'forty-two') }; | |||
949 | if($@) { | |||
950 | print "Oops: $@\n"; | |||
951 | } | |||
952 | ||||
953 | I<Attribute (x) does not pass the type constraint (Int) with 'forty-two'> | |||
954 | ||||
955 | Before setting the value, a check is made on the type constraint of | |||
956 | the attribute, if it has one, to see if the value passes it. If the | |||
957 | value fails to pass, the set operation dies with a L</throw_error>. | |||
958 | ||||
959 | Any coercion to convert values is done before checking the type constraint. | |||
960 | ||||
961 | To check a value against a type constraint before setting it, fetch the | |||
962 | attribute instance using L<Class::MOP::Class/find_attribute_by_name>, | |||
963 | fetch the type_constraint from the attribute using L<Moose::Meta::Attribute/type_constraint> | |||
964 | and call L<Moose::Meta::TypeConstraint/check>. See L<Moose::Cookbook::Basics::Recipe4> | |||
965 | for an example. | |||
966 | ||||
967 | =back | |||
968 | ||||
969 | =head2 Attribute Accessor generation | |||
970 | ||||
971 | =over 4 | |||
972 | ||||
973 | =item B<< $attr->install_accessors >> | |||
974 | ||||
975 | This method overrides the parent to also install delegation methods. | |||
976 | ||||
977 | If, after installing all methods, the attribute object has no associated | |||
978 | methods, it throws an error unless C<< is => 'bare' >> was passed to the | |||
979 | attribute constructor. (Trying to add an attribute that has no associated | |||
980 | methods is almost always an error.) | |||
981 | ||||
982 | =item B<< $attr->remove_accessors >> | |||
983 | ||||
984 | This method overrides the parent to also remove delegation methods. | |||
985 | ||||
986 | =item B<< $attr->inline_set($instance_var, $value_var) >> | |||
987 | ||||
988 | This method return a code snippet suitable for inlining the relevant | |||
989 | operation. It expect strings containing variable names to be used in the | |||
990 | inlining, like C<'$self'> or C<'$_[1]'>. | |||
991 | ||||
992 | =item B<< $attr->install_delegation >> | |||
993 | ||||
994 | This method adds its delegation methods to the attribute's associated | |||
995 | class, if it has any to add. | |||
996 | ||||
997 | =item B<< $attr->remove_delegation >> | |||
998 | ||||
999 | This method remove its delegation methods from the attribute's | |||
1000 | associated class. | |||
1001 | ||||
1002 | =item B<< $attr->accessor_metaclass >> | |||
1003 | ||||
1004 | Returns the accessor metaclass name, which defaults to | |||
1005 | L<Moose::Meta::Method::Accessor>. | |||
1006 | ||||
1007 | =item B<< $attr->delegation_metaclass >> | |||
1008 | ||||
1009 | Returns the delegation metaclass name, which defaults to | |||
1010 | L<Moose::Meta::Method::Delegation>. | |||
1011 | ||||
1012 | =back | |||
1013 | ||||
1014 | =head2 Additional Moose features | |||
1015 | ||||
1016 | These methods are not found in the superclass. They support features | |||
1017 | provided by Moose. | |||
1018 | ||||
1019 | =over 4 | |||
1020 | ||||
1021 | =item B<< $attr->does($role) >> | |||
1022 | ||||
1023 | This indicates whether the I<attribute itself> does the given | |||
1024 | role. The role can be given as a full class name, or as a resolvable | |||
1025 | trait name. | |||
1026 | ||||
1027 | Note that this checks the attribute itself, not its type constraint, | |||
1028 | so it is checking the attribute's metaclass and any traits applied to | |||
1029 | the attribute. | |||
1030 | ||||
1031 | =item B<< Moose::Meta::Class->interpolate_class_and_new($name, %options) >> | |||
1032 | ||||
1033 | This is an alternate constructor that handles the C<metaclass> and | |||
1034 | C<traits> options. | |||
1035 | ||||
1036 | Effectively, this method is a factory that finds or creates the | |||
1037 | appropriate class for the given C<metaclass> and/or C<traits>. | |||
1038 | ||||
1039 | Once it has the appropriate class, it will call C<< $class->new($name, | |||
1040 | %options) >> on that class. | |||
1041 | ||||
1042 | =item B<< $attr->clone_and_inherit_options(%options) >> | |||
1043 | ||||
1044 | This method supports the C<has '+foo'> feature. It does various bits | |||
1045 | of processing on the supplied C<%options> before ultimately calling | |||
1046 | the C<clone> method. | |||
1047 | ||||
1048 | One of its main tasks is to make sure that the C<%options> provided | |||
1049 | does not include the options returned by the | |||
1050 | C<illegal_options_for_inheritance> method. | |||
1051 | ||||
1052 | =item B<< $attr->illegal_options_for_inheritance >> | |||
1053 | ||||
1054 | This returns a blacklist of options that can not be overridden in a | |||
1055 | subclass's attribute definition. | |||
1056 | ||||
1057 | This exists to allow a custom metaclass to change or add to the list | |||
1058 | of options which can not be changed. | |||
1059 | ||||
1060 | =item B<< $attr->type_constraint >> | |||
1061 | ||||
1062 | Returns the L<Moose::Meta::TypeConstraint> object for this attribute, | |||
1063 | if it has one. | |||
1064 | ||||
1065 | =item B<< $attr->has_type_constraint >> | |||
1066 | ||||
1067 | Returns true if this attribute has a type constraint. | |||
1068 | ||||
1069 | =item B<< $attr->verify_against_type_constraint($value) >> | |||
1070 | ||||
1071 | Given a value, this method returns true if the value is valid for the | |||
1072 | attribute's type constraint. If the value is not valid, it throws an | |||
1073 | error. | |||
1074 | ||||
1075 | =item B<< $attr->handles >> | |||
1076 | ||||
1077 | This returns the value of the C<handles> option passed to the | |||
1078 | constructor. | |||
1079 | ||||
1080 | =item B<< $attr->has_handles >> | |||
1081 | ||||
1082 | Returns true if this attribute performs delegation. | |||
1083 | ||||
1084 | =item B<< $attr->is_weak_ref >> | |||
1085 | ||||
1086 | Returns true if this attribute stores its value as a weak reference. | |||
1087 | ||||
1088 | =item B<< $attr->is_required >> | |||
1089 | ||||
1090 | Returns true if this attribute is required to have a value. | |||
1091 | ||||
1092 | =item B<< $attr->is_lazy >> | |||
1093 | ||||
1094 | Returns true if this attribute is lazy. | |||
1095 | ||||
1096 | =item B<< $attr->is_lazy_build >> | |||
1097 | ||||
1098 | Returns true if the C<lazy_build> option was true when passed to the | |||
1099 | constructor. | |||
1100 | ||||
1101 | =item B<< $attr->should_coerce >> | |||
1102 | ||||
1103 | Returns true if the C<coerce> option passed to the constructor was | |||
1104 | true. | |||
1105 | ||||
1106 | =item B<< $attr->should_auto_deref >> | |||
1107 | ||||
1108 | Returns true if the C<auto_deref> option passed to the constructor was | |||
1109 | true. | |||
1110 | ||||
1111 | =item B<< $attr->trigger >> | |||
1112 | ||||
1113 | This is the subroutine reference that was in the C<trigger> option | |||
1114 | passed to the constructor, if any. | |||
1115 | ||||
1116 | =item B<< $attr->has_trigger >> | |||
1117 | ||||
1118 | Returns true if this attribute has a trigger set. | |||
1119 | ||||
1120 | =item B<< $attr->documentation >> | |||
1121 | ||||
1122 | Returns the value that was in the C<documentation> option passed to | |||
1123 | the constructor, if any. | |||
1124 | ||||
1125 | =item B<< $attr->has_documentation >> | |||
1126 | ||||
1127 | Returns true if this attribute has any documentation. | |||
1128 | ||||
1129 | =item B<< $attr->applied_traits >> | |||
1130 | ||||
1131 | This returns an array reference of all the traits which were applied | |||
1132 | to this attribute. If none were applied, this returns C<undef>. | |||
1133 | ||||
1134 | =item B<< $attr->has_applied_traits >> | |||
1135 | ||||
1136 | Returns true if this attribute has any traits applied. | |||
1137 | ||||
1138 | =back | |||
1139 | ||||
1140 | =head1 BUGS | |||
1141 | ||||
1142 | See L<Moose/BUGS> for details on reporting bugs. | |||
1143 | ||||
1144 | =head1 AUTHOR | |||
1145 | ||||
1146 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
1147 | ||||
1148 | Yuval Kogman E<lt>nothingmuch@woobling.comE<gt> | |||
1149 | ||||
1150 | =head1 COPYRIGHT AND LICENSE | |||
1151 | ||||
1152 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
1153 | ||||
1154 | L<http://www.iinteractive.com> | |||
1155 | ||||
1156 | This library is free software; you can redistribute it and/or modify | |||
1157 | it under the same terms as Perl itself. | |||
1158 | ||||
1159 | =cut |