X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil.pm;h=5bccc5af9fa13c81eab98160ae3c251783772e26;hb=a94188ac85b86f501de86f25496e821e31d74cac;hp=32cf5a9edf55b741aa35dbe2b154df8da69a81a0;hpb=004222dc591495492d18979bee465a5a4fcbd8d5;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index 32cf5a9..5bccc5a 100644
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -6,9 +6,9 @@ use warnings;
 use Sub::Exporter;
 use Scalar::Util 'blessed';
 use Carp         'confess';
-use Class::MOP   ();
+use Class::MOP   0.56;
 
-our $VERSION   = '0.04';
+our $VERSION   = '0.56';
 our $AUTHORITY = 'cpan:STEVAN';
 
 my @exports = qw[
@@ -18,6 +18,9 @@ my @exports = qw[
     apply_all_roles
     get_all_init_args
     get_all_attribute_values
+    resolve_metatrait_alias
+    resolve_metaclass_alias
+    add_method_modifier
 ];
 
 Sub::Exporter::setup_exporter({
@@ -40,7 +43,7 @@ sub does_role {
     my $meta = find_meta($class_or_obj);
     
     return unless defined $meta;
-
+    return unless $meta->can('does_role');
     return 1 if $meta->does_role($role);
     return;
 }
@@ -118,6 +121,47 @@ sub get_all_init_args {
     };
 }
 
+sub resolve_metatrait_alias {
+    resolve_metaclass_alias( @_, trait => 1 );
+}
+
+sub resolve_metaclass_alias {
+    my ( $type, $metaclass_name, %options ) = @_;
+
+    if ( my $resolved = eval {
+        my $possible_full_name = 'Moose::Meta::' . $type . '::Custom::' . ( $options{trait} ? "Trait::" : "" ) . $metaclass_name;
+
+        Class::MOP::load_class($possible_full_name);
+
+        $possible_full_name->can('register_implementation')
+            ? $possible_full_name->register_implementation
+            : $possible_full_name;
+    } ) {
+        return $resolved;
+    } else {
+        Class::MOP::load_class($metaclass_name);
+        return $metaclass_name;
+    }
+}
+
+sub add_method_modifier {
+    my ( $class_or_obj, $modifier_name, $args ) = @_;
+    my $meta                = find_meta($class_or_obj);
+    my $code                = pop @{$args};
+    my $add_modifier_method = 'add_' . $modifier_name . '_method_modifier';
+    if ( my $method_modifier_type = ref( @{$args}[0] ) ) {
+        if ( $method_modifier_type eq 'Regexp' ) {
+            my @all_methods = $meta->compute_all_applicable_methods;
+            my @matched_methods
+                = grep { $_->{name} =~ @{$args}[0] } @all_methods;
+            $meta->$add_modifier_method( $_->{name}, $code )
+                for @matched_methods;
+        }
+    }
+    else {
+        $meta->$add_modifier_method( $_, $code ) for @{$args};
+    }
+}
 
 1;
 
@@ -189,6 +233,20 @@ 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.
 
+=item B<resolve_metaclass_alias($category, $name, %options)>
+
+=item B<resolve_metatrait_alias($category, $name, %options)>
+
+Resolve a short name like in e.g.
+
+    has foo => (
+        metaclass => "Bar",
+    );
+
+to a full class name.
+
+=item B<add_method_modifier ($class_or_obj, $modifier_name, $args)>
+
 =back
 
 =head1 TODO