2 package Class::MOP::Method::Wrapped;
8 use Scalar::Util 'blessed';
10 our $VERSION = '0.69';
11 $VERSION = eval $VERSION;
12 our $AUTHORITY = 'cpan:STEVAN';
14 use base 'Class::MOP::Method';
17 # this ugly beast is the result of trying
18 # to micro optimize this as much as possible
19 # while not completely loosing maintainability.
20 # At this point it's "fast enough", after all
21 # you can't get something for nothing :)
22 my $_build_wrapped_method = sub {
23 my $modifier_table = shift;
24 my ($before, $after, $around) = (
25 $modifier_table->{before},
26 $modifier_table->{after},
27 $modifier_table->{around},
29 if (@$before && @$after) {
30 $modifier_table->{cache} = sub {
31 $_->(@_) for @{$before};
33 ((defined wantarray) ?
35 (@rval = $around->{cache}->(@_))
37 ($rval[0] = $around->{cache}->(@_)))
39 $around->{cache}->(@_));
40 $_->(@_) for @{$after};
41 return unless defined wantarray;
42 return wantarray ? @rval : $rval[0];
45 elsif (@$before && !@$after) {
46 $modifier_table->{cache} = sub {
47 $_->(@_) for @{$before};
48 return $around->{cache}->(@_);
51 elsif (@$after && !@$before) {
52 $modifier_table->{cache} = sub {
54 ((defined wantarray) ?
56 (@rval = $around->{cache}->(@_))
58 ($rval[0] = $around->{cache}->(@_)))
60 $around->{cache}->(@_));
61 $_->(@_) for @{$after};
62 return unless defined wantarray;
63 return wantarray ? @rval : $rval[0];
67 $modifier_table->{cache} = $around->{cache};
72 my ( $class, $code, %params ) = @_;
74 (blessed($code) && $code->isa('Class::MOP::Method'))
75 || confess "Can only wrap blessed CODE";
77 my $modifier_table = {
87 $_build_wrapped_method->($modifier_table);
88 my $method = $class->SUPER::wrap(
89 sub { $modifier_table->{cache}->(@_) },
90 # get these from the original
91 # unless explicitly overriden
92 package_name => $params{package_name} || $code->package_name,
93 name => $params{name} || $code->name,
95 $method->{'modifier_table'} = $modifier_table;
99 sub get_original_method {
101 $code->{'modifier_table'}->{orig};
104 sub add_before_modifier {
106 my $modifier = shift;
107 unshift @{$code->{'modifier_table'}->{before}} => $modifier;
108 $_build_wrapped_method->($code->{'modifier_table'});
111 sub before_modifiers {
113 return @{$code->{'modifier_table'}->{before}};
116 sub add_after_modifier {
118 my $modifier = shift;
119 push @{$code->{'modifier_table'}->{after}} => $modifier;
120 $_build_wrapped_method->($code->{'modifier_table'});
123 sub after_modifiers {
125 return @{$code->{'modifier_table'}->{after}};
130 # this is another possible candidate for
131 # optimization as well. There is an overhead
132 # associated with the currying that, if
133 # eliminated might make around modifiers
135 my $compile_around_method = sub {{
137 return $f1 unless @_;
139 push @_, sub { $f2->( $f1, @_ ) };
143 sub add_around_modifier {
145 my $modifier = shift;
146 unshift @{$code->{'modifier_table'}->{around}->{methods}} => $modifier;
147 $code->{'modifier_table'}->{around}->{cache} = $compile_around_method->(
148 @{$code->{'modifier_table'}->{around}->{methods}},
149 $code->{'modifier_table'}->{orig}->body
151 $_build_wrapped_method->($code->{'modifier_table'});
155 sub around_modifiers {
157 return @{$code->{'modifier_table'}->{around}->{methods}};
168 Class::MOP::Method::Wrapped - Method Meta Object to handle before/around/after modifiers
172 This is a L<Class::MOP::Method> subclass which provides the funtionality
173 to wrap a given CODE reference with before, after and around method modifiers.
181 =item B<wrap ($code)>
183 This is the constructor, it will return a B<Class::MOP::Method::Wrapped>
184 instance that can be used to add before, after and around modifiers to.
186 =item B<get_original_method>
188 This returns the original CODE reference that was provided to the
195 These three methods will add the method modifiers to the wrapped
196 CODE reference. For more information on how method modifiers work,
197 see the section in L<Class::MOP::Class>.
201 =item B<add_before_modifier ($code)>
203 =item B<add_after_modifier ($code)>
205 =item B<add_around_modifier ($code)>
209 These three methods each returna list of method modifiers I<in the
210 order in which they are run>.
214 =item B<before_modifiers>
216 =item B<after_modifiers>
218 =item B<around_modifiers>
224 Stevan Little E<lt>stevan@iinteractive.comE<gt>
226 =head1 COPYRIGHT AND LICENSE
228 Copyright 2006-2008 by Infinity Interactive, Inc.
230 L<http://www.iinteractive.com>
232 This library is free software; you can redistribute it and/or modify
233 it under the same terms as Perl itself.