From: Stevan Little Date: Tue, 28 Feb 2006 23:10:47 +0000 (+0000) Subject: more method modifier stuff X-Git-Tag: 0_20~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ee5e71d43dd6d0b038dfcea1629897926969beed;p=gitmo%2FClass-MOP.git more method modifier stuff --- diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 542c968..96c8539 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -230,7 +230,7 @@ sub add_method { (defined $method_name && $method_name) || confess "You must define a method name"; # use reftype here to allow for blessed subs ... - (reftype($method) && reftype($method) eq 'CODE') + ('CODE' eq (reftype($method) || '')) || confess "Your code block must be a CODE reference"; my $full_method_name = ($self->name . '::' . $method_name); @@ -241,12 +241,16 @@ sub add_method { *{$full_method_name} = subname $full_method_name => $method; } +sub add_method_modifier { + +} + sub alias_method { my ($self, $method_name, $method) = @_; (defined $method_name && $method_name) || confess "You must define a method name"; # use reftype here to allow for blessed subs ... - (reftype($method) && reftype($method) eq 'CODE') + ('CODE' eq (reftype($method) || '')) || confess "Your code block must be a CODE reference"; my $full_method_name = ($self->name . '::' . $method_name); @@ -713,6 +717,8 @@ other than use B to make sure it is tagged with the correct name, and therefore show up correctly in stack traces and such. +=item B + =item B This will take a C<$method_name> and CODE reference to that diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm index 912368a..ef479f3 100644 --- a/lib/Class/MOP/Method.pm +++ b/lib/Class/MOP/Method.pm @@ -22,7 +22,7 @@ sub meta { sub new { my $class = shift; my $code = shift; - (reftype($code) && reftype($code) eq 'CODE') + ('CODE' eq (reftype($code) || '')) || confess "You must supply a CODE reference to bless"; bless $code => blessed($class) || $class; } @@ -72,7 +72,7 @@ sub new { || 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') + ('CODE' eq (reftype($code) || '')) || confess "You must supply a CODE reference for a modifier"; unshift @{$MODIFIERS{$code}->{before}} => $modifier; } @@ -84,7 +84,7 @@ sub new { || 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') + ('CODE' eq (reftype($code) || '')) || confess "You must supply a CODE reference for a modifier"; push @{$MODIFIERS{$code}->{after}} => $modifier; } @@ -105,7 +105,7 @@ sub new { || 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') + ('CODE' eq (reftype($code) || '')) || confess "You must supply a CODE reference for a modifier"; unshift @{$MODIFIERS{$code}->{around}->{methods}} => $modifier; $MODIFIERS{$code}->{around}->{cache} = $compile_around_method->( @@ -177,6 +177,10 @@ to this class. This simply blesses the C<&code> reference passed to it. +=item B + +This wraps an existing method so that it can handle method modifiers. + =back =head2 Informational @@ -189,11 +193,17 @@ This simply blesses the C<&code> reference passed to it. =back -=head1 SEE ALSO +=head2 Modifiers + +=over 4 -http://dirtsimple.org/2005/01/clos-style-method-combination-for.html +=item B -http://www.gigamonkeys.com/book/object-reorientation-generic-functions.html +=item B + +=item B + +=back =head1 AUTHOR diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index c8308b6..d5dafa9 100644 --- a/t/010_self_introspection.t +++ b/t/010_self_introspection.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 118; +use Test::More tests => 120; use Test::Exception; BEGIN { @@ -37,6 +37,8 @@ my @methods = qw( has_method get_method add_method remove_method alias_method get_method_list compute_all_applicable_methods find_all_methods_by_name + add_method_modifier + has_attribute get_attribute add_attribute remove_attribute get_attribute_list get_attribute_map compute_all_applicable_attributes diff --git a/t/031_method_modifiers.t b/t/031_method_modifiers.t index 5bd4d3d..a1d019e 100644 --- a/t/031_method_modifiers.t +++ b/t/031_method_modifiers.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More no_plan => 18; +use Test::More tests => 23; use Test::Exception; BEGIN { @@ -73,7 +73,44 @@ BEGIN { is(scalar $wrapped->(), 4, '... got the right results back from the around methods (in scalar context)'); } - +{ + my @tracelog; + + my $method = Class::MOP::Method->new(sub { push @tracelog => 'primary' }); + isa_ok($method, 'Class::MOP::Method'); + + my $wrapped = $method->wrap(); + isa_ok($wrapped, 'Class::MOP::Method'); + + lives_ok { + $wrapped->add_before_modifier(sub { push @tracelog => 'before 1' }); + $wrapped->add_before_modifier(sub { push @tracelog => 'before 2' }); + $wrapped->add_before_modifier(sub { push @tracelog => 'before 3' }); + } '... added the before modifier okay'; + + lives_ok { + $wrapped->add_around_modifier(sub { push @tracelog => 'around 3'; $_[0]->(); }); + $wrapped->add_around_modifier(sub { push @tracelog => 'around 2'; $_[0]->(); }); + $wrapped->add_around_modifier(sub { push @tracelog => 'around 1'; $_[0]->(); }); + } '... added the around modifier okay'; + + lives_ok { + $wrapped->add_after_modifier(sub { push @tracelog => 'after 3' }); + $wrapped->add_after_modifier(sub { push @tracelog => 'after 2' }); + $wrapped->add_after_modifier(sub { push @tracelog => 'after 1' }); + } '... added the after modifier okay'; + + $wrapped->(); + is_deeply( + \@tracelog, + [ + 'before 3', 'before 2', 'before 1', # last-in-first-out order + 'around 1', 'around 2', 'around 3', # last-in-first-out order + 'primary', + 'after 3', 'after 2', 'after 1', # first-in-first-out order + ], + '... got the right tracelog from all our before/around/after methods'); +}