7 use Scalar::Util 'blessed';
11 our $VERSION = '0.04';
12 our $AUTHORITY = 'cpan:STEVAN';
20 get_all_attribute_values
21 resolve_metatrait_alias
22 resolve_metaclass_alias
25 Sub::Exporter::setup_exporter({
27 groups => { all => \@exports }
30 ## some utils for the utils ...
34 return Class::MOP::get_metaclass_by_name(blessed($_[0]) || $_[0]);
40 my ($class_or_obj, $role) = @_;
42 my $meta = find_meta($class_or_obj);
44 return unless defined $meta;
46 return 1 if $meta->does_role($role);
50 sub search_class_by_role {
51 my ($class_or_obj, $role_name) = @_;
53 my $meta = find_meta($class_or_obj);
55 return unless defined $meta;
57 foreach my $class ($meta->class_precedence_list) {
59 my $_meta = find_meta($class);
61 next unless defined $_meta;
63 foreach my $role (@{ $_meta->roles || [] }) {
64 return $class if $role->name eq $role_name;
72 my $applicant = shift;
74 confess "Must specify at least one role to apply to $applicant" unless @_;
76 my $roles = Data::OptList::mkopt([ @_ ]);
81 my $meta = (blessed $applicant ? $applicant : find_meta($applicant));
83 foreach my $role_spec (@$roles) {
84 Class::MOP::load_class($role_spec->[0]);
87 ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role'))
88 || confess "You can only consume roles, " . $_->[0] . " is not a Moose role"
91 if (scalar @$roles == 1) {
92 my ($role, $params) = @{$roles->[0]};
93 $role->meta->apply($meta, (defined $params ? %$params : ()));
96 Moose::Meta::Role->combine(
102 # instance deconstruction ...
104 sub get_all_attribute_values {
105 my ($class, $instance) = @_;
107 map { $_->name => $_->get_value($instance) }
108 grep { $_->has_value($instance) }
109 $class->compute_all_applicable_attributes
113 sub get_all_init_args {
114 my ($class, $instance) = @_;
116 map { $_->init_arg => $_->get_value($instance) }
117 grep { $_->has_value($instance) }
118 grep { defined($_->init_arg) }
119 $class->compute_all_applicable_attributes
123 sub resolve_metatrait_alias {
124 resolve_metaclass_alias( @_, trait => 1 );
127 sub resolve_metaclass_alias {
128 my ( $type, $metaclass_name, %options ) = @_;
130 if ( my $resolved = eval {
131 my $possible_full_name = 'Moose::Meta::' . $type . '::Custom::' . ( $options{trait} ? "Trait::" : "" ) . $metaclass_name;
133 Class::MOP::load_class($possible_full_name);
135 $possible_full_name->can('register_implementation')
136 ? $possible_full_name->register_implementation
137 : $possible_full_name;
141 Class::MOP::load_class($metaclass_name);
142 return $metaclass_name;
155 Moose::Util - Utilities for working with Moose classes
159 use Moose::Util qw/find_meta does_role search_class_by_role/;
161 my $meta = find_meta($object) || die "No metaclass found";
163 if (does_role($object, $role)) {
164 print "The object can do $role!\n";
167 my $class = search_class_by_role($object, 'FooRole');
168 print "Nearest class with 'FooRole' is $class\n";
172 This is a set of utility functions to help working with Moose classes, and
173 is used internally by Moose itself. The goal is to provide useful functions
174 that for both Moose users and Moose extenders (MooseX:: authors).
176 This is a relatively new addition to the Moose toolchest, so ideas,
177 suggestions and contributions to this collection are most welcome.
178 See the L<TODO> section below for a list of ideas for possible functions
181 =head1 EXPORTED FUNCTIONS
185 =item B<find_meta ($class_or_obj)>
187 This will attempt to locate a metaclass for the given C<$class_or_obj>
190 =item B<does_role ($class_or_obj, $role_name)>
192 Returns true if C<$class_or_obj> can do the role C<$role_name>.
194 =item B<search_class_by_role ($class_or_obj, $role_name)>
196 Returns first class in precedence list that consumed C<$role_name>.
198 =item B<apply_all_roles ($applicant, @roles)>
200 Given an C<$applicant> (which can somehow be turned into either a
201 metaclass or a metarole) and a list of C<@roles> this will do the
202 right thing to apply the C<@roles> to the C<$applicant>. This is
203 actually used internally by both L<Moose> and L<Moose::Role>, and the
204 C<@roles> will be pre-processed through L<Data::OptList::mkopt>
205 to allow for the additional arguments to be passed.
207 =item B<get_all_attribute_values($meta, $instance)>
209 Returns the values of the C<$instance>'s fields keyed by the attribute names.
211 =item B<get_all_init_args($meta, $instance)>
213 Returns a hash reference where the keys are all the attributes' C<init_arg>s
214 and the values are the instance's fields. Attributes without an C<init_arg>
217 =item B<resolve_metaclass_alias($category, $name, %options)>
219 =item B<resolve_metatrait_alias($category, $name, %options)>
221 Resolve a short name like in e.g.
227 to a full class name.
233 Here is a list of possible functions to write
237 =item discovering original method from modified method
239 =item search for origin class of a method or attribute
245 All complex software has bugs lurking in it, and this module is no
246 exception. If you find a bug please either email me, or add the bug
251 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
253 B<with contributions from:>
255 Robert (phaylon) Sedlacek
259 =head1 COPYRIGHT AND LICENSE
261 Copyright 2007-2008 by Infinity Interactive, Inc.
263 L<http://www.iinteractive.com>
265 This library is free software; you can redistribute it and/or modify
266 it under the same terms as Perl itself.