method modifiers

diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index c4aa852..82aebfe 100644 (file)
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -34,15 +34,18 @@ sub new {
                my $code = shift;
                (blessed($code))
                        || confess "Can only ask the package name of a blessed CODE";
-               my $modifier_table = { before => [], after => [] };
+               my $modifier_table = { 
+                       orig   => $code,
+                       before => [],
+                       after  => [],           
+                       around => {
+                               cache   => $code,
+                               methods => [],
+                       },
+               };
                my $method = $code->new(sub {
                        $_->(@_) for @{$modifier_table->{before}};
-                       # NOTE: 
-                       # we actually need to be sure to preserve 
-                       # the calling context and call this method
-                       # with the same context too. This just 
-                       # requires some bookkeeping code, thats all.                    
-                       my @rval = $code->(@_);
+                       my @rval = $modifier_table->{around}->{cache}->(@_);
                        $_->(@_) for @{$modifier_table->{after}};                       
                        return wantarray ? @rval : $rval[0];
                });     
@@ -72,7 +75,33 @@ sub new {
            (reftype($modifier) && reftype($modifier) eq 'CODE')
                || confess "You must supply a CODE reference for a modifier";                   
                push @{$MODIFIERS{$code}->{after}} => $modifier;
-       }       
+       }
+       
+       {
+               my $compile_around_method = sub {{
+               my $f1 = pop;
+               return $f1 unless @_;
+               my $f2 = pop;
+               push @_, sub { $f2->( $f1, @_ ) };
+                       redo;
+               }};
+       
+               sub add_around_modifier {
+                       my $code     = shift;
+                       my $modifier = shift;
+                       (exists $MODIFIERS{$code})
+                               || confess "You must first wrap your method before adding a modifier";          
+                       (blessed($code))
+                               || confess "Can only ask the package name of a blessed CODE";
+                   (reftype($modifier) && reftype($modifier) eq 'CODE')
+                       || confess "You must supply a CODE reference for a modifier";                   
+                       unshift @{$MODIFIERS{$code}->{around}->{methods}} => $modifier;         
+                       $MODIFIERS{$code}->{around}->{cache} = $compile_around_method->(
+                               @{$MODIFIERS{$code}->{around}->{methods}},
+                               $MODIFIERS{$code}->{orig}
+                       );
+               }       
+       }
 }
 
 # informational

diff --git a/t/031_method_modifiers.t b/t/031_method_modifiers.t
index 3e8c617..bbb4e14 100644 (file)
--- a/t/031_method_modifiers.t
+++ b/t/031_method_modifiers.t
@@ -11,34 +11,66 @@ BEGIN {
     use_ok('Class::MOP::Method');
 }
 
-my $trace = '';
+# test before and afters
+{
+       my $trace = '';
 
-my $method = Class::MOP::Method->new(sub { $trace .= 'primary' });
-isa_ok($method, 'Class::MOP::Method');
+       my $method = Class::MOP::Method->new(sub { $trace .= 'primary' });
+       isa_ok($method, 'Class::MOP::Method');
 
-$method->();
-is($trace, 'primary', '... got the right return value from method');
-$trace = '';
+       $method->();
+       is($trace, 'primary', '... got the right return value from method');
+       $trace = '';
 
-my $wrapped = $method->wrap();
-isa_ok($wrapped, 'Class::MOP::Method');
+       my $wrapped = $method->wrap();
+       isa_ok($wrapped, 'Class::MOP::Method');
+
+       $wrapped->();
+       is($trace, 'primary', '... got the right return value from the wrapped method');
+       $trace = '';
+
+       lives_ok {
+               $wrapped->add_before_modifier(sub { $trace .= 'before -> ' });
+       } '... added the before modifier okay';
+
+       $wrapped->();
+       is($trace, 'before -> primary', '... got the right return value from the wrapped method (w/ before)');
+       $trace = '';
+
+       lives_ok {
+               $wrapped->add_after_modifier(sub { $trace .= ' -> after' });
+       } '... added the after modifier okay';
+
+       $wrapped->();
+       is($trace, 'before -> primary -> after', '... got the right return value from the wrapped method (w/ before)');
+       $trace = '';
+}
+
+# test around method
+{
+       my $method = Class::MOP::Method->new(sub { 4 });
+       isa_ok($method, 'Class::MOP::Method');
+       
+       is($method->(), 4, '... got the right value from the wrapped method');  
+
+       my $wrapped = $method->wrap;
+       isa_ok($wrapped, 'Class::MOP::Method');
+
+       is($wrapped->(), 4, '... got the right value from the wrapped method');
+       
+       lives_ok {
+               $wrapped->add_around_modifier(sub { (3, $_[0]->()) });          
+               $wrapped->add_around_modifier(sub { (2, $_[0]->()) });
+               $wrapped->add_around_modifier(sub { (1, $_[0]->()) });          
+       } '... added the around modifier okay'; 
+
+       is_deeply(
+               [ $wrapped->() ],
+               [ 1, 2, 3, 4 ],
+               '... got the right results back from the around methods');
+}
 
-$wrapped->();
-is($trace, 'primary', '... got the right return value from the wrapped method');
-$trace = '';
 
-lives_ok {
-       $wrapped->add_before_modifier(sub { $trace .= 'before -> ' });
-} '... added the before modifier okay';
 
-$wrapped->();
-is($trace, 'before -> primary', '... got the right return value from the wrapped method (w/ before)');
-$trace = '';
 
-lives_ok {
-       $wrapped->add_after_modifier(sub { $trace .= ' -> after' });
-} '... added the after modifier okay';
 
-$wrapped->();
-is($trace, 'before -> primary -> after', '... got the right return value from the wrapped method (w/ before)');
-$trace = '';
\ No newline at end of file