updating copyright dates
[gitmo/Moose.git] / lib / Moose / Util.pm
1 package Moose::Util;
2
3 use strict;
4 use warnings;
5
6 use Sub::Exporter;
7 use Scalar::Util ();
8 use Class::MOP   ();
9
10 our $VERSION   = '0.01';
11 our $AUTHORITY = 'cpan:STEVAN';
12
13 my @exports = qw[
14     find_meta 
15     does_role
16     search_class_by_role   
17 ];
18
19 Sub::Exporter::setup_exporter({
20     exports => \@exports,
21     groups  => { all => \@exports }
22 });
23
24 ## some utils for the utils ...
25
26 sub find_meta { 
27     return unless $_[0];
28     return Class::MOP::get_metaclass_by_name(ref($_[0]) || $_[0]);
29 }
30
31 ## the functions ...
32
33 sub does_role {
34     my ($class_or_obj, $role) = @_;
35
36     my $meta = find_meta($class_or_obj);
37     
38     return unless defined $meta;
39
40     return 1 if $meta->does_role($role);
41     return;
42 }
43
44 sub search_class_by_role {
45     my ($class_or_obj, $role_name) = @_;
46     
47     my $meta = find_meta($class_or_obj);
48
49     return unless defined $meta;
50
51     foreach my $class ($meta->class_precedence_list) {
52         
53         my $_meta = find_meta($class);        
54
55         next unless defined $_meta;
56
57         foreach my $role (@{ $_meta->roles || [] }) {
58             return $class if $role->name eq $role_name;
59         }
60     }
61
62     return;
63 }
64
65 1;
66
67 __END__
68
69 =pod
70
71 =head1 NAME
72
73 Moose::Util - Utilities for working with Moose classes
74
75 =head1 SYNOPSIS
76
77   use Moose::Util qw/find_meta does_role search_class_by_role/;
78
79   my $meta = find_meta($object) || die "No metaclass found";
80
81   if (does_role($object, $role)) {
82     print "The object can do $role!\n";
83   }
84
85   my $class = search_class_by_role($object, 'FooRole');
86   print "Nearest class with 'FooRole' is $class\n";
87
88 =head1 DESCRIPTION
89
90 This is a set of utility functions to help working with Moose classes. This 
91 is an experimental module, and it's not 100% clear what purpose it will serve. 
92 That said, ideas, suggestions and contributions to this collection are most 
93 welcome. See the L<TODO> section below for a list of ideas for possible 
94 functions to write.
95
96 =head1 EXPORTED FUNCTIONS
97
98 =over 4
99
100 =item B<find_meta ($class_or_obj)>
101
102 This will attempt to locate a metaclass for the given C<$class_or_obj>
103 and return it.
104
105 =item B<does_role ($class_or_obj, $role_name)>
106
107 Returns true if C<$class_or_obj> can do the role C<$role_name>.
108
109 =item B<search_class_by_role ($class_or_obj, $role_name)>
110
111 Returns first class in precedence list that consumed C<$role_name>.
112
113 =back
114
115 =head1 TODO
116
117 Here is a list of possible functions to write
118
119 =over 4
120
121 =item discovering original method from modified method
122
123 =item search for origin class of a method or attribute
124
125 =back
126
127 =head1 BUGS
128
129 All complex software has bugs lurking in it, and this module is no 
130 exception. If you find a bug please either email me, or add the bug
131 to cpan-RT.
132
133 =head1 AUTHOR
134
135 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
136
137 B<with contributions from:>
138
139 Robert (phaylon) Sedlacek
140
141 Stevan Little
142
143 =head1 COPYRIGHT AND LICENSE
144
145 Copyright 2007-2008 by Infinity Interactive, Inc.
146
147 L<http://www.iinteractive.com>
148
149 This library is free software; you can redistribute it and/or modify
150 it under the same terms as Perl itself. 
151
152 =cut
153