7 use Scalar::Util 'blessed';
11 our $VERSION = '0.04';
12 our $AUTHORITY = 'cpan:STEVAN';
20 get_all_attribute_values
23 Sub::Exporter::setup_exporter({
25 groups => { all => \@exports }
28 ## some utils for the utils ...
32 return Class::MOP::get_metaclass_by_name(blessed($_[0]) || $_[0]);
38 my ($class_or_obj, $role) = @_;
40 my $meta = find_meta($class_or_obj);
42 return unless defined $meta;
44 return 1 if $meta->does_role($role);
48 sub search_class_by_role {
49 my ($class_or_obj, $role_name) = @_;
51 my $meta = find_meta($class_or_obj);
53 return unless defined $meta;
55 foreach my $class ($meta->class_precedence_list) {
57 my $_meta = find_meta($class);
59 next unless defined $_meta;
61 foreach my $role (@{ $_meta->roles || [] }) {
62 return $class if $role->name eq $role_name;
70 my $applicant = shift;
72 confess "Must specify at least one role to apply to $applicant" unless @_;
74 my $roles = Data::OptList::mkopt([ @_ ]);
79 my $meta = (blessed $applicant ? $applicant : find_meta($applicant));
81 foreach my $role_spec (@$roles) {
82 Class::MOP::load_class($role_spec->[0]);
85 ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role'))
86 || confess "You can only consume roles, " . $_->[0] . " is not a Moose role"
89 if (scalar @$roles == 1) {
90 my ($role, $params) = @{$roles->[0]};
91 $role->meta->apply($meta, (defined $params ? %$params : ()));
94 Moose::Meta::Role->combine(
100 # instance deconstruction ...
102 sub get_all_attribute_values {
103 my ($class, $instance) = @_;
105 map { $_->name => $_->get_value($instance) }
106 grep { $_->has_value($instance) }
107 $class->compute_all_applicable_attributes
111 sub get_all_init_args {
112 my ($class, $instance) = @_;
114 map { $_->init_arg => $_->get_value($instance) }
115 grep { $_->has_value($instance) }
116 grep { defined($_->init_arg) }
117 $class->compute_all_applicable_attributes
130 Moose::Util - Utilities for working with Moose classes
134 use Moose::Util qw/find_meta does_role search_class_by_role/;
136 my $meta = find_meta($object) || die "No metaclass found";
138 if (does_role($object, $role)) {
139 print "The object can do $role!\n";
142 my $class = search_class_by_role($object, 'FooRole');
143 print "Nearest class with 'FooRole' is $class\n";
147 This is a set of utility functions to help working with Moose classes, and
148 is used internally by Moose itself. The goal is to provide useful functions
149 that for both Moose users and Moose extenders (MooseX:: authors).
151 This is a relatively new addition to the Moose toolchest, so ideas,
152 suggestions and contributions to this collection are most welcome.
153 See the L<TODO> section below for a list of ideas for possible functions
156 =head1 EXPORTED FUNCTIONS
160 =item B<find_meta ($class_or_obj)>
162 This will attempt to locate a metaclass for the given C<$class_or_obj>
165 =item B<does_role ($class_or_obj, $role_name)>
167 Returns true if C<$class_or_obj> can do the role C<$role_name>.
169 =item B<search_class_by_role ($class_or_obj, $role_name)>
171 Returns first class in precedence list that consumed C<$role_name>.
173 =item B<apply_all_roles ($applicant, @roles)>
175 Given an C<$applicant> (which can somehow be turned into either a
176 metaclass or a metarole) and a list of C<@roles> this will do the
177 right thing to apply the C<@roles> to the C<$applicant>. This is
178 actually used internally by both L<Moose> and L<Moose::Role>, and the
179 C<@roles> will be pre-processed through L<Data::OptList::mkopt>
180 to allow for the additional arguments to be passed.
182 =item B<get_all_attribute_values($meta, $instance)>
184 Returns the values of the C<$instance>'s fields keyed by the attribute names.
186 =item B<get_all_init_args($meta, $instance)>
188 Returns a hash reference where the keys are all the attributes' C<init_arg>s
189 and the values are the instance's fields. Attributes without an C<init_arg>
196 Here is a list of possible functions to write
200 =item discovering original method from modified method
202 =item search for origin class of a method or attribute
208 All complex software has bugs lurking in it, and this module is no
209 exception. If you find a bug please either email me, or add the bug
214 Anders Nor Berle E<lt>debolaz@gmail.comE<gt>
216 B<with contributions from:>
218 Robert (phaylon) Sedlacek
222 =head1 COPYRIGHT AND LICENSE
224 Copyright 2007-2008 by Infinity Interactive, Inc.
226 L<http://www.iinteractive.com>
228 This library is free software; you can redistribute it and/or modify
229 it under the same terms as Perl itself.