From: Jesse Luehrs <doy@tozt.net>
Date: Sat, 19 Dec 2009 21:41:57 +0000 (-0600)
Subject: add ->consumers method to role metaclass
X-Git-Tag: 1.04~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c23885b15542f08dc8036433e91ef80f04c78a60;p=gitmo%2FMoose.git

add ->consumers method to role metaclass
---

diff --git a/Changes b/Changes
index eff16cc..bffbc4e 100644
--- a/Changes
+++ b/Changes
@@ -15,6 +15,9 @@ for, noteworthy changes.
   * strict and warnings are now unimported when Moose, Moose::Role, or
     Moose::Exporter are unimported. (doy, Adam Kennedy)
 
+  * Added a 'consumers' method to Moose::Meta::Role for finding all
+    classes/roles which consume the given role. (doy)
+
   [BUG FIXES]
 
   * Fix has '+attr' in Roles to explode immediately, rather than when the role
diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index 27dc2eb..2755033 100644
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -506,6 +506,19 @@ sub create {
     return $meta;
 }
 
+sub consumers {
+    my $self = shift;
+    my @consumers;
+    for my $meta (Class::MOP::get_all_metaclass_instances) {
+        next if $meta->name eq $self->name;
+        next unless $meta->isa('Moose::Meta::Class')
+                 || $meta->isa('Moose::Meta::Role');
+        push @consumers, $meta->name
+            if $meta->does_role($self->name);
+    }
+    return @consumers;
+}
+
 # anonymous roles. most of it is copied straight out of Class::MOP::Class.
 # an intrepid hacker might find great riches if he unifies this code with that
 # code in Class::MOP::Module or Class::MOP::Package
@@ -740,6 +753,10 @@ C<create_anon_class> method.
 
 Returns true if the role is an anonymous role.
 
+=item B<< $metarole->consumers >>
+
+Returns a list of names of classes and roles which consume this role.
+
 =back
 
 =head2 Role application
diff --git a/t/030_roles/044_role_consumers.t b/t/030_roles/044_role_consumers.t
new file mode 100644
index 0000000..225d032
--- /dev/null
+++ b/t/030_roles/044_role_consumers.t
@@ -0,0 +1,52 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+{
+    package Foo::Role;
+    use Moose::Role;
+}
+
+{
+    package Bar::Role;
+    use Moose::Role;
+}
+
+{
+    package Foo;
+    use Moose;
+    with 'Foo::Role';
+}
+
+{
+    package Bar;
+    use Moose;
+    extends 'Foo';
+    with 'Bar::Role';
+}
+
+{
+    package FooBar;
+    use Moose;
+    with 'Foo::Role', 'Bar::Role';
+}
+
+{
+    package Foo::Role::User;
+    use Moose::Role;
+    with 'Foo::Role';
+}
+
+{
+    package Foo::User;
+    use Moose;
+    with 'Foo::Role::User';
+}
+
+is_deeply([sort Foo::Role->meta->consumers],
+          ['Bar', 'Foo', 'Foo::Role::User', 'Foo::User', 'FooBar']);
+is_deeply([sort Bar::Role->meta->consumers],
+          ['Bar', 'FooBar']);
+is_deeply([sort Foo::Role::User->meta->consumers],
+          ['Foo::User']);