7 use Scalar::Util 'blessed';
11 our $VERSION = '0.55';
12 our $AUTHORITY = 'cpan:STEVAN';
20 get_all_attribute_values
21 resolve_metatrait_alias
22 resolve_metaclass_alias
26 Sub::Exporter::setup_exporter({
28 groups => { all => \@exports }
31 ## some utils for the utils ...
35 return Class::MOP::get_metaclass_by_name(blessed($_[0]) || $_[0]);
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;
73 my $applicant = shift;
75 confess "Must specify at least one role to apply to $applicant" unless @_;
77 my $roles = Data::OptList::mkopt([ @_ ]);
82 my $meta = (blessed $applicant ? $applicant : find_meta($applicant));
84 foreach my $role_spec (@$roles) {
85 Class::MOP::load_class($role_spec->[0]);
88 ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role'))
89 || confess "You can only consume roles, " . $_->[0] . " 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(
103 # instance deconstruction ...
105 sub get_all_attribute_values {
106 my ($class, $instance) = @_;
108 map { $_->name => $_->get_value($instance) }
109 grep { $_->has_value($instance) }
110 $class->compute_all_applicable_attributes
114 sub get_all_init_args {
115 my ($class, $instance) = @_;
117 map { $_->init_arg => $_->get_value($instance) }
118 grep { $_->has_value($instance) }
119 grep { defined($_->init_arg) }
120 $class->compute_all_applicable_attributes
124 sub resolve_metatrait_alias {
125 resolve_metaclass_alias( @_, trait => 1 );
128 sub resolve_metaclass_alias {
129 my ( $type, $metaclass_name, %options ) = @_;
131 if ( my $resolved = eval {
132 my $possible_full_name = 'Moose::Meta::' . $type . '::Custom::' . ( $options{trait} ? "Trait::" : "" ) . $metaclass_name;
134 Class::MOP::load_class($possible_full_name);
136 $possible_full_name->can('register_implementation')
137 ? $possible_full_name->register_implementation
138 : $possible_full_name;
142 Class::MOP::load_class($metaclass_name);
143 return $metaclass_name;
147 sub add_method_modifier {
148 my ( $class_or_obj, $modifier_name, $args ) = @_;
149 my $meta = find_meta($class_or_obj);
150 my $code = pop @{$args};
151 my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier';
152 if ( my $method_modifier_type = ref( @{$args}[0] ) ) {
153 if ( $method_modifier_type eq 'Regexp' ) {
154 my @all_methods = $meta->compute_all_applicable_methods;
156 = grep { $_->{name} =~ @{$args}[0] } @all_methods;
157 $meta->$add_modifier_method( $_->{name}, $code )
158 for @matched_methods;
162 $meta->$add_modifier_method( $_, $code ) for @{$args};
174 Moose::Util - Utilities for working with Moose classes
178 use Moose::Util qw/find_meta does_role search_class_by_role/;
180 my $meta = find_meta($object) || die "No metaclass found";
182 if (does_role($object, $role)) {
183 print "The object can do $role!\n";
186 my $class = search_class_by_role($object, 'FooRole');
187 print "Nearest class with 'FooRole' is $class\n";
191 This is a set of utility functions to help working with Moose classes, and
192 is used internally by Moose itself. The goal is to provide useful functions
193 that for both Moose users and Moose extenders (MooseX:: authors).
195 This is a relatively new addition to the Moose toolchest, so ideas,
196 suggestions and contributions to this collection are most welcome.
197 See the L<TODO> section below for a list of ideas for possible functions
200 =head1 EXPORTED FUNCTIONS
204 =item B<find_meta ($class_or_obj)>
206 This will attempt to locate a metaclass for the given C<$class_or_obj>
209 =item B<does_role ($class_or_obj, $role_name)>
211 Returns true if C<$class_or_obj> can do the role C<$role_name>.
213 =item B<search_class_by_role ($class_or_obj, $role_name)>
215 Returns first class in precedence list that consumed C<$role_name>.
217 =item B<apply_all_roles ($applicant, @roles)>
219 Given an C<$applicant> (which can somehow be turned into either a
220 metaclass or a metarole) and a list of C<@roles> this will do the
221 right thing to apply the C<@roles> to the C<$applicant>. This is
222 actually used internally by both L<Moose> and L<Moose::Role>, and the
223 C<@roles> will be pre-processed through L<Data::OptList::mkopt>
224 to allow for the additional arguments to be passed.
226 =item B<get_all_attribute_values($meta, $instance)>
228 Returns the values of the C<$instance>'s fields keyed by the attribute names.
230 =item B<get_all_init_args($meta, $instance)>
232 Returns a hash reference where the keys are all the attributes' C<init_arg>s
233 and the values are the instance's fields. Attributes without an C<init_arg>
236 =item B<resolve_metaclass_alias($category, $name, %options)>
238 =item B<resolve_metatrait_alias($category, $name, %options)>
240 Resolve a short name like in e.g.
246 to a full class name.
248 =item B<add_method_modifier ($class_or_obj, $modifier_name, $args)>
254 Here is a list of possible functions to write
258 =item discovering original method from modified method
260 =item search for origin class of a method or attribute
266 All complex software has bugs lurking in it, and this module is no
267 exception. If you find a bug please either email me, or add the bug
272 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
274 B<with contributions from:>
276 Robert (phaylon) Sedlacek
280 =head1 COPYRIGHT AND LICENSE
282 Copyright 2007-2008 by Infinity Interactive, Inc.
284 L<http://www.iinteractive.com>
286 This library is free software; you can redistribute it and/or modify
287 it under the same terms as Perl itself.