From: Hans Dieter Pearcey <hdp@weftsoar.net>
Date: Wed, 15 Apr 2009 17:36:22 +0000 (-0400)
Subject: add ensure_all_roles()
X-Git-Tag: 0.75~13
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b099a649f0b1ad09f15956cd0efd7b3fd50d4070;p=gitmo%2FMoose.git

add ensure_all_roles()
---

diff --git a/Changes b/Changes
index de106b7..051c658 100644
--- a/Changes
+++ b/Changes
@@ -7,6 +7,10 @@ for, noteworthy changes.
       - Move validation of not inheriting from roles from Moose::extends to
         Moose::Meta::Class::superclasses (doy)
 
+    * Moose::Util
+      - add ensure_all_roles() function to encapsulate the common "apply this
+        role unless the object already does it" pattern (hdp)
+
 0.74 Tue, April 7, 2009
     * Moose::Meta::Role
     * Moose::Meta::Method::Destructor
diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index f745f10..25f08eb 100644
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -15,6 +15,7 @@ my @exports = qw[
     find_meta 
     does_role
     search_class_by_role   
+    ensure_all_roles
     apply_all_roles
     get_all_init_args
     get_all_attribute_values
@@ -67,8 +68,22 @@ sub search_class_by_role {
     return;
 }
 
+# this can possibly behave in unexpected ways because the roles being composed
+# before being applied could differ from call to call; I'm not sure if or how
+# to document this possible quirk.
+sub ensure_all_roles {
+    my $applicant = shift;
+    _apply_all_roles($applicant, sub { !does_role($applicant, $_) }, @_);
+}
+
 sub apply_all_roles {
     my $applicant = shift;
+    _apply_all_roles($applicant, sub { 1 }, @_);
+}
+
+sub _apply_all_roles {
+    my $applicant = shift;
+    my $role_filter = shift;
 
     unless (@_) {
         require Moose;
@@ -88,6 +103,10 @@ sub apply_all_roles {
         }
     }
 
+    @$roles = grep { local $_ = $_->[0]; $role_filter->() } @$roles;
+
+    return unless @$roles;
+
     my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
 
     if ( scalar @$roles == 1 ) {
@@ -249,6 +268,11 @@ The list of C<@roles> should be a list of names, each of which can be
 followed by an optional hash reference of options (C<exclude> and
 C<alias>).
 
+=item B<ensure_all_roles($applicant, @roles)>
+
+This function is similar to L</apply_all_roles>, but only applies roles that
+C<$applicant> does not already consume.
+
 =item B<get_all_attribute_values($meta, $instance)>
 
 Returns a hash reference containing all of the C<$instance>'s
diff --git a/t/400_moose_util/005_ensure_all_roles.t b/t/400_moose_util/005_ensure_all_roles.t
new file mode 100644
index 0000000..f72b2c5
--- /dev/null
+++ b/t/400_moose_util/005_ensure_all_roles.t
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+BEGIN {
+    use_ok('Moose::Util', ':all');
+}
+
+{
+    package Foo;
+    use Moose::Role;
+}
+
+{
+    package Bar;
+    use Moose::Role;
+}
+
+{
+    package Quux;
+    use Moose;
+}
+
+is_deeply(
+    Quux->meta->roles,
+    [],
+    "no roles yet",
+);
+
+Foo->meta->apply(Quux->meta);
+
+is_deeply(
+    Quux->meta->roles,
+    [ Foo->meta ],
+    "applied Foo",
+);
+
+Foo->meta->apply(Quux->meta);
+Bar->meta->apply(Quux->meta);
+is_deeply(
+    Quux->meta->roles,
+    [ Foo->meta, Foo->meta, Bar->meta ],
+    "duplicated Foo",
+);
+
+is(does_role('Quux', 'Foo'), 1, "Quux does Foo");
+is(does_role('Quux', 'Bar'), 1, "Quux does Bar");
+ensure_all_roles('Quux', qw(Foo Bar));
+is_deeply(
+    Quux->meta->roles,
+    [ Foo->meta, Foo->meta, Bar->meta ],
+    "unchanged, since all roles are already applied",
+);
+
+my $obj = Quux->new;
+ensure_all_roles($obj, qw(Foo Bar));
+is_deeply(
+    $obj->meta->roles,
+    [ Foo->meta, Foo->meta, Bar->meta ],
+    "unchanged, since all roles are already applied",
+);