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