7 use Scalar::Util 'blessed';
11 our $VERSION = '0.56';
12 $VERSION = eval $VERSION;
13 our $AUTHORITY = 'cpan:STEVAN';
21 get_all_attribute_values
22 resolve_metatrait_alias
23 resolve_metaclass_alias
27 Sub::Exporter::setup_exporter({
29 groups => { all => \@exports }
32 ## some utils for the utils ...
36 return Class::MOP::get_metaclass_by_name(blessed($_[0]) || $_[0]);
42 my ($class_or_obj, $role) = @_;
44 my $meta = find_meta($class_or_obj);
46 return unless defined $meta;
47 return unless $meta->can('does_role');
48 return 1 if $meta->does_role($role);
52 sub search_class_by_role {
53 my ($class_or_obj, $role_name) = @_;
55 my $meta = find_meta($class_or_obj);
57 return unless defined $meta;
59 foreach my $class ($meta->class_precedence_list) {
61 my $_meta = find_meta($class);
63 next unless defined $_meta;
65 foreach my $role (@{ $_meta->roles || [] }) {
66 return $class if $role->name eq $role_name;
74 my $applicant = shift;
76 confess "Must specify at least one role to apply to $applicant" unless @_;
78 my $roles = Data::OptList::mkopt( [@_] );
80 my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
82 foreach my $role_spec (@$roles) {
83 Class::MOP::load_class( $role_spec->[0] );
86 ( $_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role') )
87 || confess "You can only consume roles, "
89 . " is not a Moose role"
92 if ( scalar @$roles == 1 ) {
93 my ( $role, $params ) = @{ $roles->[0] };
94 $role->meta->apply( $meta, ( defined $params ? %$params : () ) );
97 Moose::Meta::Role->combine( @$roles )->apply($meta);
101 # instance deconstruction ...
103 sub get_all_attribute_values {
104 my ($class, $instance) = @_;
106 map { $_->name => $_->get_value($instance) }
107 grep { $_->has_value($instance) }
108 $class->compute_all_applicable_attributes
112 sub get_all_init_args {
113 my ($class, $instance) = @_;
115 map { $_->init_arg => $_->get_value($instance) }
116 grep { $_->has_value($instance) }
117 grep { defined($_->init_arg) }
118 $class->compute_all_applicable_attributes
122 sub resolve_metatrait_alias {
123 resolve_metaclass_alias( @_, trait => 1 );
126 sub resolve_metaclass_alias {
127 my ( $type, $metaclass_name, %options ) = @_;
129 if ( my $resolved = eval {
130 my $possible_full_name = 'Moose::Meta::' . $type . '::Custom::' . ( $options{trait} ? "Trait::" : "" ) . $metaclass_name;
132 Class::MOP::load_class($possible_full_name);
134 $possible_full_name->can('register_implementation')
135 ? $possible_full_name->register_implementation
136 : $possible_full_name;
140 Class::MOP::load_class($metaclass_name);
141 return $metaclass_name;
145 sub add_method_modifier {
146 my ( $class_or_obj, $modifier_name, $args ) = @_;
147 my $meta = find_meta($class_or_obj);
148 my $code = pop @{$args};
149 my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier';
150 if ( my $method_modifier_type = ref( @{$args}[0] ) ) {
151 if ( $method_modifier_type eq 'Regexp' ) {
152 my @all_methods = $meta->get_all_methods;
154 = grep { $_->name =~ @{$args}[0] } @all_methods;
155 $meta->$add_modifier_method( $_->name, $code )
156 for @matched_methods;
160 $meta->$add_modifier_method( $_, $code ) for @{$args};
172 Moose::Util - Utilities for working with Moose classes
176 use Moose::Util qw/find_meta does_role search_class_by_role/;
178 my $meta = find_meta($object) || die "No metaclass found";
180 if (does_role($object, $role)) {
181 print "The object can do $role!\n";
184 my $class = search_class_by_role($object, 'FooRole');
185 print "Nearest class with 'FooRole' is $class\n";
189 This is a set of utility functions to help working with Moose classes, and
190 is used internally by Moose itself. The goal is to provide useful functions
191 that for both Moose users and Moose extenders (MooseX:: authors).
193 This is a relatively new addition to the Moose toolchest, so ideas,
194 suggestions and contributions to this collection are most welcome.
195 See the L<TODO> section below for a list of ideas for possible functions
198 =head1 EXPORTED FUNCTIONS
202 =item B<find_meta ($class_or_obj)>
204 This will attempt to locate a metaclass for the given C<$class_or_obj>
207 =item B<does_role ($class_or_obj, $role_name)>
209 Returns true if C<$class_or_obj> can do the role C<$role_name>.
211 =item B<search_class_by_role ($class_or_obj, $role_name)>
213 Returns first class in precedence list that consumed C<$role_name>.
215 =item B<apply_all_roles ($applicant, @roles)>
217 Given an C<$applicant> (which can somehow be turned into either a
218 metaclass or a metarole) and a list of C<@roles> this will do the
219 right thing to apply the C<@roles> to the C<$applicant>. This is
220 actually used internally by both L<Moose> and L<Moose::Role>, and the
221 C<@roles> will be pre-processed through L<Data::OptList::mkopt>
222 to allow for the additional arguments to be passed.
224 =item B<get_all_attribute_values($meta, $instance)>
226 Returns the values of the C<$instance>'s fields keyed by the attribute names.
228 =item B<get_all_init_args($meta, $instance)>
230 Returns a hash reference where the keys are all the attributes' C<init_arg>s
231 and the values are the instance's fields. Attributes without an C<init_arg>
234 =item B<resolve_metaclass_alias($category, $name, %options)>
236 =item B<resolve_metatrait_alias($category, $name, %options)>
238 Resolve a short name like in e.g.
244 to a full class name.
246 =item B<add_method_modifier ($class_or_obj, $modifier_name, $args)>
252 Here is a list of possible functions to write
256 =item discovering original method from modified method
258 =item search for origin class of a method or attribute
264 All complex software has bugs lurking in it, and this module is no
265 exception. If you find a bug please either email me, or add the bug
270 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
272 B<with contributions from:>
274 Robert (phaylon) Sedlacek
278 =head1 COPYRIGHT AND LICENSE
280 Copyright 2007-2008 by Infinity Interactive, Inc.
282 L<http://www.iinteractive.com>
284 This library is free software; you can redistribute it and/or modify
285 it under the same terms as Perl itself.