| File | /usr/local/lib/perl5/site_perl/5.10.1/MooseX/AttributeHelpers/Trait/Base.pm |
| Statements Executed | 157 |
| Statement Execution Time | 1.32ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 2 | 1 | 1 | 132µs | 3.39ms | MooseX::AttributeHelpers::Trait::Base::__ANON__[:51] |
| 2 | 1 | 1 | 51µs | 3.53ms | MooseX::AttributeHelpers::Trait::Base::check_provides_values |
| 2 | 1 | 1 | 48µs | 1.51ms | MooseX::AttributeHelpers::Trait::Base::process_options_for_provides |
| 1 | 1 | 1 | 18µs | 1.41ms | MooseX::AttributeHelpers::Trait::Base::BEGIN@3 |
| 1 | 1 | 1 | 8µs | 96µs | MooseX::AttributeHelpers::Trait::Base::BEGIN@219 |
| 1 | 1 | 1 | 8µs | 1.17ms | MooseX::AttributeHelpers::Trait::Base::BEGIN@4 |
| 1 | 1 | 1 | 7µs | 93µs | MooseX::AttributeHelpers::Trait::Base::BEGIN@220 |
| 2 | 1 | 1 | 5µs | 5µs | MooseX::AttributeHelpers::Trait::Base::__ANON__[:22] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::Trait::Base::__ANON__[:105] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::Trait::Base::__ANON__[:116] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::Trait::Base::__ANON__[:16] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::Trait::Base::__ANON__[:194] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::Trait::Base::__ANON__[:217] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::Trait::Base::__ANON__[:77] |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::Trait::Base::_curry |
| 0 | 0 | 0 | 0s | 0s | MooseX::AttributeHelpers::Trait::Base::_curry_sub |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | |||||
| 2 | package MooseX::AttributeHelpers::Trait::Base; | ||||
| 3 | 3 | 26µs | 2 | 2.81ms | # spent 1.41ms (18µs+1.39) within MooseX::AttributeHelpers::Trait::Base::BEGIN@3 which was called
# once (18µs+1.39ms) by Class::MOP::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP.pm:103] at line 3 # spent 1.41ms making 1 call to MooseX::AttributeHelpers::Trait::Base::BEGIN@3
# spent 1.39ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:389] |
| 4 | 3 | 780µs | 2 | 2.33ms | # spent 1.17ms (8µs+1.16) within MooseX::AttributeHelpers::Trait::Base::BEGIN@4 which was called
# once (8µs+1.16ms) by Class::MOP::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP.pm:103] at line 4 # spent 1.17ms making 1 call to MooseX::AttributeHelpers::Trait::Base::BEGIN@4
# spent 1.16ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:389] |
| 5 | |||||
| 6 | 1 | 700ns | our $VERSION = '0.23'; | ||
| 7 | 1 | 14µs | $VERSION = eval $VERSION; | ||
| 8 | 1 | 300ns | our $AUTHORITY = 'cpan:STEVAN'; | ||
| 9 | |||||
| 10 | 1 | 2µs | 1 | 114µs | requires 'helper_type'; # spent 114µs making 1 call to Moose::Role::requires |
| 11 | |||||
| 12 | # this is the method map you define ... | ||||
| 13 | has 'provides' => ( | ||||
| 14 | is => 'ro', | ||||
| 15 | isa => 'HashRef', | ||||
| 16 | default => sub {{}} | ||||
| 17 | 1 | 3µs | 1 | 194µs | ); # spent 194µs making 1 call to Moose::Role::has |
| 18 | |||||
| 19 | 2 | 5µs | has 'curries' => ( | ||
| 20 | is => 'ro', | ||||
| 21 | isa => 'HashRef', | ||||
| 22 | # spent 5µs within MooseX::AttributeHelpers::Trait::Base::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/MooseX/AttributeHelpers/Trait/Base.pm:22] which was called 2 times, avg 2µs/call:
# 2 times (5µs+0s) by Class::MOP::Mixin::AttributeCore::default at line 53 of Class/MOP/Mixin/AttributeCore.pm, avg 2µs/call | ||||
| 23 | 1 | 2µs | 1 | 93µs | ); # spent 93µs making 1 call to Moose::Role::has |
| 24 | |||||
| 25 | # these next two are the possible methods | ||||
| 26 | # you can use in the 'provides' map. | ||||
| 27 | |||||
| 28 | # provide a Class or Role which we can | ||||
| 29 | # collect the method providers from | ||||
| 30 | |||||
| 31 | # requires_attr 'method_provider' | ||||
| 32 | |||||
| 33 | # or you can provide a HASH ref of anon subs | ||||
| 34 | # yourself. This will also collect and store | ||||
| 35 | # the methods from a method_provider as well | ||||
| 36 | has 'method_constructors' => ( | ||||
| 37 | is => 'ro', | ||||
| 38 | isa => 'HashRef', | ||||
| 39 | lazy => 1, | ||||
| 40 | # spent 3.39ms (132µs+3.26) within MooseX::AttributeHelpers::Trait::Base::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/MooseX/AttributeHelpers/Trait/Base.pm:51] which was called 2 times, avg 1.70ms/call:
# 2 times (132µs+3.26ms) by Class::MOP::Mixin::AttributeCore::default at line 53 of Class/MOP/Mixin/AttributeCore.pm, avg 1.70ms/call | ||||
| 41 | 8 | 64µs | my $self = shift; | ||
| 42 | return +{} unless $self->has_method_provider; # spent 6µs making 2 calls to MooseX::AttributeHelpers::Collection::Hash::has_method_provider, avg 3µs/call | ||||
| 43 | # or grab them from the role/class | ||||
| 44 | my $method_provider = $self->method_provider->meta; # spent 26µs making 2 calls to MooseX::AttributeHelpers::MethodProvider::Hash::meta, avg 13µs/call
# spent 8µs making 2 calls to MooseX::AttributeHelpers::Collection::Hash::method_provider, avg 4µs/call | ||||
| 45 | return +{ | ||||
| 46 | map { # spent 537µs making 26 calls to Class::MOP::Mixin::HasMethods::get_method, avg 21µs/call | ||||
| 47 | $_ => $method_provider->get_method($_) | ||||
| 48 | } | ||||
| 49 | 26 | 29µs | 2 | 2.69ms | grep { $_ ne 'meta' } $method_provider->get_method_list # spent 2.69ms making 2 calls to Class::MOP::Mixin::HasMethods::get_method_list, avg 1.34ms/call |
| 50 | }; | ||||
| 51 | }, | ||||
| 52 | 1 | 4µs | 1 | 108µs | ); # spent 108µs making 1 call to Moose::Role::has |
| 53 | |||||
| 54 | ## Methods called prior to instantiation | ||||
| 55 | |||||
| 56 | # spent 1.51ms (48µs+1.46) within MooseX::AttributeHelpers::Trait::Base::process_options_for_provides which was called 2 times, avg 754µs/call:
# 2 times (48µs+1.46ms) by Class::MOP::Class:::before at line 76, avg 754µs/call | ||||
| 57 | 4 | 14µs | my ($self, $options) = @_; | ||
| 58 | |||||
| 59 | 8 | 28µs | 2 | 4µs | if (my $type = $self->helper_type) { # spent 4µs making 2 calls to MooseX::AttributeHelpers::Trait::Collection::Hash::helper_type, avg 2µs/call |
| 60 | (exists $options->{isa}) | ||||
| 61 | || confess "You must define a type with the $type metaclass"; | ||||
| 62 | |||||
| 63 | my $isa = $options->{isa}; | ||||
| 64 | |||||
| 65 | unless (blessed($isa) && $isa->isa('Moose::Meta::TypeConstraint')) { # spent 1.29ms making 2 calls to Moose::Util::TypeConstraints::find_or_create_type_constraint, avg 646µs/call
# spent 2µs making 2 calls to Scalar::Util::blessed, avg 800ns/call | ||||
| 66 | $isa = Moose::Util::TypeConstraints::find_or_create_type_constraint($isa); | ||||
| 67 | } | ||||
| 68 | |||||
| 69 | ($isa->is_a_type_of($type)) # spent 164µs making 2 calls to Moose::Meta::TypeConstraint::is_a_type_of, avg 82µs/call | ||||
| 70 | || confess "The type constraint for a $type ($options->{isa}) must be a subtype of $type"; | ||||
| 71 | } | ||||
| 72 | } | ||||
| 73 | |||||
| 74 | before '_process_options' => sub { | ||||
| 75 | 4 | 13µs | my ($self, $name, $options) = @_; | ||
| 76 | $self->process_options_for_provides($options, $name); # spent 1.51ms making 2 calls to MooseX::AttributeHelpers::Trait::Base::process_options_for_provides, avg 754µs/call | ||||
| 77 | 1 | 3µs | 1 | 53µs | }; # spent 53µs making 1 call to Moose::Role::before |
| 78 | |||||
| 79 | ## methods called after instantiation | ||||
| 80 | |||||
| 81 | # spent 3.53ms (51µs+3.48) within MooseX::AttributeHelpers::Trait::Base::check_provides_values which was called 2 times, avg 1.77ms/call:
# 2 times (51µs+3.48ms) by Class::MOP::Class:::after at line 132, avg 1.77ms/call | ||||
| 82 | 8 | 33µs | my $self = shift; | ||
| 83 | |||||
| 84 | my $method_constructors = $self->method_constructors; # spent 3.47ms making 2 calls to MooseX::AttributeHelpers::Collection::Hash::method_constructors, avg 1.73ms/call | ||||
| 85 | |||||
| 86 | foreach my $key (keys %{$self->provides}) { # spent 7µs making 2 calls to MooseX::AttributeHelpers::Collection::Hash::provides, avg 4µs/call | ||||
| 87 | 9 | 3µs | (exists $method_constructors->{$key}) | ||
| 88 | || confess "$key is an unsupported method type"; | ||||
| 89 | } | ||||
| 90 | |||||
| 91 | foreach my $key (keys %{$self->curries}) { # spent 7µs making 2 calls to MooseX::AttributeHelpers::Collection::Hash::curries, avg 4µs/call | ||||
| 92 | (exists $method_constructors->{$key}) | ||||
| 93 | || confess "$key is an unsupported method type"; | ||||
| 94 | } | ||||
| 95 | } | ||||
| 96 | |||||
| 97 | sub _curry { | ||||
| 98 | my $self = shift; | ||||
| 99 | my $code = shift; | ||||
| 100 | |||||
| 101 | my @args = @_; | ||||
| 102 | return sub { | ||||
| 103 | my $self = shift; | ||||
| 104 | $code->($self, @args, @_) | ||||
| 105 | }; | ||||
| 106 | } | ||||
| 107 | |||||
| 108 | sub _curry_sub { | ||||
| 109 | my $self = shift; | ||||
| 110 | my $body = shift; | ||||
| 111 | my $code = shift; | ||||
| 112 | |||||
| 113 | return sub { | ||||
| 114 | my $self = shift; | ||||
| 115 | $code->($self, $body, @_) | ||||
| 116 | }; | ||||
| 117 | } | ||||
| 118 | |||||
| 119 | after 'install_accessors' => sub { | ||||
| 120 | 18 | 57µs | my $attr = shift; | ||
| 121 | my $class = $attr->associated_class; # spent 2µs making 2 calls to Class::MOP::Attribute::associated_class, avg 1µs/call | ||||
| 122 | |||||
| 123 | # grab the reader and writer methods | ||||
| 124 | # as well, this will be useful for | ||||
| 125 | # our method provider constructors | ||||
| 126 | my $attr_reader = $attr->get_read_method_ref; # spent 99µs making 2 calls to Class::MOP::Attribute::get_read_method_ref, avg 49µs/call | ||||
| 127 | my $attr_writer = $attr->get_write_method_ref; # spent 137µs making 2 calls to Class::MOP::Attribute::get_write_method_ref, avg 68µs/call | ||||
| 128 | |||||
| 129 | |||||
| 130 | # before we install them, lets | ||||
| 131 | # make sure they are valid | ||||
| 132 | $attr->check_provides_values; # spent 3.53ms making 2 calls to MooseX::AttributeHelpers::Trait::Base::check_provides_values, avg 1.77ms/call | ||||
| 133 | |||||
| 134 | my $method_constructors = $attr->method_constructors; # spent 4µs making 2 calls to MooseX::AttributeHelpers::Collection::Hash::method_constructors, avg 2µs/call | ||||
| 135 | |||||
| 136 | my $class_name = $class->name; # spent 2µs making 2 calls to Class::MOP::Package::name, avg 750ns/call | ||||
| 137 | |||||
| 138 | while (my ($constructor, $constructed) = each %{$attr->curries}) { # spent 2µs making 2 calls to MooseX::AttributeHelpers::Collection::Hash::curries, avg 1µs/call | ||||
| 139 | 1 | 2µs | my $method_code; | ||
| 140 | while (my ($curried_name, $curried_arg) = each(%$constructed)) { | ||||
| 141 | if ($class->has_method($curried_name)) { | ||||
| 142 | confess | ||||
| 143 | "The method ($curried_name) already ". | ||||
| 144 | "exists in class (" . $class->name . ")"; | ||||
| 145 | } | ||||
| 146 | my $body = $method_constructors->{$constructor}->( | ||||
| 147 | $attr, | ||||
| 148 | $attr_reader, | ||||
| 149 | $attr_writer, | ||||
| 150 | ); | ||||
| 151 | |||||
| 152 | if (ref $curried_arg eq 'ARRAY') { | ||||
| 153 | $method_code = $attr->_curry($body, @$curried_arg); | ||||
| 154 | } | ||||
| 155 | elsif (ref $curried_arg eq 'CODE') { | ||||
| 156 | $method_code = $attr->_curry_sub($body, $curried_arg); | ||||
| 157 | } | ||||
| 158 | else { | ||||
| 159 | confess "curries parameter must be ref type ARRAY or CODE"; | ||||
| 160 | } | ||||
| 161 | |||||
| 162 | my $method = MooseX::AttributeHelpers::Meta::Method::Curried->wrap( | ||||
| 163 | $method_code, | ||||
| 164 | package_name => $class_name, | ||||
| 165 | name => $curried_name, | ||||
| 166 | ); | ||||
| 167 | |||||
| 168 | $attr->associate_method($method); | ||||
| 169 | $class->add_method($curried_name => $method); | ||||
| 170 | } | ||||
| 171 | } | ||||
| 172 | |||||
| 173 | foreach my $key (keys %{$attr->provides}) { # spent 2µs making 2 calls to MooseX::AttributeHelpers::Collection::Hash::provides, avg 1µs/call | ||||
| 174 | |||||
| 175 | 45 | 116µs | 9 | 16µs | my $method_name = $attr->provides->{$key}; # spent 16µs making 9 calls to MooseX::AttributeHelpers::Collection::Hash::provides, avg 2µs/call |
| 176 | |||||
| 177 | if ($class->has_method($method_name)) { # spent 290µs making 9 calls to Class::MOP::Mixin::HasMethods::has_method, avg 32µs/call | ||||
| 178 | confess "The method ($method_name) already exists in class (" . $class->name . ")"; | ||||
| 179 | } | ||||
| 180 | |||||
| 181 | 1 | 20µs | 36 | 2.86ms | my $method = MooseX::AttributeHelpers::Meta::Method::Provided->wrap( # spent 2.57ms making 9 calls to Class::MOP::Method::wrap, avg 285µs/call
# spent 93µs making 2 calls to MooseX::AttributeHelpers::MethodProvider::Hash::set, avg 46µs/call
# spent 65µs making 18 calls to Class::MOP::Method::__ANON__[Class/MOP/Method.pm:19], avg 4µs/call
# spent 46µs making 2 calls to MooseX::AttributeHelpers::MethodProvider::Hash::delete, avg 23µs/call
# spent 38µs making 2 calls to MooseX::AttributeHelpers::MethodProvider::ImmutableHash::get, avg 19µs/call
# spent 34µs making 2 calls to MooseX::AttributeHelpers::MethodProvider::ImmutableHash::exists, avg 17µs/call
# spent 23µs making 1 call to MooseX::AttributeHelpers::MethodProvider::ImmutableHash::keys |
| 182 | $method_constructors->{$key}->( | ||||
| 183 | $attr, | ||||
| 184 | $attr_reader, | ||||
| 185 | $attr_writer, | ||||
| 186 | ), | ||||
| 187 | package_name => $class_name, | ||||
| 188 | name => $method_name, | ||||
| 189 | ); | ||||
| 190 | |||||
| 191 | $attr->associate_method($method); # spent 19µs making 9 calls to Class::MOP::Attribute::associate_method, avg 2µs/call | ||||
| 192 | $class->add_method($method_name => $method); # spent 420µs making 9 calls to Class::MOP::Mixin::HasMethods::add_method, avg 47µs/call | ||||
| 193 | } | ||||
| 194 | 1 | 4µs | 1 | 45µs | }; # spent 45µs making 1 call to Moose::Role::after |
| 195 | |||||
| 196 | after 'remove_accessors' => sub { | ||||
| 197 | my $attr = shift; | ||||
| 198 | my $class = $attr->associated_class; | ||||
| 199 | |||||
| 200 | # provides accessors | ||||
| 201 | foreach my $key (keys %{$attr->provides}) { | ||||
| 202 | my $method_name = $attr->provides->{$key}; | ||||
| 203 | my $method = $class->get_method($method_name); | ||||
| 204 | $class->remove_method($method_name) | ||||
| 205 | if blessed($method) && | ||||
| 206 | $method->isa('MooseX::AttributeHelpers::Meta::Method::Provided'); | ||||
| 207 | } | ||||
| 208 | |||||
| 209 | # curries accessors | ||||
| 210 | foreach my $key (keys %{$attr->curries}) { | ||||
| 211 | my $method_name = $attr->curries->{$key}; | ||||
| 212 | my $method = $class->get_method($method_name); | ||||
| 213 | $class->remove_method($method_name) | ||||
| 214 | if blessed($method) && | ||||
| 215 | $method->isa('MooseX::AttributeHelpers::Meta::Method::Provided'); | ||||
| 216 | } | ||||
| 217 | 1 | 8µs | 1 | 30µs | }; # spent 30µs making 1 call to Moose::Role::after |
| 218 | |||||
| 219 | 3 | 25µs | 2 | 184µs | # spent 96µs (8+88) within MooseX::AttributeHelpers::Trait::Base::BEGIN@219 which was called
# once (8µs+88µs) by Class::MOP::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP.pm:103] at line 219 # spent 96µs making 1 call to MooseX::AttributeHelpers::Trait::Base::BEGIN@219
# spent 88µs making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:478] |
| 220 | 3 | 35µs | 2 | 178µs | # spent 93µs (7+86) within MooseX::AttributeHelpers::Trait::Base::BEGIN@220 which was called
# once (7µs+86µs) by Class::MOP::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Class/MOP.pm:103] at line 220 # spent 93µs making 1 call to MooseX::AttributeHelpers::Trait::Base::BEGIN@220
# spent 85µs making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:478] |
| 221 | |||||
| 222 | 1 | 31µs | 1; | ||
| 223 | |||||
| 224 | __END__ | ||||
| 225 | |||||
| 226 | =head1 NAME | ||||
| 227 | |||||
| 228 | MooseX::AttributeHelpers::Trait::Base - base role for helpers | ||||
| 229 | |||||
| 230 | =head1 METHODS | ||||
| 231 | |||||
| 232 | =head2 check_provides_values | ||||
| 233 | |||||
| 234 | Confirms that provides (and curries) has all valid possibilities in it. | ||||
| 235 | |||||
| 236 | =head2 process_options_for_provides | ||||
| 237 | |||||
| 238 | Ensures that the type constraint (C<isa>) matches the helper type. | ||||
| 239 | |||||
| 240 | =head1 BUGS | ||||
| 241 | |||||
| 242 | All complex software has bugs lurking in it, and this module is no | ||||
| 243 | exception. If you find a bug please either email me, or add the bug | ||||
| 244 | to cpan-RT. | ||||
| 245 | |||||
| 246 | =head1 AUTHORS | ||||
| 247 | |||||
| 248 | Yuval Kogman | ||||
| 249 | |||||
| 250 | Shawn M Moore | ||||
| 251 | |||||
| 252 | Jesse Luehrs | ||||
| 253 | |||||
| 254 | =head1 COPYRIGHT AND LICENSE | ||||
| 255 | |||||
| 256 | Copyright 2007-2009 by Infinity Interactive, Inc. | ||||
| 257 | |||||
| 258 | L<http://www.iinteractive.com> | ||||
| 259 | |||||
| 260 | This library is free software; you can redistribute it and/or modify | ||||
| 261 | it under the same terms as Perl itself. | ||||
| 262 | |||||
| 263 | =cut |