8 use Scalar::Util 'blessed';
11 our $VERSION = '0.77';
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 my $meta = Class::MOP::load_class( $role->[0] );
99 unless ($meta->isa('Moose::Meta::Role') ) {
101 Moose->throw_error( "You can only consume roles, "
103 . " is not a Moose role" );
107 @$roles = grep { local $_ = $_->[0]; $role_filter->() } @$roles;
109 return unless @$roles;
111 my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
113 if ( scalar @$roles == 1 ) {
114 my ( $role, $params ) = @{ $roles->[0] };
115 my $role_meta = Class::MOP::class_of($role);
116 $role_meta->apply( $meta, ( defined $params ? %$params : () ) );
119 Moose::Meta::Role->combine( @$roles )->apply($meta);
123 # instance deconstruction ...
125 sub get_all_attribute_values {
126 my ($class, $instance) = @_;
128 map { $_->name => $_->get_value($instance) }
129 grep { $_->has_value($instance) }
130 $class->get_all_attributes
134 sub get_all_init_args {
135 my ($class, $instance) = @_;
137 map { $_->init_arg => $_->get_value($instance) }
138 grep { $_->has_value($instance) }
139 grep { defined($_->init_arg) }
140 $class->get_all_attributes
144 sub resolve_metatrait_alias {
145 return resolve_metaclass_alias( @_, trait => 1 );
151 sub resolve_metaclass_alias {
152 my ( $type, $metaclass_name, %options ) = @_;
154 my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );
155 return $cache{$cache_key}{$metaclass_name}
156 if $cache{$cache_key}{$metaclass_name};
158 my $possible_full_name
162 . ( $options{trait} ? "Trait::" : "" )
165 my $loaded_class = Class::MOP::load_first_existing_class(
170 return $cache{$cache_key}{$metaclass_name}
171 = $loaded_class->can('register_implementation')
172 ? $loaded_class->register_implementation
177 sub add_method_modifier {
178 my ( $class_or_obj, $modifier_name, $args ) = @_;
179 my $meta = find_meta($class_or_obj);
180 my $code = pop @{$args};
181 my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier';
182 if ( my $method_modifier_type = ref( @{$args}[0] ) ) {
183 if ( $method_modifier_type eq 'Regexp' ) {
184 my @all_methods = $meta->get_all_methods;
186 = grep { $_->name =~ @{$args}[0] } @all_methods;
187 $meta->$add_modifier_method( $_->name, $code )
188 for @matched_methods;
192 $meta->$add_modifier_method( $_, $code ) for @{$args};
199 return $items[0] if @items == 1;
200 return "$items[0] and $items[1]" if @items == 2;
202 my $tail = pop @items;
203 my $list = join ', ', @items;
204 $list .= ', and ' . $tail;
217 Moose::Util - Utilities for working with Moose classes
221 use Moose::Util qw/find_meta does_role search_class_by_role/;
223 my $meta = find_meta($object) || die "No metaclass found";
225 if (does_role($object, $role)) {
226 print "The object can do $role!\n";
229 my $class = search_class_by_role($object, 'FooRole');
230 print "Nearest class with 'FooRole' is $class\n";
234 This module provides a set of utility functions. Many of these
235 functions are intended for use in Moose itself or MooseX modules, but
236 some of them may be useful for use in your own code.
238 =head1 EXPORTED FUNCTIONS
242 =item B<find_meta($class_or_obj)>
244 This method takes a class name or object and attempts to find a
245 metaclass for the class, if one exists. It will B<not> create one if it
248 =item B<does_role($class_or_obj, $role_name)>
250 Returns true if C<$class_or_obj> does the given C<$role_name>.
252 The class must already have a metaclass for this to work.
254 =item B<search_class_by_role($class_or_obj, $role_name)>
256 Returns the first class in the class's precedence list that does
257 C<$role_name>, if any.
259 The class must already have a metaclass for this to work.
261 =item B<apply_all_roles($applicant, @roles)>
263 This function applies one or more roles to the given C<$applicant> The
264 applicant can be a role name, class name, or object.
266 The C<$applicant> must already have a metaclass object.
268 The list of C<@roles> should be a list of names, each of which can be
269 followed by an optional hash reference of options (C<exclude> and
272 =item B<ensure_all_roles($applicant, @roles)>
274 This function is similar to L</apply_all_roles>, but only applies roles that
275 C<$applicant> does not already consume.
277 =item B<get_all_attribute_values($meta, $instance)>
279 Returns a hash reference containing all of the C<$instance>'s
280 attributes. The keys are attribute names.
282 =item B<get_all_init_args($meta, $instance)>
284 Returns a hash reference containing all of the C<init_arg> values for
285 the instance's attributes. The values are the associated attribute
286 values. If an attribute does not have a defined C<init_arg>, it is
289 This could be useful in cloning an object.
291 =item B<resolve_metaclass_alias($category, $name, %options)>
293 =item B<resolve_metatrait_alias($category, $name, %options)>
295 Resolves a short name to a full class name. Short names are often used
296 when specifying the C<metaclass> or C<traits> option for an attribute:
302 The name resolution mechanism is covered in L<Moose/Trait Name
305 =item B<english_list(@items)>
307 Given a list of scalars, turns them into a proper list in English
308 ("one and two", "one, two, three, and four"). This is used to help us
309 make nicer error messages.
315 Here is a list of possible functions to write
319 =item discovering original method from modified method
321 =item search for origin class of a method or attribute
327 All complex software has bugs lurking in it, and this module is no
328 exception. If you find a bug please either email me, or add the bug
333 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
335 B<with contributions from:>
337 Robert (phaylon) Sedlacek
341 =head1 COPYRIGHT AND LICENSE
343 Copyright 2007-2009 by Infinity Interactive, Inc.
345 L<http://www.iinteractive.com>
347 This library is free software; you can redistribute it and/or modify
348 it under the same terms as Perl itself.