use warnings;
use Sub::Exporter;
-use Scalar::Util ();
+use Scalar::Util 'blessed';
+use Carp 'confess';
use Class::MOP ();
-our $VERSION = '0.01';
+our $VERSION = '0.03';
our $AUTHORITY = 'cpan:STEVAN';
my @exports = qw[
find_meta
does_role
search_class_by_role
+ apply_all_roles
+ get_all_init_args
+ get_all_attribute_values
];
Sub::Exporter::setup_exporter({
sub find_meta {
return unless $_[0];
- return Class::MOP::get_metaclass_by_name(ref($_[0]) || $_[0]);
+ return Class::MOP::get_metaclass_by_name(blessed($_[0]) || $_[0]);
}
## the functions ...
return;
}
+sub apply_all_roles {
+ my $applicant = shift;
+
+ confess "Must specify at least one role to apply to $applicant" unless @_;
+
+ my $roles = Data::OptList::mkopt([ @_ ]);
+
+ #use Data::Dumper;
+ #warn Dumper $roles;
+
+ my $meta = (blessed $applicant ? $applicant : find_meta($applicant));
+
+ Class::MOP::load_class($_->[0]) for @$roles;
+
+ ($_->[0]->can('meta') && $_->[0]->meta->isa('Moose::Meta::Role'))
+ || confess "You can only consume roles, " . $_->[0] . " is not a Moose role"
+ foreach @$roles;
+
+ if (scalar @$roles == 1) {
+ my ($role, $params) = @{$roles->[0]};
+ $role->meta->apply($meta, (defined $params ? %$params : ()));
+ }
+ else {
+ Moose::Meta::Role->combine(
+ @$roles
+ )->apply($meta);
+ }
+}
+
+# instance deconstruction ...
+
+sub get_all_attribute_values {
+ my ($class, $instance) = @_;
+ return +{
+ map { $_->name => $_->get_value($instance) }
+ grep { $_->has_value($instance) }
+ $class->compute_all_applicable_attributes
+ };
+}
+
+sub get_all_init_args {
+ my ($class, $instance) = @_;
+ return +{
+ map { $_->init_arg => $_->get_value($instance) }
+ grep { $_->has_value($instance) }
+ grep { defined($_->init_arg) }
+ $class->compute_all_applicable_attributes
+ };
+}
+
+
1;
__END__
Returns first class in precedence list that consumed C<$role_name>.
+=item B<apply_all_roles ($applicant, @roles)>
+
+Given an C<$applicant> (which can somehow be turned into either a
+metaclass or a metarole) and a list of C<@roles> this will do the
+right thing to apply the C<@roles> to the C<$applicant>. This is
+actually used internally by both L<Moose> and L<Moose::Role>, and the
+C<@roles> will be pre-processed through L<Data::OptList::mkopt>
+to allow for the additional arguments to be passed.
+
+=item B<get_all_attribute_values($meta, $instance)>
+
+Returns the values of the C<$instance>'s fields keyed by the attribute names.
+
+=item B<get_all_init_args($meta, $instance)>
+
+Returns a hash reference where the keys are all the attributes' C<init_arg>s
+and the values are the instance's fields. Attributes without an C<init_arg>
+will be skipped.
+
=back
=head1 TODO
=head1 COPYRIGHT AND LICENSE
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>