From: Robert 'phaylon' Sedlacek <rs@474.at>
Date: Tue, 7 Aug 2007 22:06:33 +0000 (+0000)
Subject: Added search_class_by_role to Moose::Util
X-Git-Tag: 0_25~11
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1631b53f3cecc6033043b6e4bf858113e0054b7a;p=gitmo%2FMoose.git

Added search_class_by_role to Moose::Util
---

diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index 904ecd4..ef9646d 100644
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -10,7 +10,7 @@ our $VERSION = '0.01';
 
 our $AUTHORITY = 'cpan:BERLE';
 
-our @EXPORT_OK = qw/can_role/;
+our @EXPORT_OK = qw/can_role search_class_by_role/;
 
 sub can_role {
   my ($class,$does) = @_;
@@ -20,6 +20,18 @@ sub can_role {
     && $class->does ($does);
 }
 
+sub search_class_by_role {
+    my ($obj, $role_name) = @_;
+
+    for my $class ($obj->meta->class_precedence_list) {
+        for my $role (@{ $class->meta->roles || [] }) {
+            return $class if $role->name eq $role_name;
+        }
+    }
+
+    return undef;
+}
+
 1;
 
 __END__
@@ -32,12 +44,15 @@ Moose::Util - Moose utilities
 
 =head1 SYNOPSIS
 
-  use Moose::Util qw/can_role/;
+  use Moose::Util qw/can_role search_class_by_role/;
 
   if (can_role ($object,'rolename')) {
     print "The object can do rolename!\n";
   }
 
+  my $class = search_class_by_role($object, 'FooRole');
+  print "Nearest class with 'FooRole' is $class\n";
+
 =head1 FUNCTIONS
 
 =over 4
@@ -48,6 +63,12 @@ Moose::Util - Moose utilities
 
 Returns true if $object can do the role $rolename.
 
+=item search_class_by_role
+
+  my $class = search_class_by_role($object, $rolename);
+
+Returns first class in precedence list that consumed C<$rolename>.
+
 =back
 
 =head1 BUGS