X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FClass.pm;h=79fac5c8971882d25aae1267bd0b94c545c516d0;hb=13b9990881cb1c765a47711fc4eb0d47a404c756;hp=3dbf300c3e0007c1d1ca129632e5159be9ad409e;hpb=98a8fd12ede46b22edc10d229680d9d2e8deeade;p=gitmo%2FMouse.git

diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm
index 3dbf300..79fac5c 100644
--- a/lib/Mouse/Meta/Class.pm
+++ b/lib/Mouse/Meta/Class.pm
@@ -129,7 +129,7 @@ sub _collect_roles {
     }
 
     my %seen;
-    return sort grep { !$seen{$_}++ }
+    return sort grep { !$seen{$_}++ } ## no critic
         (map{ $_->name } map{ $_->meta->calculate_all_roles } @self_anon_supers),
         (map{ $_->name } map{ $_->meta->calculate_all_roles } @other_anon_supers),
     ;
@@ -228,20 +228,8 @@ sub compute_all_applicable_attributes { # DEPRECATED
 sub linearized_isa;
 
 sub new_object;
+sub clone_object;
 
-sub clone_object {
-    my $class  = shift;
-    my $object = shift;
-    my $args   = $object->Mouse::Object::BUILDARGS(@_);
-
-    (blessed($object) && $object->isa($class->name))
-        || $class->throw_error("You must pass an instance of the metaclass (" . $class->name . "), not ($object)");
-
-    my $cloned = bless { %$object }, ref $object;
-    $class->_initialize_object($cloned, $args);
-
-    return $cloned;
-}
 
 sub clone_instance { # DEPRECATED
     my ($class, $instance, %params) = @_;
@@ -367,10 +355,10 @@ sub _install_modifier_pp{
 sub _install_modifier {
     my ( $self, $type, $name, $code ) = @_;
 
-    # load Class::Method::Modifiers first
+    # load Data::Util first
     my $no_cmm_fast = do{
         local $@;
-        eval q{ use Class::Method::Modifiers::Fast 0.041 () };
+        eval q{ use Data::Util 0.55 () };
         $@;
     };
 
@@ -379,13 +367,27 @@ sub _install_modifier {
         $impl = \&_install_modifier_pp;
     }
     else{
-        my $install_modifier = Class::Method::Modifiers::Fast->can('install_modifier');
         $impl = sub {
             my ( $self, $type, $name, $code ) = @_;
             my $into = $self->name;
-            $install_modifier->($into, $type, $name, $code);
 
-            $self->add_method($name => Mouse::Util::get_code_ref($into, $name));
+            my $method = Mouse::Util::get_code_ref( $into, $name );
+
+            if ( !$method || !Data::Util::subroutine_modifier($method) ) {
+                unless ($method) {
+                    $method = $into->can($name)
+                        or Carp::confess("The method '$name' is not found in the inheritance hierarchy for class $into");
+                }
+                $method = Data::Util::modify_subroutine( $method,
+                    $type => [$code] );
+
+                $self->add_method($name => $method);
+            }
+            else {
+                Data::Util::subroutine_modifier( $method, $type => $code );
+                $self->add_method($name => Mouse::Util::get_code_ref($into, $name));
+            }
+
             return;
         };
     }
@@ -486,7 +488,7 @@ Mouse::Meta::Class - The Mouse class metaclass
 
 =head1 VERSION
 
-This document describes Mouse version 0.50_05
+This document describes Mouse version 0.59
 
 =head1 METHODS