File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Moose/Meta/Method/Augmented.pm |
Statements Executed | 13 |
Statement Execution Time | 252µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 17µs | 20µs | BEGIN@3 | Moose::Meta::Method::Augmented::
1 | 1 | 1 | 7µs | 16µs | BEGIN@4 | Moose::Meta::Method::Augmented::
1 | 1 | 1 | 6µs | 48µs | BEGIN@10 | Moose::Meta::Method::Augmented::
0 | 0 | 0 | 0s | 0s | __ANON__[:47] | Moose::Meta::Method::Augmented::
0 | 0 | 0 | 0s | 0s | new | Moose::Meta::Method::Augmented::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Moose::Meta::Method::Augmented; | ||||
2 | |||||
3 | 3 | 23µs | 2 | 23µs | # spent 20µs (17+3) within Moose::Meta::Method::Augmented::BEGIN@3 which was called
# once (17µs+3µs) by Moose::Meta::Class::BEGIN@19 at line 3 # spent 20µs making 1 call to Moose::Meta::Method::Augmented::BEGIN@3
# spent 3µs making 1 call to strict::import |
4 | 3 | 49µs | 2 | 25µs | # spent 16µs (7+9) within Moose::Meta::Method::Augmented::BEGIN@4 which was called
# once (7µs+9µs) by Moose::Meta::Class::BEGIN@19 at line 4 # spent 16µs making 1 call to Moose::Meta::Method::Augmented::BEGIN@4
# spent 9µs making 1 call to warnings::import |
5 | |||||
6 | 1 | 600ns | our $VERSION = '0.98'; | ||
7 | 1 | 18µs | $VERSION = eval $VERSION; | ||
8 | 1 | 300ns | our $AUTHORITY = 'cpan:STEVAN'; | ||
9 | |||||
10 | 3 | 154µs | 2 | 89µs | # spent 48µs (6+41) within Moose::Meta::Method::Augmented::BEGIN@10 which was called
# once (6µs+41µs) by Moose::Meta::Class::BEGIN@19 at line 10 # spent 48µs making 1 call to Moose::Meta::Method::Augmented::BEGIN@10
# spent 41µs making 1 call to base::import |
11 | |||||
12 | sub new { | ||||
13 | 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 | my $name = $args{name}; | ||||
20 | my $meta = $args{class}; | ||||
21 | |||||
22 | my $super = $meta->find_next_method_by_name($name); | ||||
23 | |||||
24 | (defined $super) | ||||
25 | || $meta->throw_error("You cannot augment '$name' because it has no super method", data => $name); | ||||
26 | |||||
27 | my $_super_package = $super->package_name; | ||||
28 | # BUT!,... if this is an overridden method .... | ||||
29 | if ($super->isa('Moose::Meta::Method::Overridden')) { | ||||
30 | # we need to be sure that we actually | ||||
31 | # find the next method, which is not | ||||
32 | # an 'override' method, the reason is | ||||
33 | # that an 'override' method will not | ||||
34 | # be the one calling inner() | ||||
35 | my $real_super = $meta->_find_next_method_by_name_which_is_not_overridden($name); | ||||
36 | $_super_package = $real_super->package_name; | ||||
37 | } | ||||
38 | |||||
39 | my $super_body = $super->body; | ||||
40 | |||||
41 | my $method = $args{method}; | ||||
42 | |||||
43 | my $body = sub { | ||||
44 | local $Moose::INNER_ARGS{$_super_package} = [ @_ ]; | ||||
45 | local $Moose::INNER_BODY{$_super_package} = $method; | ||||
46 | $super_body->(@_); | ||||
47 | }; | ||||
48 | |||||
49 | # FIXME store additional attrs | ||||
50 | $class->wrap( | ||||
51 | $body, | ||||
52 | package_name => $meta->name, | ||||
53 | name => $name | ||||
54 | ); | ||||
55 | } | ||||
56 | |||||
57 | 1 | 7µs | 1; | ||
58 | |||||
59 | __END__ | ||||
60 | |||||
61 | =pod | ||||
62 | |||||
63 | =head1 NAME | ||||
64 | |||||
65 | Moose::Meta::Method::Augmented - A Moose Method metaclass for augmented methods | ||||
66 | |||||
67 | =head1 DESCRIPTION | ||||
68 | |||||
69 | This class implements method augmentation logic for the L<Moose> | ||||
70 | C<augment> keyword. | ||||
71 | |||||
72 | The augmentation subroutine reference will be invoked explicitly using | ||||
73 | the C<inner> keyword from the parent class's method definition. | ||||
74 | |||||
75 | =head1 INHERITANCE | ||||
76 | |||||
77 | C<Moose::Meta::Method::Augmented> is a subclass of L<Moose::Meta::Method>. | ||||
78 | |||||
79 | =head1 METHODS | ||||
80 | |||||
81 | =over 4 | ||||
82 | |||||
83 | =item B<< Moose::Meta::Method::Augmented->new(%options) >> | ||||
84 | |||||
85 | This constructs a new object. It accepts the following options: | ||||
86 | |||||
87 | =over 8 | ||||
88 | |||||
89 | =item * class | ||||
90 | |||||
91 | The metaclass object for the class in which the augmentation is being | ||||
92 | declared. This option is required. | ||||
93 | |||||
94 | =item * name | ||||
95 | |||||
96 | The name of the method which we are augmenting. This method must exist | ||||
97 | in one of the class's superclasses. This option is required. | ||||
98 | |||||
99 | =item * method | ||||
100 | |||||
101 | The subroutine reference which implements the augmentation. This | ||||
102 | option is required. | ||||
103 | |||||
104 | =back | ||||
105 | |||||
106 | =back | ||||
107 | |||||
108 | =head1 BUGS | ||||
109 | |||||
110 | See L<Moose/BUGS> for details on reporting bugs. | ||||
111 | |||||
112 | =head1 AUTHOR | ||||
113 | |||||
114 | Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt> | ||||
115 | |||||
116 | =head1 COPYRIGHT AND LICENSE | ||||
117 | |||||
118 | Copyright 2006-2010 by Infinity Interactive, Inc. | ||||
119 | |||||
120 | L<http://www.iinteractive.com> | ||||
121 | |||||
122 | This library is free software; you can redistribute it and/or modify | ||||
123 | it under the same terms as Perl itself. | ||||
124 | |||||
125 | =cut |