From: Dave Rolsky <autarch@urth.org>
Date: Mon, 28 Jul 2008 13:19:10 +0000 (+0000)
Subject: Moved most of Moose::Util::apply_all_roles to
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0a6e4a3afc73b2709dc592f77f5ba5b0e8a21754;p=gitmo%2FMoose.git

Moved most of Moose::Util::apply_all_roles to
apply_all_roles_with_method, to allow us to apply roles to a metaclass
instance easily.

Multiple metaclass traits are now applied as a composite role, just
like attribute traits.

Added tests for applying >1 metaclass trait.
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index fed5941..5c7655f 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -194,13 +194,13 @@ use Moose::Util ();
     sub _strip_traits {
         my $idx = first_index { $_ eq '-traits' } @_;
 
-        return unless $idx && $#_ >= $idx + 1;
+        return (undef, @_) unless $idx >= 0 && $#_ >= $idx + 1;
 
         my $traits = $_[ $idx + 1 ];
 
         splice @_, $idx, 2;
 
-        return ( $traits, @_ )
+        return ($traits, @_);
     }
 
     # 1 extra level because it's called by import so there's a layer of indirection
@@ -220,17 +220,17 @@ use Moose::Util ();
         return
             unless $traits && @$traits;
 
-        if ( @$traits == 1 ) {
-            $traits->[0]->meta()->apply_to_metaclass_instance( $class->meta() );
-        } else {
-            Moose::Meta::Role->combine(@$traits)
-                ->apply_to_metaclass_instance( $class->meta() );
-        }
+        my $meta = $class->meta();
+
+        Moose::Util::apply_all_roles_with_method($meta, 'apply_to_metaclass_instance', $traits);
     }
 
     sub import {
+        # This is a bit gross, but it's necessary for backwards
+        # compatibility, so that _get_caller() sees the arguments in
+        # the right order.
         my $traits;
-        ( $traits, @_ ) = _strip_traits(@_);
+        ($traits, @_) = _strip_traits(@_);
 
         $CALLER = _get_caller(@_);
 
diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index 0812832..52c2f2c 100644
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -71,33 +71,36 @@ sub search_class_by_role {
 
 sub apply_all_roles {
     my $applicant = shift;
-    
-    confess "Must specify at least one role to apply to $applicant" unless @_;
-    
-    my $roles = Data::OptList::mkopt([ @_ ]);
-    
-    #use Data::Dumper;
-    #warn Dumper $roles;
-    
+
+    apply_all_roles_with_method( $applicant, 'apply', [@_] );
+}
+
+sub apply_all_roles_with_method {
+    my ($applicant, $apply_method, $role_list) = @_;
+
+    confess "Must specify at least one role to apply to $applicant" unless @$role_list;
+
+    my $roles = Data::OptList::mkopt($role_list);
+
     my $meta = (blessed $applicant ? $applicant : find_meta($applicant));
-    
+
     foreach my $role_spec (@$roles) {
         Class::MOP::load_class($role_spec->[0]);
     }
-    
+
     ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role'))
         || confess "You can only consume roles, " . $_->[0] . " is not a Moose role"
             foreach @$roles;
 
     if (scalar @$roles == 1) {
         my ($role, $params) = @{$roles->[0]};
-        $role->meta->apply($meta, (defined $params ? %$params : ()));
+        $role->meta->$apply_method($meta, (defined $params ? %$params : ()));
     }
     else {
         Moose::Meta::Role->combine(
             @$roles
-        )->apply($meta);
-    }    
+        )->$apply_method($meta);
+    }
 }
 
 # instance deconstruction ...
diff --git a/t/050_metaclasses/012_metaclass_traits.t b/t/050_metaclasses/012_metaclass_traits.t
index 505ffbe..dbcc55f 100644
--- a/t/050_metaclasses/012_metaclass_traits.t
+++ b/t/050_metaclasses/012_metaclass_traits.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6;
+use Test::More 'no_plan';
 
 {
     package My::SimpleTrait;
@@ -52,3 +52,40 @@ is( Bar->meta()->simple(), 5,
 can_ok( Bar->meta(), 'attr' );
 is( Bar->meta()->attr(), 'something',
     'Bar->meta()->attr() returns expected value' );
+
+{
+    package My::SimpleTrait3;
+
+    use Moose::Role;
+
+    # This needs to happen at begin time so it happens before we apply
+    # traits to Bar
+    BEGIN {
+        has 'attr2' =>
+            ( is      => 'ro',
+              default => 'something',
+            );
+    }
+
+    sub simple2 { return 55 }
+}
+
+
+{
+    package Baz;
+
+    use Moose -traits => [ 'My::SimpleTrait2', 'My::SimpleTrait3' ];
+}
+
+can_ok( Baz->meta(), 'simple' );
+is( Baz->meta()->simple(), 5,
+    'Baz->meta()->simple() returns expected value' );
+can_ok( Baz->meta(), 'attr' );
+is( Baz->meta()->attr(), 'something',
+    'Baz->meta()->attr() returns expected value' );
+can_ok( Baz->meta(), 'simple2' );
+is( Baz->meta()->simple2(), 55,
+    'Baz->meta()->simple2() returns expected value' );
+can_ok( Baz->meta(), 'attr2' );
+is( Baz->meta()->attr2(), 'something',
+    'Baz->meta()->attr2() returns expected value' );