3 use Exporter qw/import/;
11 our $AUTHORITY = 'cpan:BERLE';
13 our @EXPORT_OK = qw/does_role search_class_by_role/;
16 my ($class, $role) = @_;
18 return unless defined $class;
20 my $meta = Class::MOP::get_metaclass_by_name (ref $class || $class);
22 return unless defined $meta;
24 return $meta->does_role ($role);
27 sub search_class_by_role {
28 my ($obj, $role_name) = @_;
30 for my $class ($obj->meta->class_precedence_list) {
31 for my $role (@{ $class->meta->roles || [] }) {
32 return $class if $role->name eq $role_name;
47 Moose::Util - Moose utilities
51 use Moose::Util qw/does_role search_class_by_role/;
53 if (does_role($object, $role)) {
54 print "The object can do $role!\n";
57 my $class = search_class_by_role($object, 'FooRole');
58 print "Nearest class with 'FooRole' is $class\n";
66 does_role($object, $rolename);
68 Returns true if $object can do the role $rolename.
70 =item search_class_by_role
72 my $class = search_class_by_role($object, $rolename);
74 Returns first class in precedence list that consumed C<$rolename>.
80 All complex software has bugs lurking in it, and this module is no
81 exception. If you find a bug please either email me, or add the bug
86 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
88 =head1 COPYRIGHT AND LICENSE
90 Copyright 2007 by Infinity Interactive, Inc.
92 L<http://www.iinteractive.com>
94 This library is free software; you can redistribute it and/or modify
95 it under the same terms as Perl itself.