8 use Scalar::Util 'blessed';
11 our $VERSION = '0.83';
12 $VERSION = eval $VERSION;
13 our $AUTHORITY = 'cpan:STEVAN';
22 get_all_attribute_values
23 resolve_metatrait_alias
24 resolve_metaclass_alias
29 Sub::Exporter::setup_exporter({
31 groups => { all => \@exports }
34 ## some utils for the utils ...
36 sub find_meta { Class::MOP::class_of(@_) }
41 my ($class_or_obj, $role) = @_;
43 my $meta = find_meta($class_or_obj);
45 return unless defined $meta;
46 return unless $meta->can('does_role');
47 return 1 if $meta->does_role($role);
51 sub search_class_by_role {
52 my ($class_or_obj, $role_name) = @_;
54 my $meta = find_meta($class_or_obj);
56 return unless defined $meta;
58 foreach my $class ($meta->class_precedence_list) {
60 my $_meta = find_meta($class);
62 next unless defined $_meta;
64 foreach my $role (@{ $_meta->roles || [] }) {
65 return $class if $role->name eq $role_name;
72 # this can possibly behave in unexpected ways because the roles being composed
73 # before being applied could differ from call to call; I'm not sure if or how
74 # to document this possible quirk.
75 sub ensure_all_roles {
76 my $applicant = shift;
77 _apply_all_roles($applicant, sub { !does_role($applicant, $_) }, @_);
81 my $applicant = shift;
82 _apply_all_roles($applicant, sub { 1 }, @_);
85 sub _apply_all_roles {
86 my $applicant = shift;
87 my $role_filter = shift;
91 Moose->throw_error("Must specify at least one role to apply to $applicant");
94 my $roles = Data::OptList::mkopt( [@_] );
96 foreach my $role (@$roles) {
97 Class::MOP::load_class( $role->[0] );
98 my $meta = Class::MOP::class_of( $role->[0] );
100 unless ($meta && $meta->isa('Moose::Meta::Role') ) {
102 Moose->throw_error( "You can only consume roles, "
104 . " is not a Moose role" );
108 @$roles = grep { local $_ = $_->[0]; $role_filter->() } @$roles;
110 return unless @$roles;
112 my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
114 if ( scalar @$roles == 1 ) {
115 my ( $role, $params ) = @{ $roles->[0] };
116 my $role_meta = Class::MOP::class_of($role);
117 $role_meta->apply( $meta, ( defined $params ? %$params : () ) );
120 Moose::Meta::Role->combine( @$roles )->apply($meta);
124 # instance deconstruction ...
126 sub get_all_attribute_values {
127 my ($class, $instance) = @_;
129 map { $_->name => $_->get_value($instance) }
130 grep { $_->has_value($instance) }
131 $class->get_all_attributes
135 sub get_all_init_args {
136 my ($class, $instance) = @_;
138 map { $_->init_arg => $_->get_value($instance) }
139 grep { $_->has_value($instance) }
140 grep { defined($_->init_arg) }
141 $class->get_all_attributes
145 sub resolve_metatrait_alias {
146 return resolve_metaclass_alias( @_, trait => 1 );
152 sub resolve_metaclass_alias {
153 my ( $type, $metaclass_name, %options ) = @_;
155 my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );
156 return $cache{$cache_key}{$metaclass_name}
157 if $cache{$cache_key}{$metaclass_name};
159 my $possible_full_name
163 . ( $options{trait} ? "Trait::" : "" )
166 my $loaded_class = Class::MOP::load_first_existing_class(
171 return $cache{$cache_key}{$metaclass_name}
172 = $loaded_class->can('register_implementation')
173 ? $loaded_class->register_implementation
178 sub add_method_modifier {
179 my ( $class_or_obj, $modifier_name, $args ) = @_;
180 my $meta = find_meta($class_or_obj);
181 my $code = pop @{$args};
182 my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier';
183 if ( my $method_modifier_type = ref( @{$args}[0] ) ) {
184 if ( $method_modifier_type eq 'Regexp' ) {
185 my @all_methods = $meta->get_all_methods;
187 = grep { $_->name =~ @{$args}[0] } @all_methods;
188 $meta->$add_modifier_method( $_->name, $code )
189 for @matched_methods;
193 $meta->$add_modifier_method( $_, $code ) for @{$args};
200 return $items[0] if @items == 1;
201 return "$items[0] and $items[1]" if @items == 2;
203 my $tail = pop @items;
204 my $list = join ', ', @items;
205 $list .= ', and ' . $tail;
218 Moose::Util - Utilities for working with Moose classes
222 use Moose::Util qw/find_meta does_role search_class_by_role/;
224 my $meta = find_meta($object) || die "No metaclass found";
226 if (does_role($object, $role)) {
227 print "The object can do $role!\n";
230 my $class = search_class_by_role($object, 'FooRole');
231 print "Nearest class with 'FooRole' is $class\n";
235 This module provides a set of utility functions. Many of these
236 functions are intended for use in Moose itself or MooseX modules, but
237 some of them may be useful for use in your own code.
239 =head1 EXPORTED FUNCTIONS
243 =item B<find_meta($class_or_obj)>
245 This method takes a class name or object and attempts to find a
246 metaclass for the class, if one exists. It will B<not> create one if it
249 =item B<does_role($class_or_obj, $role_name)>
251 Returns true if C<$class_or_obj> does the given C<$role_name>.
253 The class must already have a metaclass for this to work.
255 =item B<search_class_by_role($class_or_obj, $role_name)>
257 Returns the first class in the class's precedence list that does
258 C<$role_name>, if any.
260 The class must already have a metaclass for this to work.
262 =item B<apply_all_roles($applicant, @roles)>
264 This function applies one or more roles to the given C<$applicant> The
265 applicant can be a role name, class name, or object.
267 The C<$applicant> must already have a metaclass object.
269 The list of C<@roles> should be a list of names, each of which can be
270 followed by an optional hash reference of options (C<exclude> and
273 =item B<ensure_all_roles($applicant, @roles)>
275 This function is similar to L</apply_all_roles>, but only applies roles that
276 C<$applicant> does not already consume.
278 =item B<get_all_attribute_values($meta, $instance)>
280 Returns a hash reference containing all of the C<$instance>'s
281 attributes. The keys are attribute names.
283 =item B<get_all_init_args($meta, $instance)>
285 Returns a hash reference containing all of the C<init_arg> values for
286 the instance's attributes. The values are the associated attribute
287 values. If an attribute does not have a defined C<init_arg>, it is
290 This could be useful in cloning an object.
292 =item B<resolve_metaclass_alias($category, $name, %options)>
294 =item B<resolve_metatrait_alias($category, $name, %options)>
296 Resolves a short name to a full class name. Short names are often used
297 when specifying the C<metaclass> or C<traits> option for an attribute:
303 The name resolution mechanism is covered in L<Moose/Trait Name
306 =item B<english_list(@items)>
308 Given a list of scalars, turns them into a proper list in English
309 ("one and two", "one, two, three, and four"). This is used to help us
310 make nicer error messages.
316 Here is a list of possible functions to write
320 =item discovering original method from modified method
322 =item search for origin class of a method or attribute
328 All complex software has bugs lurking in it, and this module is no
329 exception. If you find a bug please either email me, or add the bug
334 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
336 B<with contributions from:>
338 Robert (phaylon) Sedlacek
342 =head1 COPYRIGHT AND LICENSE
344 Copyright 2007-2009 by Infinity Interactive, Inc.
346 L<http://www.iinteractive.com>
348 This library is free software; you can redistribute it and/or modify
349 it under the same terms as Perl itself.