From: Stevan Little <stevan.little@iinteractive.com>
Date: Tue, 28 Feb 2006 17:33:04 +0000 (+0000)
Subject: method modifiers
X-Git-Tag: 0_20~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=855d277462a4336c2e3b9df51578cf54c4b7280f;p=gitmo%2FClass-MOP.git

method modifiers
---

diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index c4aa852..82aebfe 100644
--- 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
--- 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