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;
211 my $level = @_ ? ($_[0] + 1) : 2;
213 @info{qw(package file line)} = caller($level);
225 Moose::Util - Utilities for working with Moose classes
229 use Moose::Util qw/find_meta does_role search_class_by_role/;
231 my $meta = find_meta($object) || die "No metaclass found";
233 if (does_role($object, $role)) {
234 print "The object can do $role!\n";
237 my $class = search_class_by_role($object, 'FooRole');
238 print "Nearest class with 'FooRole' is $class\n";
242 This module provides a set of utility functions. Many of these
243 functions are intended for use in Moose itself or MooseX modules, but
244 some of them may be useful for use in your own code.
246 =head1 EXPORTED FUNCTIONS
250 =item B<find_meta($class_or_obj)>
252 This method takes a class name or object and attempts to find a
253 metaclass for the class, if one exists. It will B<not> create one if it
256 =item B<does_role($class_or_obj, $role_name)>
258 Returns true if C<$class_or_obj> does the given C<$role_name>.
260 The class must already have a metaclass for this to work.
262 =item B<search_class_by_role($class_or_obj, $role_name)>
264 Returns the first class in the class's precedence list that does
265 C<$role_name>, if any.
267 The class must already have a metaclass for this to work.
269 =item B<apply_all_roles($applicant, @roles)>
271 This function applies one or more roles to the given C<$applicant> The
272 applicant can be a role name, class name, or object.
274 The C<$applicant> must already have a metaclass object.
276 The list of C<@roles> should be a list of names, each of which can be
277 followed by an optional hash reference of options (C<exclude> and
280 =item B<ensure_all_roles($applicant, @roles)>
282 This function is similar to L</apply_all_roles>, but only applies roles that
283 C<$applicant> does not already consume.
285 =item B<get_all_attribute_values($meta, $instance)>
287 Returns a hash reference containing all of the C<$instance>'s
288 attributes. The keys are attribute names.
290 =item B<get_all_init_args($meta, $instance)>
292 Returns a hash reference containing all of the C<init_arg> values for
293 the instance's attributes. The values are the associated attribute
294 values. If an attribute does not have a defined C<init_arg>, it is
297 This could be useful in cloning an object.
299 =item B<resolve_metaclass_alias($category, $name, %options)>
301 =item B<resolve_metatrait_alias($category, $name, %options)>
303 Resolves a short name to a full class name. Short names are often used
304 when specifying the C<metaclass> or C<traits> option for an attribute:
310 The name resolution mechanism is covered in L<Moose/Trait Name
313 =item B<english_list(@items)>
315 Given a list of scalars, turns them into a proper list in English
316 ("one and two", "one, two, three, and four"). This is used to help us
317 make nicer error messages.
323 Here is a list of possible functions to write
327 =item discovering original method from modified method
329 =item search for origin class of a method or attribute
335 All complex software has bugs lurking in it, and this module is no
336 exception. If you find a bug please either email me, or add the bug
341 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
343 B<with contributions from:>
345 Robert (phaylon) Sedlacek
349 =head1 COPYRIGHT AND LICENSE
351 Copyright 2007-2009 by Infinity Interactive, Inc.
353 L<http://www.iinteractive.com>
355 This library is free software; you can redistribute it and/or modify
356 it under the same terms as Perl itself.