File | /usr/local/lib/perl/5.10.0/Moose/Meta/Method/Overridden.pm |
Statements Executed | 4049 |
Total Time | 0.0104913 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
4 | 1 | 1 | 129µs | 1.67ms | new | Moose::Meta::Method::Overridden::
0 | 0 | 0 | 0s | 0s | BEGIN | Moose::Meta::Method::Overridden::
0 | 0 | 0 | 0s | 0s | __ANON__[:37] | Moose::Meta::Method::Overridden::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package Moose::Meta::Method::Overridden; | |||
2 | ||||
3 | 3 | 23µs | 8µs | use strict; # spent 7µs making 1 call to strict::import |
4 | 3 | 59µs | 20µs | use warnings; # spent 24µs making 1 call to warnings::import |
5 | ||||
6 | 1 | 700ns | 700ns | our $VERSION = '1.15'; |
7 | 1 | 19µs | 19µs | $VERSION = eval $VERSION; |
8 | 1 | 600ns | 600ns | our $AUTHORITY = 'cpan:STEVAN'; |
9 | ||||
10 | 3 | 238µs | 79µs | use base 'Moose::Meta::Method'; # spent 4.14ms making 1 call to base::import |
11 | ||||
12 | # spent 1.67ms (129µs+1.54) within Moose::Meta::Method::Overridden::new which was called 4 times, avg 418µs/call:
# 4 times (129µs+1.54ms) by Moose::Meta::Class::add_override_method_modifier at line 313 of /usr/local/lib/perl/5.10.0/Moose/Meta/Class.pm, avg 418µs/call | |||
13 | 4 | 22µs | 5µs | my ( $class, %args ) = @_; |
14 | ||||
15 | # the package can be overridden by roles | |||
16 | # it is really more like body's compilation stash | |||
17 | # this is where we need to override the definition of super() so that the | |||
18 | # body of the code can call the right overridden version | |||
19 | 4 | 28µs | 7µs | my $super_package = $args{package} || $args{class}->name; # spent 15µs making 4 calls to Class::MOP::Package::name, avg 4µs/call |
20 | ||||
21 | 4 | 5µs | 1µs | my $name = $args{name}; |
22 | ||||
23 | 4 | 27µs | 7µs | my $super = $args{class}->find_next_method_by_name($name); # spent 953µs making 4 calls to Class::MOP::Class::find_next_method_by_name, avg 238µs/call |
24 | ||||
25 | 4 | 2µs | 525ns | (defined $super) |
26 | || $class->throw_error("You cannot override '$name' because it has no super method", data => $name); | |||
27 | ||||
28 | 4 | 22µs | 5µs | my $super_body = $super->body; # spent 16µs making 4 calls to Class::MOP::Method::body, avg 4µs/call |
29 | ||||
30 | 4 | 5µs | 1µs | my $method = $args{method}; |
31 | ||||
32 | my $body = sub { | |||
33 | 1000 | 1.07ms | 1µs | local $Moose::SUPER_PACKAGE = $super_package; |
34 | 1000 | 3.17ms | 3µs | local @Moose::SUPER_ARGS = @_; |
35 | 1000 | 382µs | 382ns | local $Moose::SUPER_BODY = $super_body; |
36 | 1000 | 5.34ms | 5µs | return $method->(@_); # spent 858ms making 1000 calls to MARC::Moose::Parser::Marcxml::__ANON__[/home/tamil/util/marc-moose/lib/MARC/Moose/Parser/Marcxml.pm:62], avg 858µs/call |
37 | 4 | 22µs | 6µs | }; |
38 | ||||
39 | # FIXME do we need this make sure this works for next::method? | |||
40 | # subname "${super_package}::${name}", $method; | |||
41 | ||||
42 | # FIXME store additional attrs | |||
43 | 4 | 50µs | 12µs | $class->wrap( # spent 545µs making 4 calls to Class::MOP::Method::wrap, avg 136µs/call
# spent 14µs making 4 calls to Class::MOP::Package::name, avg 4µs/call |
44 | $body, | |||
45 | package_name => $args{class}->name, | |||
46 | name => $name | |||
47 | ); | |||
48 | } | |||
49 | ||||
50 | 1 | 8µs | 8µs | 1; |
51 | ||||
52 | __END__ | |||
53 | ||||
54 | =pod | |||
55 | ||||
56 | =head1 NAME | |||
57 | ||||
58 | Moose::Meta::Method::Overridden - A Moose Method metaclass for overridden methods | |||
59 | ||||
60 | =head1 DESCRIPTION | |||
61 | ||||
62 | This class implements method overriding logic for the L<Moose> | |||
63 | C<override> keyword. | |||
64 | ||||
65 | The overriding subroutine's parent will be invoked explicitly using | |||
66 | the C<super> keyword from the parent class's method definition. | |||
67 | ||||
68 | =head1 METHODS | |||
69 | ||||
70 | =over 4 | |||
71 | ||||
72 | =item B<< Moose::Meta::Method::Overridden->new(%options) >> | |||
73 | ||||
74 | This constructs a new object. It accepts the following options: | |||
75 | ||||
76 | =over 8 | |||
77 | ||||
78 | =item * class | |||
79 | ||||
80 | The metaclass object for the class in which the override is being | |||
81 | declared. This option is required. | |||
82 | ||||
83 | =item * name | |||
84 | ||||
85 | The name of the method which we are overriding. This method must exist | |||
86 | in one of the class's superclasses. This option is required. | |||
87 | ||||
88 | =item * method | |||
89 | ||||
90 | The subroutine reference which implements the overriding. This option | |||
91 | is required. | |||
92 | ||||
93 | =back | |||
94 | ||||
95 | =back | |||
96 | ||||
97 | =head1 BUGS | |||
98 | ||||
99 | See L<Moose/BUGS> for details on reporting bugs. | |||
100 | ||||
101 | =head1 AUTHOR | |||
102 | ||||
103 | Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt> | |||
104 | ||||
105 | =head1 COPYRIGHT AND LICENSE | |||
106 | ||||
107 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
108 | ||||
109 | L<http://www.iinteractive.com> | |||
110 | ||||
111 | This library is free software; you can redistribute it and/or modify | |||
112 | it under the same terms as Perl itself. | |||
113 | ||||
114 | =cut |