From: Stevan Little <stevan.little@iinteractive.com>
Date: Tue, 20 May 2008 22:18:46 +0000 (+0000)
Subject: method modifier with regexp is done now
X-Git-Tag: 0_55~157
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=401cb5a6726b7cafba114173ac335613b8d854c7;p=gitmo%2FMoose.git

method modifier with regexp is done now
---

diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index c6d4b33..0f2ef34 100644
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -83,30 +83,47 @@ use Moose::Util::TypeConstraints;
             my $meta = _find_meta();
             return Class::MOP::subname('Moose::Role::before' => sub (@&) {
                 my $code = pop @_;
-                $meta->add_before_method_modifier($_, $code) for @_;
+                do {
+                    confess "Moose::Role do not currently support " 
+                          . ref($_) 
+                          . " references for before method modifiers" 
+                    if ref $_;
+                    $meta->add_before_method_modifier($_, $code) 
+                } for @_;
             });
         },
         after => sub {
             my $meta = _find_meta();
             return Class::MOP::subname('Moose::Role::after' => sub (@&) {
                 my $code = pop @_;
-                $meta->add_after_method_modifier($_, $code) for @_;
+                do {
+                    confess "Moose::Role do not currently support " 
+                          . ref($_) 
+                          . " references for after method modifiers" 
+                    if ref $_;                
+                    $meta->add_after_method_modifier($_, $code) 
+                } for @_;
             });
         },
         around => sub {
             my $meta = _find_meta();
             return Class::MOP::subname('Moose::Role::around' => sub (@&) {
                 my $code = pop @_;
-                $meta->add_around_method_modifier($_, $code) for @_;
+                do {
+                    confess "Moose::Role do not currently support " 
+                          . ref($_) 
+                          . " references for around method modifiers" 
+                    if ref $_;                
+                    $meta->add_around_method_modifier($_, $code) 
+                } for @_;  
             });
         },
         # see Moose.pm for discussion
         super => sub {
-            return Class::MOP::subname('Moose::Role::super' => sub { return unless $Moose::SUPER_BODY; $Moose::SUPER_BODY->(@Moose::SUPER_ARGS) })
+            return Class::MOP::subname('Moose::Role::super' => sub { 
+                return unless $Moose::SUPER_BODY; $Moose::SUPER_BODY->(@Moose::SUPER_ARGS) 
+            });
         },
-        #next => sub {
-        #    return subname 'Moose::Role::next' => sub { @_ = @Moose::SUPER_ARGS; goto \&next::method };
-        #},
         override => sub {
             my $meta = _find_meta();
             return Class::MOP::subname('Moose::Role::override' => sub ($&) {
diff --git a/t/010_basics/010_method_modifier_with_regexp.t b/t/010_basics/010_method_modifier_with_regexp.t
index d52f7f7..c57030b 100644
--- a/t/010_basics/010_method_modifier_with_regexp.t
+++ b/t/010_basics/010_method_modifier_with_regexp.t
@@ -4,6 +4,7 @@ use strict;
 use warnings;
 
 use Test::More tests => 10;
+use Test::Exception;
 
 BEGIN {
     use_ok('Moose');
@@ -24,14 +25,14 @@ BEGIN {
     }
 
     around qr/bark.*/ => sub {
-        'Dog::around';
+        'Dog::around(' . $_[0]->() . ')';
     };
 
 }
 
 my $dog = Dog->new;
-is( $dog->bark_once,  'Dog::around', 'around modifier is called' );
-is( $dog->bark_twice, 'Dog::around', 'around modifier is called' );
+is( $dog->bark_once,  'Dog::around(bark)', 'around modifier is called' );
+is( $dog->bark_twice, 'Dog::around(barkbark)', 'around modifier is called' );
 
 {
 
@@ -68,80 +69,20 @@ is( $Cat::BEFORE_BARK_COUNTER, 2, 'before modifier is called twice' );
 is( $Cat::AFTER_BARK_COUNTER,  2, 'after modifier is called twice' );
 
 {
+    package Dog::Role;
+    use Moose::Role;
 
-    package Animal;
-    use Moose;
-    our $BEFORE_BARK_COUNTER = 0;
-    our $AFTER_BARK_COUNTER  = 0;
-
-    sub bark_once {
-        my $self = shift;
-        return 'bark';
-    }
-
-    sub bark_twice {
-        return 'barkbark';
-    }
-
-    before qr/bark.*/ => sub {
-        $BEFORE_BARK_COUNTER++;
-    };
-
-    after qr/bark.*/ => sub {
-        $AFTER_BARK_COUNTER++;
-    };
-}
-
-{
-
-    package Cow;
-    use Moose;
-    extends 'Animal';
-
-    override 'bark_once' => sub {
-        my $self = shift;
-        super();
-        return 'cow';
-    };
-
-    override 'bark_twice' => sub {
-        super();        
-        return 'cowcow';
-    };
-}
-
-{
-    my $cow = Cow->new;
-    $cow->bark_once;
-    is( $Animal::BEFORE_BARK_COUNTER, 1,
-        'before modifier is called if method is overridden' );
-    is( $Animal::AFTER_BARK_COUNTER, 1,
-        'after modifier is called if method is overridden' );
-}
-
-{
+    ::dies_ok {
+        before qr/bark.*/ => sub {};
+    } '... this is not currently supported';
 
-    package MyDog;
-    use Moose;
-    our $BEFORE_BARK_COUNTER=0;
-    sub bark {
-        my $self = shift;
-        return 'bark';
-    }
+    ::dies_ok {
+        around qr/bark.*/ => sub {};
+    } '... this is not currently supported';    
     
-    sub bark_twice {
-        my $self = shift;
-        return 'barkbark';
-    }
-
-    before qw/bark bark_twice/ => sub {
-        $BEFORE_BARK_COUNTER++;
-    };
+    ::dies_ok {    
+        after  qr/bark.*/ => sub {};
+    } '... this is not currently supported';    
 
 }
 
-my $my_dog = MyDog->new;
-$my_dog->bark;
-$my_dog->bark_twice;
-is($MyDog::BEFORE_BARK_COUNTER, 2, "before method modifier is called twice");
-