File Coverage

blib/lib/Moose/Meta/Method/Augmented.pm
Criterion Covered Total %
statement 28 28 100.0
branch 4 4 100.0
condition n/a
subroutine 13 13 100.0
pod 1 1 100.0
total 46 46 100.0


line stmt bran cond sub pod time code
1             package Moose::Meta::Method::Augmented;
2             our $VERSION = '2.2206';
3              
4 380     380   2817 use strict;
  380         829  
  380         12854  
5 380     380   2028 use warnings;
  380         787  
  380         11864  
6              
7 380     380   2176 use parent 'Moose::Meta::Method';
  380         908  
  380         3662  
8              
9 380     380   26780 use Moose::Util 'throw_exception';
  380         1038  
  380         2590  
10              
11             sub new {
12 14     14 1 64 my ( $class, %args ) = @_;
13              
14             # the package can be overridden by roles
15             # it is really more like body's compilation stash
16             # this is where we need to override the definition of super() so that the
17             # body of the code can call the right overridden version
18 14         40 my $name = $args{name};
19 14         32 my $meta = $args{class};
20              
21 14         74 my $super = $meta->find_next_method_by_name($name);
22              
23 14 100       55 (defined $super)
24             || throw_exception( CannotAugmentNoSuperMethod => params => \%args,
25             class => $class,
26             method_name => $name
27             );
28              
29 13         59 my $_super_package = $super->package_name;
30             # BUT!,... if this is an overridden method ....
31 13 100       81 if ($super->isa('Moose::Meta::Method::Overridden')) {
32             # we need to be sure that we actually
33             # find the next method, which is not
34             # an 'override' method, the reason is
35             # that an 'override' method will not
36             # be the one calling inner()
37 1         6 my $real_super = $meta->_find_next_method_by_name_which_is_not_overridden($name);
38 1         14 $_super_package = $real_super->package_name;
39             }
40              
41 13         45 my $super_body = $super->body;
42              
43 13         29 my $method = $args{method};
44              
45             my $body = sub {
46 19     19   8572 local $Moose::INNER_ARGS{$_super_package} = [ @_ ];
        17      
        15      
        11      
        14      
        11      
        12      
        11      
47 19         46 local $Moose::INNER_BODY{$_super_package} = $method;
48 19         85 $super_body->(@_);
49 13         65 };
50              
51             # FIXME store additional attrs
52 13         86 $class->wrap(
53             $body,
54             package_name => $meta->name,
55             name => $name
56             );
57             }
58              
59             1;
60              
61             # ABSTRACT: A Moose Method metaclass for augmented methods
62              
63             __END__
64              
65             =pod
66              
67             =encoding UTF-8
68              
69             =head1 NAME
70              
71             Moose::Meta::Method::Augmented - A Moose Method metaclass for augmented methods
72              
73             =head1 VERSION
74              
75             version 2.2206
76              
77             =head1 DESCRIPTION
78              
79             This class implements method augmentation logic for the L<Moose>
80             C<augment> keyword.
81              
82             The augmentation subroutine reference will be invoked explicitly using
83             the C<inner> keyword from the parent class's method definition.
84              
85             =head1 INHERITANCE
86              
87             C<Moose::Meta::Method::Augmented> is a subclass of L<Moose::Meta::Method>.
88              
89             =head1 METHODS
90              
91             =head2 Moose::Meta::Method::Augmented->new(%options)
92              
93             This constructs a new object. It accepts the following options:
94              
95             =over 4
96              
97             =item * class
98              
99             The metaclass object for the class in which the augmentation is being
100             declared. This option is required.
101              
102             =item * name
103              
104             The name of the method which we are augmenting. This method must exist
105             in one of the class's superclasses. This option is required.
106              
107             =item * method
108              
109             The subroutine reference which implements the augmentation. This
110             option is required.
111              
112             =back
113              
114             =head1 BUGS
115              
116             See L<Moose/BUGS> for details on reporting bugs.
117              
118             =head1 AUTHORS
119              
120             =over 4
121              
122             =item *
123              
124             Stevan Little <stevan@cpan.org>
125              
126             =item *
127              
128             Dave Rolsky <autarch@urth.org>
129              
130             =item *
131              
132             Jesse Luehrs <doy@cpan.org>
133              
134             =item *
135              
136             Shawn M Moore <sartak@cpan.org>
137              
138             =item *
139              
140             יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
141              
142             =item *
143              
144             Karen Etheridge <ether@cpan.org>
145              
146             =item *
147              
148             Florian Ragwitz <rafl@debian.org>
149              
150             =item *
151              
152             Hans Dieter Pearcey <hdp@cpan.org>
153              
154             =item *
155              
156             Chris Prather <chris@prather.org>
157              
158             =item *
159              
160             Matt S Trout <mstrout@cpan.org>
161              
162             =back
163              
164             =head1 COPYRIGHT AND LICENSE
165              
166             This software is copyright (c) 2006 by Infinity Interactive, Inc.
167              
168             This is free software; you can redistribute it and/or modify it under
169             the same terms as the Perl 5 programming language system itself.
170              
171             =cut