2 package Class::MOP::Method::Wrapped;
8 use Scalar::Util 'reftype', 'blessed';
9 use Sub::Name 'subname';
11 our $VERSION = '0.02';
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};
74 (blessed($code) && $code->isa('Class::MOP::Method'))
75 || confess "Can only wrap blessed CODE";
76 my $modifier_table = {
86 $_build_wrapped_method->($modifier_table);
87 my $method = $class->SUPER::wrap(sub { $modifier_table->{cache}->(@_) });
88 $method->{'%!modifier_table'} = $modifier_table;
92 sub get_original_method {
94 $code->{'%!modifier_table'}->{orig};
97 sub add_before_modifier {
100 unshift @{$code->{'%!modifier_table'}->{before}} => $modifier;
101 $_build_wrapped_method->($code->{'%!modifier_table'});
104 sub add_after_modifier {
106 my $modifier = shift;
107 push @{$code->{'%!modifier_table'}->{after}} => $modifier;
108 $_build_wrapped_method->($code->{'%!modifier_table'});
113 # this is another possible candidate for
114 # optimization as well. There is an overhead
115 # associated with the currying that, if
116 # eliminated might make around modifiers
118 my $compile_around_method = sub {{
120 return $f1 unless @_;
122 push @_, sub { $f2->( $f1, @_ ) };
126 sub add_around_modifier {
128 my $modifier = shift;
129 unshift @{$code->{'%!modifier_table'}->{around}->{methods}} => $modifier;
130 $code->{'%!modifier_table'}->{around}->{cache} = $compile_around_method->(
131 @{$code->{'%!modifier_table'}->{around}->{methods}},
132 $code->{'%!modifier_table'}->{orig}->body
134 $_build_wrapped_method->($code->{'%!modifier_table'});
146 Class::MOP::Method::Wrapped - Method Meta Object to handle before/around/after modifiers
150 This is a L<Class::MOP::Method> subclass which provides the funtionality
151 to wrap a given CODE reference with before, after and around method modifiers.
159 =item B<wrap ($code)>
161 This is the constructor, it will return a B<Class::MOP::Method::Wrapped>
162 instance that can be used to add before, after and around modifiers to.
164 =item B<get_original_method>
166 This returns the original CODE reference that was provided to the
173 These three methods will add the method modifiers to the wrapped
174 CODE reference. For more information on how method modifiers work,
175 see the section in L<Class::MOP::Class>.
179 =item B<add_before_modifier ($code)>
181 =item B<add_after_modifier ($code)>
183 =item B<add_around_modifier ($code)>
189 Stevan Little E<lt>stevan@iinteractive.comE<gt>
191 =head1 COPYRIGHT AND LICENSE
193 Copyright 2006-2008 by Infinity Interactive, Inc.
195 L<http://www.iinteractive.com>
197 This library is free software; you can redistribute it and/or modify
198 it under the same terms as Perl itself.