X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil.pm;h=91e874559f2cc886f0fabcbb7d17e94f7de3ed01;hb=72d15b838f9f72a7fe7dcc1570c4b445d9252c2b;hp=46b57f607d73cd795458971b96282e8429f76461;hpb=a3738e5b694e89eb03672de763214bf156421101;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index 46b57f6..91e8745 100644
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -6,9 +6,10 @@ 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.55_01';
+$VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
 my @exports = qw[
@@ -18,6 +19,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 +44,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;
 }
@@ -68,33 +72,30 @@ sub search_class_by_role {
 
 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));
-    
+
+    my $roles = Data::OptList::mkopt( [@_] );
+
+    my $meta = ( blessed $applicant ? $applicant : find_meta($applicant) );
+
     foreach my $role_spec (@$roles) {
-        Class::MOP::load_class($role_spec->[0]);
+        Class::MOP::load_class( $role_spec->[0] );
     }
-    
-    ($_->[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 : ()));
+    ( $_->[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);
-    }    
+        Moose::Meta::Role->combine( @$roles )->apply($meta);
+    }
 }
 
 # instance deconstruction ...
@@ -141,6 +142,24 @@ sub resolve_metaclass_alias {
     }
 }
 
+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->get_all_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;
 
@@ -224,6 +243,8 @@ Resolve a short name like in e.g.
 
 to a full class name.
 
+=item B<add_method_modifier ($class_or_obj, $modifier_name, $args)>
+
 =back
 
 =head1 TODO