| 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 | Class::MOP::Attribute::_process_accessors |
| 191 | 3 | 2 | 3.75ms | 107ms | Class::MOP::Attribute::install_accessors |
| 347 | 1 | 1 | 3.17ms | 11.7ms | Class::MOP::Attribute::initialize_instance_slot |
| 357 | 3 | 2 | 2.77ms | 18.0ms | Class::MOP::Attribute::inline_set |
| 123 | 50 | 4 | 2.77ms | 6.55ms | Class::MOP::Attribute::new |
| 177 | 1 | 1 | 2.67ms | 48.8ms | Class::MOP::Attribute::__ANON__[:342] |
| 286 | 1 | 1 | 2.50ms | 6.56ms | Class::MOP::Attribute::_set_initial_slot_value |
| 115 | 1 | 1 | 1.89ms | 3.13ms | Class::MOP::Attribute::_new |
| 441 | 3 | 2 | 1.80ms | 3.21ms | Class::MOP::Attribute::slots |
| 234 | 2 | 1 | 1.71ms | 1.71ms | Class::MOP::Attribute::associate_method |
| 123 | 1 | 1 | 888µs | 1.84ms | Class::MOP::Attribute::attach_to_class |
| 223 | 2 | 1 | 787µs | 787µs | Class::MOP::Attribute::accessor_metaclass |
| 78 | 3 | 2 | 727µs | 6.11ms | Class::MOP::Attribute::inline_get |
| 13 | 1 | 1 | 146µs | 458µs | Class::MOP::Attribute::inline_has |
| 8 | 1 | 1 | 72µs | 326µs | Class::MOP::Attribute::get_raw_value |
| 2 | 1 | 1 | 39µs | 113µs | Class::MOP::Attribute::has_value |
| 8 | 1 | 1 | 36µs | 362µs | Class::MOP::Attribute::get_value |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::__ANON__[:153] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::__ANON__[:190] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::__ANON__[:210] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::__ANON__[:345] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::__ANON__[:388] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::clear_value |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::detach_from_class |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::get_read_method |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::get_read_method_ref |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::get_write_method |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::get_write_method_ref |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::inline_clear |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::remove_accessors |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::set_initial_value |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::set_raw_value |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Attribute::set_value |
| 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 | 1230 | 2.75ms | 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 | 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 | 2106 | 9.12ms | 4µ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 | 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 |