8 use Scalar::Util 'blessed';
11 our $VERSION = '0.88';
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, undef, @_);
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 if ( defined $role_filter ) {
109 @$roles = grep { local $_ = $_->[0]; $role_filter->() } @$roles;
112 return unless @$roles;
114 my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
116 if ( scalar @$roles == 1 ) {
117 my ( $role, $params ) = @{ $roles->[0] };
118 my $role_meta = Class::MOP::class_of($role);
119 $role_meta->apply( $meta, ( defined $params ? %$params : () ) );
122 Moose::Meta::Role->combine( @$roles )->apply($meta);
126 # instance deconstruction ...
128 sub get_all_attribute_values {
129 my ($class, $instance) = @_;
131 map { $_->name => $_->get_value($instance) }
132 grep { $_->has_value($instance) }
133 $class->get_all_attributes
137 sub get_all_init_args {
138 my ($class, $instance) = @_;
140 map { $_->init_arg => $_->get_value($instance) }
141 grep { $_->has_value($instance) }
142 grep { defined($_->init_arg) }
143 $class->get_all_attributes
147 sub resolve_metatrait_alias {
148 return resolve_metaclass_alias( @_, trait => 1 );
154 sub resolve_metaclass_alias {
155 my ( $type, $metaclass_name, %options ) = @_;
157 my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );
158 return $cache{$cache_key}{$metaclass_name}
159 if $cache{$cache_key}{$metaclass_name};
161 my $possible_full_name
165 . ( $options{trait} ? "Trait::" : "" )
168 my $loaded_class = Class::MOP::load_first_existing_class(
173 return $cache{$cache_key}{$metaclass_name}
174 = $loaded_class->can('register_implementation')
175 ? $loaded_class->register_implementation
180 sub add_method_modifier {
181 my ( $class_or_obj, $modifier_name, $args ) = @_;
182 my $meta = find_meta($class_or_obj);
183 my $code = pop @{$args};
184 my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier';
185 if ( my $method_modifier_type = ref( @{$args}[0] ) ) {
186 if ( $method_modifier_type eq 'Regexp' ) {
187 my @all_methods = $meta->get_all_methods;
189 = grep { $_->name =~ @{$args}[0] } @all_methods;
190 $meta->$add_modifier_method( $_->name, $code )
191 for @matched_methods;
195 $meta->$add_modifier_method( $_, $code ) for @{$args};
202 return $items[0] if @items == 1;
203 return "$items[0] and $items[1]" if @items == 2;
205 my $tail = pop @items;
206 my $list = join ', ', @items;
207 $list .= ', and ' . $tail;
213 my $level = @_ ? ($_[0] + 1) : 2;
215 @info{qw(package file line)} = caller($level);
227 Moose::Util - Utilities for working with Moose classes
231 use Moose::Util qw/find_meta does_role search_class_by_role/;
233 my $meta = find_meta($object) || die "No metaclass found";
235 if (does_role($object, $role)) {
236 print "The object can do $role!\n";
239 my $class = search_class_by_role($object, 'FooRole');
240 print "Nearest class with 'FooRole' is $class\n";
244 This module provides a set of utility functions. Many of these
245 functions are intended for use in Moose itself or MooseX modules, but
246 some of them may be useful for use in your own code.
248 =head1 EXPORTED FUNCTIONS
252 =item B<find_meta($class_or_obj)>
254 This method takes a class name or object and attempts to find a
255 metaclass for the class, if one exists. It will B<not> create one if it
258 =item B<does_role($class_or_obj, $role_name)>
260 Returns true if C<$class_or_obj> does the given C<$role_name>.
262 The class must already have a metaclass for this to work.
264 =item B<search_class_by_role($class_or_obj, $role_name)>
266 Returns the first class in the class's precedence list that does
267 C<$role_name>, if any.
269 The class must already have a metaclass for this to work.
271 =item B<apply_all_roles($applicant, @roles)>
273 This function applies one or more roles to the given C<$applicant> The
274 applicant can be a role name, class name, or object.
276 The C<$applicant> must already have a metaclass object.
278 The list of C<@roles> should be a list of names, each of which can be
279 followed by an optional hash reference of options (C<excludes> and
282 =item B<ensure_all_roles($applicant, @roles)>
284 This function is similar to L</apply_all_roles>, but only applies roles that
285 C<$applicant> does not already consume.
287 =item B<get_all_attribute_values($meta, $instance)>
289 Returns a hash reference containing all of the C<$instance>'s
290 attributes. The keys are attribute names.
292 =item B<get_all_init_args($meta, $instance)>
294 Returns a hash reference containing all of the C<init_arg> values for
295 the instance's attributes. The values are the associated attribute
296 values. If an attribute does not have a defined C<init_arg>, it is
299 This could be useful in cloning an object.
301 =item B<resolve_metaclass_alias($category, $name, %options)>
303 =item B<resolve_metatrait_alias($category, $name, %options)>
305 Resolves a short name to a full class name. Short names are often used
306 when specifying the C<metaclass> or C<traits> option for an attribute:
312 The name resolution mechanism is covered in L<Moose/Trait Name
315 =item B<english_list(@items)>
317 Given a list of scalars, turns them into a proper list in English
318 ("one and two", "one, two, three, and four"). This is used to help us
319 make nicer error messages.
325 Here is a list of possible functions to write
329 =item discovering original method from modified method
331 =item search for origin class of a method or attribute
337 All complex software has bugs lurking in it, and this module is no
338 exception. If you find a bug please either email me, or add the bug
343 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
345 B<with contributions from:>
347 Robert (phaylon) Sedlacek
351 =head1 COPYRIGHT AND LICENSE
353 Copyright 2007-2009 by Infinity Interactive, Inc.
355 L<http://www.iinteractive.com>
357 This library is free software; you can redistribute it and/or modify
358 it under the same terms as Perl itself.