0.37
[gitmo/Moose.git] / lib / Moose / Util.pm
index d5af0a6..466e2aa 100644 (file)
@@ -4,16 +4,20 @@ use strict;
 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({
@@ -25,7 +29,7 @@ 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 ...
@@ -62,6 +66,57 @@ sub search_class_by_role {
     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__
@@ -110,6 +165,25 @@ Returns true if C<$class_or_obj> can do the role C<$role_name>.
 
 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
@@ -142,7 +216,7 @@ Stevan Little
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2007 by Infinity Interactive, Inc.
+Copyright 2007-2008 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>