Fix obscure failure of CDBICompat accessor install on 5.8

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / CDBICompat / ColumnGroups.pm

diff --git a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
index d804d02..44a6010 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
+++ b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
@@ -4,7 +4,6 @@ package # hide from PAUSE
 use strict;
 use warnings;
 use Sub::Name ();
-use Storable 'dclone';
 use List::Util ();
 
 use base qw/DBIx::Class::Row/;
@@ -43,7 +42,7 @@ sub _register_column_group {
 
   # Must do a complete deep copy else column groups
   # might accidentally be shared.
-  my $groups = dclone $class->_column_groups;
+  my $groups = DBIx::Class::_Util::deep_clone( $class->_column_groups );
 
   if ($group eq 'Primary') {
     $class->set_primary_key(@cols);
@@ -84,7 +83,23 @@ sub _register_column_group {
 
     no strict 'refs';
     my $existing_accessor = *{$class .'::'. $name}{CODE};
-    return $existing_accessor && !$our_accessors{$existing_accessor};
+
+    return(
+      defined $existing_accessor
+        and
+      ! $our_accessors{$existing_accessor}
+        and
+      # under 5.8 mro the CODE slot may simply be a "cached method"
+      ! (
+        DBIx::Class::_ENV_::OLD_MRO
+          and
+        grep {
+          $_ ne $class
+            and
+          ($_->can($name)||0) == $existing_accessor
+        } @{mro::get_linear_isa($class)}
+      )
+    )
   }
 
   sub _deploy_accessor {