File | /usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm |
Statements Executed | 11726 |
Total Time | 0.0491169999999999 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
234 | 5 | 2 | 6.42ms | 66.7ms | _process_accessors | Class::MOP::Attribute::
191 | 3 | 2 | 3.75ms | 107ms | install_accessors | Class::MOP::Attribute::
347 | 1 | 1 | 3.17ms | 11.7ms | initialize_instance_slot | Class::MOP::Attribute::
357 | 3 | 2 | 2.77ms | 18.0ms | inline_set | Class::MOP::Attribute::
123 | 50 | 4 | 2.77ms | 6.55ms | new | Class::MOP::Attribute::
177 | 1 | 1 | 2.67ms | 48.8ms | __ANON__[:342] | Class::MOP::Attribute::
286 | 1 | 1 | 2.50ms | 6.56ms | _set_initial_slot_value | Class::MOP::Attribute::
115 | 1 | 1 | 1.89ms | 3.13ms | _new | Class::MOP::Attribute::
441 | 3 | 2 | 1.80ms | 3.21ms | slots | Class::MOP::Attribute::
234 | 2 | 1 | 1.71ms | 1.71ms | associate_method | Class::MOP::Attribute::
123 | 1 | 1 | 888µs | 1.84ms | attach_to_class | Class::MOP::Attribute::
223 | 2 | 1 | 787µs | 787µs | accessor_metaclass | Class::MOP::Attribute::
78 | 3 | 2 | 727µs | 6.11ms | inline_get | Class::MOP::Attribute::
13 | 1 | 1 | 146µs | 458µs | inline_has | Class::MOP::Attribute::
8 | 1 | 1 | 72µs | 326µs | get_raw_value | Class::MOP::Attribute::
2 | 1 | 1 | 39µs | 113µs | has_value | Class::MOP::Attribute::
8 | 1 | 1 | 36µs | 362µs | get_value | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | BEGIN | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | __ANON__[:153] | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | __ANON__[:190] | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | __ANON__[:210] | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | __ANON__[:345] | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | __ANON__[:388] | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | clear_value | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | detach_from_class | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | get_read_method | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | get_read_method_ref | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | get_write_method | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | get_write_method_ref | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | inline_clear | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | remove_accessors | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | set_initial_value | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | set_raw_value | Class::MOP::Attribute::
0 | 0 | 0 | 0s | 0s | set_value | Class::MOP::Attribute::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | ||||
2 | package Class::MOP::Attribute; | |||
3 | ||||
4 | 3 | 30µs | 10µs | use strict; # spent 9µs making 1 call to strict::import |
5 | 3 | 34µs | 12µs | use warnings; # spent 32µs making 1 call to warnings::import |
6 | ||||
7 | 3 | 29µs | 10µs | use Class::MOP::Method::Accessor; # spent 3µs making 1 call to import |
8 | ||||
9 | 3 | 38µs | 13µs | use Carp 'confess'; # spent 44µs making 1 call to Exporter::import |
10 | 3 | 33µs | 11µs | use Scalar::Util 'blessed', 'weaken'; # spent 42µs making 1 call to Exporter::import |
11 | 3 | 73µs | 24µs | use Try::Tiny; # spent 45µs making 1 call to Exporter::import |
12 | ||||
13 | 1 | 1µs | 1µs | our $VERSION = '1.09'; |
14 | 1 | 33µs | 33µs | $VERSION = eval $VERSION; |
15 | 1 | 700ns | 700ns | our $AUTHORITY = 'cpan:STEVAN'; |
16 | ||||
17 | 3 | 2.39ms | 797µs | use base 'Class::MOP::Object', 'Class::MOP::Mixin::AttributeCore'; # spent 131µs making 1 call to base::import |
18 | ||||
19 | # NOTE: (meta-circularity) | |||
20 | # This method will be replaced in the | |||
21 | # boostrap section of Class::MOP, by | |||
22 | # a new version which uses the | |||
23 | # &Class::MOP::Class::construct_instance | |||
24 | # method to build an attribute meta-object | |||
25 | # which itself is described with attribute | |||
26 | # meta-objects. | |||
27 | # - Ain't meta-circularity grand? :) | |||
28 | # spent 6.55ms (2.77+3.79) within Class::MOP::Attribute::new which was called 123 times, avg 53µs/call:
# 66 times (1.60ms+1.28ms) by Class::MOP::Mixin::HasAttributes::add_attribute at line 21 of /usr/local/lib/perl/5.10.0/Class/MOP/Mixin/HasAttributes.pm, avg 44µs/call
# 9 times (266µs+1.72ms) by Moose::Meta::Attribute::new at line 74 of /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm, avg 220µs/call
# once (32µs+42µs) at line 192 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (25µs+27µs) at line 510 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (26µs+25µs) at line 615 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (24µs+25µs) at line 302 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (23µs+23µs) at line 566 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (26µs+19µs) at line 234 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (20µs+24µs) at line 276 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (23µs+19µs) at line 337 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (22µs+19µs) at line 195 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (23µs+18µs) at line 237 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (18µs+23µs) at line 321 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (19µs+20µs) at line 520 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (21µs+17µs) at line 364 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (24µs+13µs) at line 447 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (18µs+19µs) at line 373 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (22µs+15µs) at line 492 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (19µs+17µs) at line 482 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+21µs) at line 649 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (17µs+18µs) at line 340 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (21µs+14µs) at line 43 of /usr/local/lib/perl/5.10.0/Moose/Meta/Class.pm
# once (17µs+18µs) at line 252 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (22µs+13µs) at line 207 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (21µs+13µs) at line 634 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (16µs+17µs) at line 413 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (20µs+13µs) at line 559 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+17µs) at line 573 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (20µs+12µs) at line 454 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (20µs+12µs) at line 640 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+17µs) at line 661 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (17µs+13µs) at line 583 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+15µs) at line 383 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (17µs+13µs) at line 618 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (16µs+13µs) at line 399 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (17µs+13µs) at line 355 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (16µs+12µs) at line 427 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (17µs+12µs) at line 538 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (16µs+13µs) at line 544 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (16µs+12µs) at line 420 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (16µs+12µs) at line 461 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+13µs) at line 592 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (16µs+12µs) at line 440 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+13µs) at line 526 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+12µs) at line 468 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+12µs) at line 655 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+12µs) at line 600 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+12µs) at line 434 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (15µs+12µs) at line 475 of /usr/local/lib/perl/5.10.0/Class/MOP.pm
# once (14µs+12µs) at line 532 of /usr/local/lib/perl/5.10.0/Class/MOP.pm | |||
29 | 1107 | 2.44ms | 2µs | my ( $class, @args ) = @_; |
30 | ||||
31 | unshift @args, "name" if @args % 2 == 1; | |||
32 | my %options = @args; | |||
33 | ||||
34 | my $name = $options{name}; | |||
35 | ||||
36 | (defined $name) | |||
37 | || confess "You must provide a name for the attribute"; | |||
38 | ||||
39 | $options{init_arg} = $name | |||
40 | if not exists $options{init_arg}; | |||
41 | 123 | 301µs | 2µs | if(exists $options{builder}){ |
42 | confess("builder must be a defined scalar value which is a method name") | |||
43 | if ref $options{builder} || !(defined $options{builder}); | |||
44 | confess("Setting both default and builder is not allowed.") | |||
45 | if exists $options{default}; | |||
46 | } else { | |||
47 | ($class->is_default_a_coderef(\%options)) # spent 228µs making 29 calls to Class::MOP::Mixin::AttributeCore::is_default_a_coderef, avg 8µs/call | |||
48 | || confess("References are not allowed as default values, you must ". | |||
49 | "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])") | |||
50 | if exists $options{default} && ref $options{default}; | |||
51 | } | |||
52 | if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) { | |||
53 | confess("A required attribute must have either 'init_arg', 'builder', or 'default'"); | |||
54 | } | |||
55 | ||||
56 | $class->_new(\%options); # spent 3.13ms making 115 calls to Class::MOP::Attribute::_new, avg 27µs/call
# spent 427µs making 8 calls to Moose::Meta::Attribute::_new, avg 53µs/call | |||
57 | } | |||
58 | ||||
59 | # spent 3.13ms (1.89+1.24) within Class::MOP::Attribute::_new which was called 115 times, avg 27µs/call:
# 115 times (1.89ms+1.24ms) by Class::MOP::Attribute::new at line 56, avg 27µs/call | |||
60 | 458 | 1.65ms | 4µs | my $class = shift; |
61 | ||||
62 | return Class::MOP::Class->initialize($class)->new_object(@_) # spent 1.23ms making 1 call to Class::MOP::Class::new_object
# spent 11µs making 1 call to Class::MOP::Class::initialize | |||
63 | if $class ne __PACKAGE__; | |||
64 | ||||
65 | my $options = @_ == 1 ? $_[0] : {@_}; | |||
66 | ||||
67 | bless { | |||
68 | 'name' => $options->{name}, | |||
69 | 'accessor' => $options->{accessor}, | |||
70 | 'reader' => $options->{reader}, | |||
71 | 'writer' => $options->{writer}, | |||
72 | 'predicate' => $options->{predicate}, | |||
73 | 'clearer' => $options->{clearer}, | |||
74 | 'builder' => $options->{builder}, | |||
75 | 'init_arg' => $options->{init_arg}, | |||
76 | exists $options->{default} | |||
77 | ? ('default' => $options->{default}) | |||
78 | : (), | |||
79 | 'initializer' => $options->{initializer}, | |||
80 | 'definition_context' => $options->{definition_context}, | |||
81 | # keep a weakened link to the | |||
82 | # class we are associated with | |||
83 | 'associated_class' => undef, | |||
84 | # and a list of the methods | |||
85 | # associated with this attr | |||
86 | 'associated_methods' => [], | |||
87 | # this let's us keep track of | |||
88 | # our order inside the associated | |||
89 | # class | |||
90 | 'insertion_order' => undef, | |||
91 | }, $class; | |||
92 | } | |||
93 | ||||
94 | # NOTE: | |||
95 | # this is a primative (and kludgy) clone operation | |||
96 | # for now, it will be replaced in the Class::MOP | |||
97 | # bootstrap with a proper one, however we know | |||
98 | # that this one will work fine for now. | |||
99 | sub clone { | |||
100 | my $self = shift; | |||
101 | my %options = @_; | |||
102 | (blessed($self)) | |||
103 | || confess "Can only clone an instance"; | |||
104 | return bless { %{$self}, %options } => ref($self); | |||
105 | } | |||
106 | ||||
107 | # spent 11.7ms (3.17+8.56) within Class::MOP::Attribute::initialize_instance_slot which was called 347 times, avg 34µs/call:
# 347 times (3.17ms+8.56ms) by Class::MOP::Class::_construct_instance at line 598 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 34µs/call | |||
108 | 1041 | 3.23ms | 3µs | my ($self, $meta_instance, $instance, $params) = @_; |
109 | my $init_arg = $self->{'init_arg'}; | |||
110 | ||||
111 | # try to fetch the init arg from the %params ... | |||
112 | ||||
113 | # if nothing was in the %params, we can use the | |||
114 | # attribute's default value (if it has one) | |||
115 | if(defined $init_arg and exists $params->{$init_arg}){ # spent 6.56ms making 286 calls to Class::MOP::Attribute::_set_initial_slot_value, avg 23µs/call
# spent 2.00ms making 114 calls to Class::MOP::Mixin::AttributeCore::default, avg 18µs/call | |||
116 | $self->_set_initial_slot_value( | |||
117 | $meta_instance, | |||
118 | $instance, | |||
119 | $params->{$init_arg}, | |||
120 | ); | |||
121 | } | |||
122 | elsif (exists $self->{'default'}) { | |||
123 | $self->_set_initial_slot_value( | |||
124 | $meta_instance, | |||
125 | $instance, | |||
126 | $self->default($instance), | |||
127 | ); | |||
128 | } | |||
129 | elsif (defined( my $builder = $self->{'builder'})) { | |||
130 | if ($builder = $instance->can($builder)) { | |||
131 | $self->_set_initial_slot_value( | |||
132 | $meta_instance, | |||
133 | $instance, | |||
134 | $instance->$builder, | |||
135 | ); | |||
136 | } | |||
137 | else { | |||
138 | confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'"); | |||
139 | } | |||
140 | } | |||
141 | } | |||
142 | ||||
143 | # spent 6.56ms (2.50+4.06) within Class::MOP::Attribute::_set_initial_slot_value which was called 286 times, avg 23µs/call:
# 286 times (2.50ms+4.06ms) by Class::MOP::Attribute::initialize_instance_slot at line 115, avg 23µs/call | |||
144 | 858 | 3.96ms | 5µs | my ($self, $meta_instance, $instance, $value) = @_; |
145 | ||||
146 | my $slot_name = $self->name; # spent 920µs making 286 calls to Class::MOP::Mixin::AttributeCore::name, avg 3µs/call | |||
147 | ||||
148 | return $meta_instance->set_slot_value($instance, $slot_name, $value) # spent 1.93ms making 286 calls to Class::MOP::Instance::set_slot_value, avg 7µs/call
# spent 1.21ms making 286 calls to Class::MOP::Mixin::AttributeCore::has_initializer, avg 4µs/call | |||
149 | unless $self->has_initializer; | |||
150 | ||||
151 | my $callback = sub { | |||
152 | $meta_instance->set_slot_value($instance, $slot_name, $_[0]); | |||
153 | }; | |||
154 | ||||
155 | my $initializer = $self->initializer; | |||
156 | ||||
157 | # most things will just want to set a value, so make it first arg | |||
158 | $instance->$initializer($value, $callback, $self); | |||
159 | } | |||
160 | ||||
161 | 1025 | 2.09ms | 2µs | sub associated_class { $_[0]->{'associated_class'} } |
162 | 8 | 13µs | 2µs | sub associated_methods { $_[0]->{'associated_methods'} } |
163 | ||||
164 | sub get_read_method { | |||
165 | my $self = shift; | |||
166 | my $reader = $self->reader || $self->accessor; | |||
167 | # normal case ... | |||
168 | return $reader unless ref $reader; | |||
169 | # the HASH ref case | |||
170 | my ($name) = %$reader; | |||
171 | return $name; | |||
172 | } | |||
173 | ||||
174 | sub get_write_method { | |||
175 | my $self = shift; | |||
176 | my $writer = $self->writer || $self->accessor; | |||
177 | # normal case ... | |||
178 | return $writer unless ref $writer; | |||
179 | # the HASH ref case | |||
180 | my ($name) = %$writer; | |||
181 | return $name; | |||
182 | } | |||
183 | ||||
184 | sub get_read_method_ref { | |||
185 | my $self = shift; | |||
186 | if ((my $reader = $self->get_read_method) && $self->associated_class) { | |||
187 | return $self->associated_class->get_method($reader); | |||
188 | } | |||
189 | else { | |||
190 | my $code = sub { $self->get_value(@_) }; | |||
191 | if (my $class = $self->associated_class) { | |||
192 | return $class->method_metaclass->wrap( | |||
193 | $code, | |||
194 | package_name => $class->name, | |||
195 | name => '__ANON__' | |||
196 | ); | |||
197 | } | |||
198 | else { | |||
199 | return $code; | |||
200 | } | |||
201 | } | |||
202 | } | |||
203 | ||||
204 | sub get_write_method_ref { | |||
205 | my $self = shift; | |||
206 | if ((my $writer = $self->get_write_method) && $self->associated_class) { | |||
207 | return $self->associated_class->get_method($writer); | |||
208 | } | |||
209 | else { | |||
210 | my $code = sub { $self->set_value(@_) }; | |||
211 | if (my $class = $self->associated_class) { | |||
212 | return $class->method_metaclass->wrap( | |||
213 | $code, | |||
214 | package_name => $class->name, | |||
215 | name => '__ANON__' | |||
216 | ); | |||
217 | } | |||
218 | else { | |||
219 | return $code; | |||
220 | } | |||
221 | } | |||
222 | } | |||
223 | ||||
224 | # slots | |||
225 | ||||
226 | 441 | 2.43ms | 6µs | # spent 3.21ms (1.80+1.41) within Class::MOP::Attribute::slots which was called 441 times, avg 7µs/call:
# 413 times (1.68ms+1.33ms) by Class::MOP::Instance::BUILDARGS at line 28 of /usr/local/lib/perl/5.10.0/Class/MOP/Instance.pm, avg 7µs/call
# 26 times (106µs+77µs) by Moose::Meta::Attribute::inline_set at line 589 of /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm, avg 7µs/call
# 2 times (9µs+4µs) by Moose::Meta::Attribute::inline_set at line 591 of /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm, avg 6µs/call # spent 1.41ms making 441 calls to Class::MOP::Mixin::AttributeCore::name, avg 3µs/call |
227 | ||||
228 | # class association | |||
229 | ||||
230 | # spent 1.84ms (888µs+954µs) within Class::MOP::Attribute::attach_to_class which was called 123 times, avg 15µs/call:
# 123 times (888µs+954µs) by Class::MOP::Class::_attach_attribute at line 756 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 15µs/call | |||
231 | 369 | 1.54ms | 4µs | my ($self, $class) = @_; |
232 | (blessed($class) && $class->isa('Class::MOP::Class')) # spent 306µs making 123 calls to Scalar::Util::blessed, avg 2µs/call
# spent 302µs making 123 calls to UNIVERSAL::isa, avg 2µs/call | |||
233 | || confess "You must pass a Class::MOP::Class instance (or a subclass)"; | |||
234 | weaken($self->{'associated_class'} = $class); # spent 346µs making 123 calls to Scalar::Util::weaken, avg 3µs/call | |||
235 | } | |||
236 | ||||
237 | sub detach_from_class { | |||
238 | my $self = shift; | |||
239 | $self->{'associated_class'} = undef; | |||
240 | } | |||
241 | ||||
242 | # method association | |||
243 | ||||
244 | sub associate_method { | |||
245 | 468 | 897µs | 2µs | my ($self, $method) = @_; |
246 | push @{$self->{'associated_methods'}} => $method; | |||
247 | } | |||
248 | ||||
249 | ## Slot management | |||
250 | ||||
251 | sub set_initial_value { | |||
252 | my ($self, $instance, $value) = @_; | |||
253 | $self->_set_initial_slot_value( | |||
254 | Class::MOP::Class->initialize(ref($instance))->get_meta_instance, | |||
255 | $instance, | |||
256 | $value | |||
257 | ); | |||
258 | } | |||
259 | ||||
260 | sub set_value { shift->set_raw_value(@_) } | |||
261 | 8 | 41µs | 5µs | # spent 362µs (36+326) within Class::MOP::Attribute::get_value which was called 8 times, avg 45µs/call:
# 8 times (36µs+326µs) by Class::MOP::Method::Accessor::_generate_reader_method or Class::MOP::Method::Accessor::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm:105] at line 104 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm, avg 45µs/call # spent 326µs making 8 calls to Class::MOP::Attribute::get_raw_value, avg 41µs/call |
262 | ||||
263 | sub set_raw_value { | |||
264 | my ($self, $instance, $value) = @_; | |||
265 | ||||
266 | Class::MOP::Class->initialize(ref($instance)) | |||
267 | ->get_meta_instance | |||
268 | ->set_slot_value($instance, $self->name, $value); | |||
269 | } | |||
270 | ||||
271 | # spent 326µs (72+254) within Class::MOP::Attribute::get_raw_value which was called 8 times, avg 41µs/call:
# 8 times (72µs+254µs) by Class::MOP::Attribute::get_value at line 261, avg 41µs/call | |||
272 | 16 | 152µs | 9µs | my ($self, $instance) = @_; |
273 | ||||
274 | Class::MOP::Class->initialize(ref($instance)) # spent 76µs making 5 calls to Class::MOP::Class::Immutable::Class::MOP::Class::get_meta_instance, avg 15µs/call
# spent 76µs making 8 calls to Class::MOP::Class::initialize, avg 9µs/call
# spent 48µs making 8 calls to Class::MOP::Instance::get_slot_value, avg 6µs/call
# spent 32µs making 8 calls to Class::MOP::Mixin::AttributeCore::name, avg 4µs/call
# spent 22µs making 3 calls to Class::MOP::Class::get_meta_instance, avg 7µs/call | |||
275 | ->get_meta_instance | |||
276 | ->get_slot_value($instance, $self->name); | |||
277 | } | |||
278 | ||||
279 | # spent 113µs (39+74) within Class::MOP::Attribute::has_value which was called 2 times, avg 56µs/call:
# 2 times (39µs+74µs) by Class::MOP::Method::Accessor::_generate_predicate_method or Class::MOP::Method::Accessor::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm:120] at line 119 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm, avg 56µs/call | |||
280 | 4 | 60µs | 15µs | my ($self, $instance) = @_; |
281 | ||||
282 | Class::MOP::Class->initialize(ref($instance)) # spent 28µs making 2 calls to Class::MOP::Class::initialize, avg 14µs/call
# spent 16µs making 1 call to Class::MOP::Class::Immutable::Class::MOP::Class::get_meta_instance
# spent 15µs making 2 calls to Class::MOP::Instance::is_slot_initialized, avg 8µs/call
# spent 8µs making 2 calls to Class::MOP::Mixin::AttributeCore::name, avg 4µs/call
# spent 7µs making 1 call to Class::MOP::Class::get_meta_instance | |||
283 | ->get_meta_instance | |||
284 | ->is_slot_initialized($instance, $self->name); | |||
285 | } | |||
286 | ||||
287 | sub clear_value { | |||
288 | my ($self, $instance) = @_; | |||
289 | ||||
290 | Class::MOP::Class->initialize(ref($instance)) | |||
291 | ->get_meta_instance | |||
292 | ->deinitialize_slot($instance, $self->name); | |||
293 | } | |||
294 | ||||
295 | ## load em up ... | |||
296 | ||||
297 | 223 | 332µs | 1µs | # spent 787µs within Class::MOP::Attribute::accessor_metaclass which was called 223 times, avg 4µs/call:
# 166 times (605µ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, avg 4µs/call
# 57 times (181µs+0s) by Class::MOP::Attribute::_process_accessors at line 312, avg 3µs/call |
298 | ||||
299 | # spent 66.7ms (6.42+60.2) within Class::MOP::Attribute::_process_accessors which was called 234 times, avg 285µs/call:
# 148 times (3.89ms+29.2ms) by Class::MOP::Attribute::install_accessors at line 360, avg 224µs/call
# 36 times (931µs+5.58ms) by Class::MOP::Attribute::install_accessors at line 368, avg 181µs/call
# 31 times (965µs+9.91ms) by Class::MOP::Attribute::install_accessors at line 356, avg 351µs/call
# 11 times (432µs+14.2ms) by Moose::Meta::Attribute::_process_accessors at line 573 of /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm, avg 1.33ms/call
# 8 times (197µs+1.31ms) by Class::MOP::Attribute::install_accessors at line 364, avg 188µs/call | |||
300 | 936 | 1.65ms | 2µs | my ($self, $type, $accessor, $generate_as_inline_methods) = @_; |
301 | ||||
302 | my $method_ctx; | |||
303 | ||||
304 | if ( my $ctx = $self->definition_context ) { # spent 1.09ms making 234 calls to Class::MOP::Mixin::AttributeCore::definition_context, avg 5µs/call | |||
305 | $method_ctx = { %$ctx }; | |||
306 | } | |||
307 | ||||
308 | 1170 | 7.47ms | 6µs | if (ref($accessor)) { |
309 | (ref($accessor) eq 'HASH') | |||
310 | || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref"; | |||
311 | my ($name, $method) = %{$accessor}; | |||
312 | $method = $self->accessor_metaclass->wrap( # spent 2.45ms making 57 calls to Class::MOP::Method::wrap, avg 43µs/call
# spent 181µs making 57 calls to Class::MOP::Attribute::accessor_metaclass, avg 3µs/call
# spent 175µs making 57 calls to Class::MOP::Attribute::associated_class, avg 3µs/call
# spent 159µs making 57 calls to Class::MOP::Package::name, avg 3µs/call | |||
313 | $method, | |||
314 | package_name => $self->associated_class->name, | |||
315 | name => $name, | |||
316 | definition_context => $method_ctx, | |||
317 | ); | |||
318 | $self->associate_method($method); # spent 284µs making 57 calls to Class::MOP::Attribute::associate_method, avg 5µs/call | |||
319 | return ($name, $method); | |||
320 | } | |||
321 | else { | |||
322 | my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable); # spent 404µs making 84 calls to Class::MOP::Class::instance_metaclass, avg 5µs/call
# spent 288µs making 84 calls to Class::MOP::Attribute::associated_class, avg 3µs/call
# spent 258µs making 84 calls to Class::MOP::Instance::is_inlinable, avg 3µs/call | |||
323 | my $method; | |||
324 | # spent 48.8ms (2.67+46.1) within Class::MOP::Attribute::__ANON__[/usr/local/lib/perl/5.10.0/Class/MOP/Attribute.pm:342] which was called 177 times, avg 276µs/call:
# 177 times (2.67ms+46.1ms) by Try::Tiny::try at line 76 of /usr/local/share/perl/5.10.0/Try/Tiny.pm, avg 276µs/call | |||
325 | 381 | 3.87ms | 10µs | if ( $method_ctx ) { |
326 | my $desc = "accessor $accessor"; | |||
327 | if ( $accessor ne $self->name ) { # spent 32µs making 10 calls to Class::MOP::Mixin::AttributeCore::name, avg 3µs/call | |||
328 | $desc .= " of attribute " . $self->name; | |||
329 | } | |||
330 | ||||
331 | $method_ctx->{description} = $desc; | |||
332 | } | |||
333 | ||||
334 | $method = $self->accessor_metaclass->new( # spent 44.3ms making 177 calls to Class::MOP::Method::Accessor::new, avg 250µs/call
# spent 605µs making 166 calls to Class::MOP::Attribute::accessor_metaclass, avg 4µs/call
# spent 591µs making 177 calls to Class::MOP::Package::name, avg 3µs/call
# spent 578µs making 177 calls to Class::MOP::Attribute::associated_class, avg 3µs/call
# spent 57µs making 11 calls to Moose::Meta::Attribute::accessor_metaclass, avg 5µs/call | |||
335 | attribute => $self, | |||
336 | is_inline => $inline_me, | |||
337 | accessor_type => $type, | |||
338 | package_name => $self->associated_class->name, | |||
339 | name => $accessor, | |||
340 | definition_context => $method_ctx, | |||
341 | ); | |||
342 | } | |||
343 | catch { | |||
344 | confess "Could not create the '$type' method for " . $self->name . " because : $_"; | |||
345 | }; # spent 52.4ms making 177 calls to Try::Tiny::try, avg 160µs/call, max recursion depth 1
# spent 1.16ms making 177 calls to Try::Tiny::catch, avg 7µs/call | |||
346 | $self->associate_method($method); # spent 1.43ms making 177 calls to Class::MOP::Attribute::associate_method, avg 8µs/call | |||
347 | return ($accessor, $method); | |||
348 | } | |||
349 | } | |||
350 | ||||
351 | # spent 107ms (3.75+104) within Class::MOP::Attribute::install_accessors which was called 191 times, avg 562µs/call:
# 114 times (2.21ms+38.3ms) 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 355µs/call
# 67 times (1.24ms+46.3ms) by Class::MOP::Class::_inline_accessors at line 1273 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 710µs/call
# 10 times (301µs+19.0ms) by Moose::Meta::Attribute::install_accessors at line 532 of /usr/local/lib/perl/5.10.0/Moose/Meta/Attribute.pm, avg 1.93ms/call | |||
352 | 1719 | 7.85ms | 5µs | my $self = shift; |
353 | my $inline = shift; | |||
354 | my $class = $self->associated_class; # spent 980µs making 191 calls to Class::MOP::Attribute::associated_class, avg 5µs/call | |||
355 | ||||
356 | $class->add_method( # spent 10.9ms making 31 calls to Class::MOP::Attribute::_process_accessors, avg 351µs/call
# spent 9.63ms making 7 calls to Moose::Meta::Attribute::_process_accessors, avg 1.38ms/call
# spent 4.92ms making 38 calls to Class::MOP::Mixin::HasMethods::add_method, avg 129µs/call
# spent 1.02ms making 191 calls to Class::MOP::Mixin::AttributeCore::has_accessor, avg 5µs/call
# spent 184µs making 38 calls to Class::MOP::Mixin::AttributeCore::accessor, avg 5µs/call | |||
357 | $self->_process_accessors('accessor' => $self->accessor(), $inline) | |||
358 | ) if $self->has_accessor(); | |||
359 | ||||
360 | $class->add_method( # spent 33.1ms making 148 calls to Class::MOP::Attribute::_process_accessors, avg 224µs/call
# spent 17.8ms making 151 calls to Class::MOP::Mixin::HasMethods::add_method, avg 118µs/call
# spent 6.34ms making 3 calls to Moose::Meta::Attribute::_process_accessors, avg 2.11ms/call
# spent 984µs making 191 calls to Class::MOP::Mixin::AttributeCore::has_reader, avg 5µs/call
# spent 740µs making 151 calls to Class::MOP::Mixin::AttributeCore::reader, avg 5µs/call | |||
361 | $self->_process_accessors('reader' => $self->reader(), $inline) | |||
362 | ) if $self->has_reader(); | |||
363 | ||||
364 | $class->add_method( # spent 1.51ms making 8 calls to Class::MOP::Attribute::_process_accessors, avg 188µs/call
# spent 1.18ms making 1 call to Moose::Meta::Attribute::_process_accessors
# spent 1.04ms making 191 calls to Class::MOP::Mixin::AttributeCore::has_writer, avg 5µs/call
# spent 1.00ms making 9 calls to Class::MOP::Mixin::HasMethods::add_method, avg 111µs/call
# spent 40µs making 9 calls to Class::MOP::Mixin::AttributeCore::writer, avg 4µs/call | |||
365 | $self->_process_accessors('writer' => $self->writer(), $inline) | |||
366 | ) if $self->has_writer(); | |||
367 | ||||
368 | $class->add_method( # spent 6.51ms making 36 calls to Class::MOP::Attribute::_process_accessors, avg 181µs/call
# spent 3.89ms making 36 calls to Class::MOP::Mixin::HasMethods::add_method, avg 108µs/call
# spent 906µs making 191 calls to Class::MOP::Mixin::AttributeCore::has_predicate, avg 5µs/call
# spent 182µs making 36 calls to Class::MOP::Mixin::AttributeCore::predicate, avg 5µs/call | |||
369 | $self->_process_accessors('predicate' => $self->predicate(), $inline) | |||
370 | ) if $self->has_predicate(); | |||
371 | ||||
372 | $class->add_method( # spent 824µs making 191 calls to Class::MOP::Mixin::AttributeCore::has_clearer, avg 4µs/call | |||
373 | $self->_process_accessors('clearer' => $self->clearer(), $inline) | |||
374 | ) if $self->has_clearer(); | |||
375 | ||||
376 | return; | |||
377 | } | |||
378 | ||||
379 | { | |||
380 | 1 | 700ns | 700ns | my $_remove_accessor = sub { |
381 | my ($accessor, $class) = @_; | |||
382 | if (ref($accessor) && ref($accessor) eq 'HASH') { | |||
383 | ($accessor) = keys %{$accessor}; | |||
384 | } | |||
385 | my $method = $class->get_method($accessor); | |||
386 | $class->remove_method($accessor) | |||
387 | if (ref($method) && $method->isa('Class::MOP::Method::Accessor')); | |||
388 | 1 | 5µs | 5µs | }; |
389 | ||||
390 | sub remove_accessors { | |||
391 | my $self = shift; | |||
392 | # TODO: | |||
393 | # we really need to make sure to remove from the | |||
394 | # associates methods here as well. But this is | |||
395 | # such a slimly used method, I am not worried | |||
396 | # about it right now. | |||
397 | $_remove_accessor->($self->accessor(), $self->associated_class()) if $self->has_accessor(); | |||
398 | $_remove_accessor->($self->reader(), $self->associated_class()) if $self->has_reader(); | |||
399 | $_remove_accessor->($self->writer(), $self->associated_class()) if $self->has_writer(); | |||
400 | $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate(); | |||
401 | $_remove_accessor->($self->clearer(), $self->associated_class()) if $self->has_clearer(); | |||
402 | return; | |||
403 | } | |||
404 | ||||
405 | } | |||
406 | ||||
407 | # spent 6.11ms (727µs+5.38) within Class::MOP::Attribute::inline_get which was called 78 times, avg 78µs/call:
# 52 times (475µs+4.43ms) by Class::MOP::Method::Accessor::_generate_reader_method_inline at line 152 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm, avg 94µs/call
# 15 times (130µs+339µs) by Class::MOP::Method::Accessor::_generate_accessor_method_inline at line 136 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm, avg 31µs/call
# 11 times (122µs+614µs) by Moose::Meta::Method::Accessor::_inline_get at line 277 of /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Accessor.pm, avg 67µs/call | |||
408 | 234 | 1.26ms | 5µs | my $self = shift; |
409 | my ($instance) = @_; | |||
410 | ||||
411 | return $self->associated_class->get_meta_instance->inline_get_slot_value( # spent 3.81ms making 78 calls to Class::MOP::Class::get_meta_instance, avg 49µs/call
# spent 1.08ms making 78 calls to Class::MOP::Instance::inline_get_slot_value, avg 14µs/call
# spent 273µs making 78 calls to Class::MOP::Attribute::associated_class, avg 3µs/call
# spent 216µs making 78 calls to Class::MOP::Mixin::AttributeCore::name, avg 3µs/call | |||
412 | $instance, $self->name ); | |||
413 | } | |||
414 | ||||
415 | # spent 18.0ms (2.77+15.2) within Class::MOP::Attribute::inline_set which was called 357 times, avg 50µs/call:
# 339 times (2.59ms+13.1ms) 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 46µs/call
# 15 times (148µs+2.05ms) by Class::MOP::Method::Accessor::_generate_accessor_method_inline at line 136 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm, avg 146µs/call
# 3 times (31µs+69µs) by Class::MOP::Method::Accessor::_generate_writer_method_inline at line 167 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm, avg 34µs/call | |||
416 | 1071 | 4.97ms | 5µs | my $self = shift; |
417 | my ( $instance, $value ) = @_; | |||
418 | ||||
419 | return $self->associated_class->get_meta_instance->inline_set_slot_value( # spent 6.10ms making 231 calls to Class::MOP::Class::Immutable::Class::MOP::Class::get_meta_instance, avg 26µs/call
# spent 4.31ms making 357 calls to Class::MOP::Instance::inline_set_slot_value, avg 12µs/call
# spent 2.56ms making 126 calls to Class::MOP::Class::get_meta_instance, avg 20µs/call
# spent 1.40ms making 357 calls to Class::MOP::Attribute::associated_class, avg 4µs/call
# spent 855µs making 357 calls to Class::MOP::Mixin::AttributeCore::name, avg 2µs/call | |||
420 | $instance, $self->name, $value ); | |||
421 | } | |||
422 | ||||
423 | # spent 458µs (146+312) within Class::MOP::Attribute::inline_has which was called 13 times, avg 35µs/call:
# 13 times (146µs+312µs) by Class::MOP::Method::Accessor::_generate_predicate_method_inline at line 180 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Accessor.pm, avg 35µs/call | |||
424 | 39 | 227µs | 6µs | my $self = shift; |
425 | my ($instance) = @_; | |||
426 | ||||
427 | return | |||
428 | $self->associated_class->get_meta_instance # spent 182µs making 13 calls to Class::MOP::Instance::inline_is_slot_initialized, avg 14µs/call
# spent 53µs making 13 calls to Class::MOP::Class::get_meta_instance, avg 4µs/call
# spent 41µs making 13 calls to Class::MOP::Attribute::associated_class, avg 3µs/call
# spent 35µs making 13 calls to Class::MOP::Mixin::AttributeCore::name, avg 3µs/call | |||
429 | ->inline_is_slot_initialized( $instance, $self->name ); | |||
430 | } | |||
431 | ||||
432 | sub inline_clear { | |||
433 | my $self = shift; | |||
434 | my ($instance) = @_; | |||
435 | ||||
436 | return | |||
437 | $self->associated_class->get_meta_instance | |||
438 | ->inline_deinitialize_slot( $instance, $self->name ); | |||
439 | } | |||
440 | ||||
441 | 1 | 5µs | 5µs | 1; |
442 | ||||
443 | __END__ | |||
444 | ||||
445 | =pod | |||
446 | ||||
447 | =head1 NAME | |||
448 | ||||
449 | Class::MOP::Attribute - Attribute Meta Object | |||
450 | ||||
451 | =head1 SYNOPSIS | |||
452 | ||||
453 | Class::MOP::Attribute->new( | |||
454 | foo => ( | |||
455 | accessor => 'foo', # dual purpose get/set accessor | |||
456 | predicate => 'has_foo', # predicate check for defined-ness | |||
457 | init_arg => '-foo', # class->new will look for a -foo key | |||
458 | default => 'BAR IS BAZ!' # if no -foo key is provided, use this | |||
459 | ) | |||
460 | ); | |||
461 | ||||
462 | Class::MOP::Attribute->new( | |||
463 | bar => ( | |||
464 | reader => 'bar', # getter | |||
465 | writer => 'set_bar', # setter | |||
466 | predicate => 'has_bar', # predicate check for defined-ness | |||
467 | init_arg => ':bar', # class->new will look for a :bar key | |||
468 | # no default value means it is undef | |||
469 | ) | |||
470 | ); | |||
471 | ||||
472 | =head1 DESCRIPTION | |||
473 | ||||
474 | The Attribute Protocol is almost entirely an invention of | |||
475 | C<Class::MOP>. Perl 5 does not have a consistent notion of | |||
476 | attributes. There are so many ways in which this is done, and very few | |||
477 | (if any) are easily discoverable by this module. | |||
478 | ||||
479 | With that said, this module attempts to inject some order into this | |||
480 | chaos, by introducing a consistent API which can be used to create | |||
481 | object attributes. | |||
482 | ||||
483 | =head1 METHODS | |||
484 | ||||
485 | =head2 Creation | |||
486 | ||||
487 | =over 4 | |||
488 | ||||
489 | =item B<< Class::MOP::Attribute->new($name, ?%options) >> | |||
490 | ||||
491 | An attribute must (at the very least), have a C<$name>. All other | |||
492 | C<%options> are added as key-value pairs. | |||
493 | ||||
494 | =over 8 | |||
495 | ||||
496 | =item * init_arg | |||
497 | ||||
498 | This is a string value representing the expected key in an | |||
499 | initialization hash. For instance, if we have an C<init_arg> value of | |||
500 | C<-foo>, then the following code will Just Work. | |||
501 | ||||
502 | MyClass->meta->new_object( -foo => 'Hello There' ); | |||
503 | ||||
504 | If an init_arg is not assigned, it will automatically use the | |||
505 | attribute's name. If C<init_arg> is explicitly set to C<undef>, the | |||
506 | attribute cannot be specified during initialization. | |||
507 | ||||
508 | =item * builder | |||
509 | ||||
510 | This provides the name of a method that will be called to initialize | |||
511 | the attribute. This method will be called on the object after it is | |||
512 | constructed. It is expected to return a valid value for the attribute. | |||
513 | ||||
514 | =item * default | |||
515 | ||||
516 | This can be used to provide an explicit default for initializing the | |||
517 | attribute. If the default you provide is a subroutine reference, then | |||
518 | this reference will be called I<as a method> on the object. | |||
519 | ||||
520 | If the value is a simple scalar (string or number), then it can be | |||
521 | just passed as is. However, if you wish to initialize it with a HASH | |||
522 | or ARRAY ref, then you need to wrap that inside a subroutine | |||
523 | reference: | |||
524 | ||||
525 | Class::MOP::Attribute->new( | |||
526 | 'foo' => ( | |||
527 | default => sub { [] }, | |||
528 | ) | |||
529 | ); | |||
530 | ||||
531 | # or ... | |||
532 | ||||
533 | Class::MOP::Attribute->new( | |||
534 | 'foo' => ( | |||
535 | default => sub { {} }, | |||
536 | ) | |||
537 | ); | |||
538 | ||||
539 | If you wish to initialize an attribute with a subroutine reference | |||
540 | itself, then you need to wrap that in a subroutine as well: | |||
541 | ||||
542 | Class::MOP::Attribute->new( | |||
543 | 'foo' => ( | |||
544 | default => sub { | |||
545 | sub { print "Hello World" } | |||
546 | }, | |||
547 | ) | |||
548 | ); | |||
549 | ||||
550 | And lastly, if the value of your attribute is dependent upon some | |||
551 | other aspect of the instance structure, then you can take advantage of | |||
552 | the fact that when the C<default> value is called as a method: | |||
553 | ||||
554 | Class::MOP::Attribute->new( | |||
555 | 'object_identity' => ( | |||
556 | default => sub { Scalar::Util::refaddr( $_[0] ) }, | |||
557 | ) | |||
558 | ); | |||
559 | ||||
560 | Note that there is no guarantee that attributes are initialized in any | |||
561 | particular order, so you cannot rely on the value of some other | |||
562 | attribute when generating the default. | |||
563 | ||||
564 | =item * initializer | |||
565 | ||||
566 | This option can be either a method name or a subroutine | |||
567 | reference. This method will be called when setting the attribute's | |||
568 | value in the constructor. Unlike C<default> and C<builder>, the | |||
569 | initializer is only called when a value is provided to the | |||
570 | constructor. The initializer allows you to munge this value during | |||
571 | object construction. | |||
572 | ||||
573 | The initializer is called as a method with three arguments. The first | |||
574 | is the value that was passed to the constructor. The second is a | |||
575 | subroutine reference that can be called to actually set the | |||
576 | attribute's value, and the last is the associated | |||
577 | C<Class::MOP::Attribute> object. | |||
578 | ||||
579 | This contrived example shows an initializer that sets the attribute to | |||
580 | twice the given value. | |||
581 | ||||
582 | Class::MOP::Attribute->new( | |||
583 | 'doubled' => ( | |||
584 | initializer => sub { | |||
585 | my ( $self, $value, $set, $attr ) = @_; | |||
586 | $set->( $value * 2 ); | |||
587 | }, | |||
588 | ) | |||
589 | ); | |||
590 | ||||
591 | Since an initializer can be a method name, you can easily make | |||
592 | attribute initialization use the writer: | |||
593 | ||||
594 | Class::MOP::Attribute->new( | |||
595 | 'some_attr' => ( | |||
596 | writer => 'some_attr', | |||
597 | initializer => 'some_attr', | |||
598 | ) | |||
599 | ); | |||
600 | ||||
601 | Your writer will need to examine C<@_> and determine under which | |||
602 | context it is being called. | |||
603 | ||||
604 | =back | |||
605 | ||||
606 | The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer> | |||
607 | options all accept the same parameters. You can provide the name of | |||
608 | the method, in which case an appropriate default method will be | |||
609 | generated for you. Or instead you can also provide hash reference | |||
610 | containing exactly one key (the method name) and one value. The value | |||
611 | should be a subroutine reference, which will be installed as the | |||
612 | method itself. | |||
613 | ||||
614 | =over 8 | |||
615 | ||||
616 | =item * accessor | |||
617 | ||||
618 | An C<accessor> is a standard Perl-style read/write accessor. It will | |||
619 | return the value of the attribute, and if a value is passed as an | |||
620 | argument, it will assign that value to the attribute. | |||
621 | ||||
622 | Note that C<undef> is a legitimate value, so this will work: | |||
623 | ||||
624 | $object->set_something(undef); | |||
625 | ||||
626 | =item * reader | |||
627 | ||||
628 | This is a basic read-only accessor. It returns the value of the | |||
629 | attribute. | |||
630 | ||||
631 | =item * writer | |||
632 | ||||
633 | This is a basic write accessor, it accepts a single argument, and | |||
634 | assigns that value to the attribute. | |||
635 | ||||
636 | Note that C<undef> is a legitimate value, so this will work: | |||
637 | ||||
638 | $object->set_something(undef); | |||
639 | ||||
640 | =item * predicate | |||
641 | ||||
642 | The predicate method returns a boolean indicating whether or not the | |||
643 | attribute has been explicitly set. | |||
644 | ||||
645 | Note that the predicate returns true even if the attribute was set to | |||
646 | a false value (C<0> or C<undef>). | |||
647 | ||||
648 | =item * clearer | |||
649 | ||||
650 | This method will uninitialize the attribute. After an attribute is | |||
651 | cleared, its C<predicate> will return false. | |||
652 | ||||
653 | =item * definition_context | |||
654 | ||||
655 | Mostly, this exists as a hook for the benefit of Moose. | |||
656 | ||||
657 | This option should be a hash reference containing several keys which | |||
658 | will be used when inlining the attribute's accessors. The keys should | |||
659 | include C<line>, the line number where the attribute was created, and | |||
660 | either C<file> or C<description>. | |||
661 | ||||
662 | This information will ultimately be used when eval'ing inlined | |||
663 | accessor code so that error messages report a useful line and file | |||
664 | name. | |||
665 | ||||
666 | =back | |||
667 | ||||
668 | =item B<< $attr->clone(%options) >> | |||
669 | ||||
670 | This clones the attribute. Any options you provide will override the | |||
671 | settings of the original attribute. You can change the name of the new | |||
672 | attribute by passing a C<name> key in C<%options>. | |||
673 | ||||
674 | =back | |||
675 | ||||
676 | =head2 Informational | |||
677 | ||||
678 | These are all basic read-only accessors for the values passed into | |||
679 | the constructor. | |||
680 | ||||
681 | =over 4 | |||
682 | ||||
683 | =item B<< $attr->name >> | |||
684 | ||||
685 | Returns the attribute's name. | |||
686 | ||||
687 | =item B<< $attr->accessor >> | |||
688 | ||||
689 | =item B<< $attr->reader >> | |||
690 | ||||
691 | =item B<< $attr->writer >> | |||
692 | ||||
693 | =item B<< $attr->predicate >> | |||
694 | ||||
695 | =item B<< $attr->clearer >> | |||
696 | ||||
697 | The C<accessor>, C<reader>, C<writer>, C<predicate>, and C<clearer> | |||
698 | methods all return exactly what was passed to the constructor, so it | |||
699 | can be either a string containing a method name, or a hash reference. | |||
700 | ||||
701 | =item B<< $attr->initializer >> | |||
702 | ||||
703 | Returns the initializer as passed to the constructor, so this may be | |||
704 | either a method name or a subroutine reference. | |||
705 | ||||
706 | =item B<< $attr->init_arg >> | |||
707 | ||||
708 | =item B<< $attr->is_default_a_coderef >> | |||
709 | ||||
710 | =item B<< $attr->default($instance) >> | |||
711 | ||||
712 | The C<$instance> argument is optional. If you don't pass it, the | |||
713 | return value for this method is exactly what was passed to the | |||
714 | constructor, either a simple scalar or a subroutine reference. | |||
715 | ||||
716 | If you I<do> pass an C<$instance> and the default is a subroutine | |||
717 | reference, then the reference is called as a method on the | |||
718 | C<$instance> and the generated value is returned. | |||
719 | ||||
720 | =item B<< $attr->slots >> | |||
721 | ||||
722 | Return a list of slots required by the attribute. This is usually just | |||
723 | one, the name of the attribute. | |||
724 | ||||
725 | A slot is the name of the hash key used to store the attribute in an | |||
726 | object instance. | |||
727 | ||||
728 | =item B<< $attr->get_read_method >> | |||
729 | ||||
730 | =item B<< $attr->get_write_method >> | |||
731 | ||||
732 | Returns the name of a method suitable for reading or writing the value | |||
733 | of the attribute in the associated class. | |||
734 | ||||
735 | If an attribute is read- or write-only, then these methods can return | |||
736 | C<undef> as appropriate. | |||
737 | ||||
738 | =item B<< $attr->has_read_method >> | |||
739 | ||||
740 | =item B<< $attr->has_write_method >> | |||
741 | ||||
742 | This returns a boolean indicating whether the attribute has a I<named> | |||
743 | read or write method. | |||
744 | ||||
745 | =item B<< $attr->get_read_method_ref >> | |||
746 | ||||
747 | =item B<< $attr->get_write_method_ref >> | |||
748 | ||||
749 | Returns the subroutine reference of a method suitable for reading or | |||
750 | writing the attribute's value in the associated class. These methods | |||
751 | always return a subroutine reference, regardless of whether or not the | |||
752 | attribute is read- or write-only. | |||
753 | ||||
754 | =item B<< $attr->insertion_order >> | |||
755 | ||||
756 | If this attribute has been inserted into a class, this returns a zero | |||
757 | based index regarding the order of insertion. | |||
758 | ||||
759 | =back | |||
760 | ||||
761 | =head2 Informational predicates | |||
762 | ||||
763 | These are all basic predicate methods for the values passed into C<new>. | |||
764 | ||||
765 | =over 4 | |||
766 | ||||
767 | =item B<< $attr->has_accessor >> | |||
768 | ||||
769 | =item B<< $attr->has_reader >> | |||
770 | ||||
771 | =item B<< $attr->has_writer >> | |||
772 | ||||
773 | =item B<< $attr->has_predicate >> | |||
774 | ||||
775 | =item B<< $attr->has_clearer >> | |||
776 | ||||
777 | =item B<< $attr->has_initializer >> | |||
778 | ||||
779 | =item B<< $attr->has_init_arg >> | |||
780 | ||||
781 | This will be I<false> if the C<init_arg> was set to C<undef>. | |||
782 | ||||
783 | =item B<< $attr->has_default >> | |||
784 | ||||
785 | This will be I<false> if the C<default> was set to C<undef>, since | |||
786 | C<undef> is the default C<default> anyway. | |||
787 | ||||
788 | =item B<< $attr->has_builder >> | |||
789 | ||||
790 | =item B<< $attr->has_insertion_order >> | |||
791 | ||||
792 | This will be I<false> if this attribute has not be inserted into a class | |||
793 | ||||
794 | =back | |||
795 | ||||
796 | =head2 Value management | |||
797 | ||||
798 | These methods are basically "back doors" to the instance, and can be | |||
799 | used to bypass the regular accessors, but still stay within the MOP. | |||
800 | ||||
801 | These methods are not for general use, and should only be used if you | |||
802 | really know what you are doing. | |||
803 | ||||
804 | =over 4 | |||
805 | ||||
806 | =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >> | |||
807 | ||||
808 | This method is used internally to initialize the attribute's slot in | |||
809 | the object C<$instance>. | |||
810 | ||||
811 | The C<$params> is a hash reference of the values passed to the object | |||
812 | constructor. | |||
813 | ||||
814 | It's unlikely that you'll need to call this method yourself. | |||
815 | ||||
816 | =item B<< $attr->set_value($instance, $value) >> | |||
817 | ||||
818 | Sets the value without going through the accessor. Note that this | |||
819 | works even with read-only attributes. | |||
820 | ||||
821 | =item B<< $attr->set_raw_value($instance, $value) >> | |||
822 | ||||
823 | Sets the value with no side effects such as a trigger. | |||
824 | ||||
825 | This doesn't actually apply to Class::MOP attributes, only to subclasses. | |||
826 | ||||
827 | =item B<< $attr->set_initial_value($instance, $value) >> | |||
828 | ||||
829 | Sets the value without going through the accessor. This method is only | |||
830 | called when the instance is first being initialized. | |||
831 | ||||
832 | =item B<< $attr->get_value($instance) >> | |||
833 | ||||
834 | Returns the value without going through the accessor. Note that this | |||
835 | works even with write-only accessors. | |||
836 | ||||
837 | =item B<< $attr->get_raw_value($instance) >> | |||
838 | ||||
839 | Returns the value without any side effects such as lazy attributes. | |||
840 | ||||
841 | Doesn't actually apply to Class::MOP attributes, only to subclasses. | |||
842 | ||||
843 | =item B<< $attr->has_value($instance) >> | |||
844 | ||||
845 | Return a boolean indicating whether the attribute has been set in | |||
846 | C<$instance>. This how the default C<predicate> method works. | |||
847 | ||||
848 | =item B<< $attr->clear_value($instance) >> | |||
849 | ||||
850 | This will clear the attribute's value in C<$instance>. This is what | |||
851 | the default C<clearer> calls. | |||
852 | ||||
853 | Note that this works even if the attribute does not have any | |||
854 | associated read, write or clear methods. | |||
855 | ||||
856 | =back | |||
857 | ||||
858 | =head2 Class association | |||
859 | ||||
860 | These methods allow you to manage the attributes association with | |||
861 | the class that contains it. These methods should not be used | |||
862 | lightly, nor are they very magical, they are mostly used internally | |||
863 | and by metaclass instances. | |||
864 | ||||
865 | =over 4 | |||
866 | ||||
867 | =item B<< $attr->associated_class >> | |||
868 | ||||
869 | This returns the C<Class::MOP::Class> with which this attribute is | |||
870 | associated, if any. | |||
871 | ||||
872 | =item B<< $attr->attach_to_class($metaclass) >> | |||
873 | ||||
874 | This method stores a weakened reference to the C<$metaclass> object | |||
875 | internally. | |||
876 | ||||
877 | This method does not remove the attribute from its old class, | |||
878 | nor does it create any accessors in the new class. | |||
879 | ||||
880 | It is probably best to use the L<Class::MOP::Class> C<add_attribute> | |||
881 | method instead. | |||
882 | ||||
883 | =item B<< $attr->detach_from_class >> | |||
884 | ||||
885 | This method removes the associate metaclass object from the attribute | |||
886 | it has one. | |||
887 | ||||
888 | This method does not remove the attribute itself from the class, or | |||
889 | remove its accessors. | |||
890 | ||||
891 | It is probably best to use the L<Class::MOP::Class> | |||
892 | C<remove_attribute> method instead. | |||
893 | ||||
894 | =back | |||
895 | ||||
896 | =head2 Attribute Accessor generation | |||
897 | ||||
898 | =over 4 | |||
899 | ||||
900 | =item B<< $attr->accessor_metaclass >> | |||
901 | ||||
902 | Accessor methods are generated using an accessor metaclass. By | |||
903 | default, this is L<Class::MOP::Method::Accessor>. This method returns | |||
904 | the name of the accessor metaclass that this attribute uses. | |||
905 | ||||
906 | =item B<< $attr->associate_method($method) >> | |||
907 | ||||
908 | This associates a L<Class::MOP::Method> object with the | |||
909 | attribute. Typically, this is called internally when an attribute | |||
910 | generates its accessors. | |||
911 | ||||
912 | =item B<< $attr->associated_methods >> | |||
913 | ||||
914 | This returns the list of methods which have been associated with the | |||
915 | attribute. | |||
916 | ||||
917 | =item B<< $attr->install_accessors >> | |||
918 | ||||
919 | This method generates and installs code the attributes various | |||
920 | accessors. It is typically called from the L<Class::MOP::Class> | |||
921 | C<add_attribute> method. | |||
922 | ||||
923 | =item B<< $attr->remove_accessors >> | |||
924 | ||||
925 | This method removes all of the accessors associated with the | |||
926 | attribute. | |||
927 | ||||
928 | This does not currently remove methods from the list returned by | |||
929 | C<associated_methods>. | |||
930 | ||||
931 | =item B<< $attr->inline_get >> | |||
932 | ||||
933 | =item B<< $attr->inline_set >> | |||
934 | ||||
935 | =item B<< $attr->inline_has >> | |||
936 | ||||
937 | =item B<< $attr->inline_clear >> | |||
938 | ||||
939 | These methods return a code snippet suitable for inlining the relevant | |||
940 | operation. They expect strings containing variable names to be used in the | |||
941 | inlining, like C<'$self'> or C<'$_[1]'>. | |||
942 | ||||
943 | =back | |||
944 | ||||
945 | =head2 Introspection | |||
946 | ||||
947 | =over 4 | |||
948 | ||||
949 | =item B<< Class::MOP::Attribute->meta >> | |||
950 | ||||
951 | This will return a L<Class::MOP::Class> instance for this class. | |||
952 | ||||
953 | It should also be noted that L<Class::MOP> will actually bootstrap | |||
954 | this module by installing a number of attribute meta-objects into its | |||
955 | metaclass. | |||
956 | ||||
957 | =back | |||
958 | ||||
959 | =head1 AUTHORS | |||
960 | ||||
961 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
962 | ||||
963 | =head1 COPYRIGHT AND LICENSE | |||
964 | ||||
965 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
966 | ||||
967 | L<http://www.iinteractive.com> | |||
968 | ||||
969 | This library is free software; you can redistribute it and/or modify | |||
970 | it under the same terms as Perl itself. | |||
971 | ||||
972 | =cut | |||
973 | ||||
974 |