X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FColumnGroups.pm;h=73f845c959a4834370dbd746865ee95aae84787c;hb=e570488ade8f327f47dd3318db3443a348d561d6;hp=d804d029c6e578980ff28c63b274a3334d0b22ae;hpb=b818efd7cd7db9188d32b1afb7f1081c07278eae;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
index d804d02..73f845c 100644
--- a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
+++ b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
@@ -3,12 +3,13 @@ package # hide from PAUSE
 
 use strict;
 use warnings;
-use Sub::Name ();
-use Storable 'dclone';
-use List::Util ();
 
 use base qw/DBIx::Class::Row/;
 
+use List::Util ();
+use DBIx::Class::_Util 'set_subname';
+use namespace::clean;
+
 __PACKAGE__->mk_classdata('_column_groups' => { });
 
 sub columns {
@@ -35,7 +36,7 @@ sub _add_column_group {
 
 sub add_columns {
   my ($class, @cols) = @_;
-  $class->result_source_instance->add_columns(@cols);
+  $class->result_source->add_columns(@cols);
 }
 
 sub _register_column_group {
@@ -43,7 +44,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 +85,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
+          ( $Class::C3::MRO{$_} || {} )->{methods}{$name}
+        } @{mro::get_linear_isa($class)}
+      )
+    )
   }
 
   sub _deploy_accessor {
@@ -96,7 +113,7 @@ sub _register_column_group {
       no strict 'refs';
       no warnings 'redefine';
       my $fullname = join '::', $class, $name;
-      *$fullname = Sub::Name::subname $fullname, $accessor;
+      *$fullname = set_subname $fullname, $accessor;
     }
 
     $our_accessors{$accessor}++;
@@ -122,20 +139,16 @@ sub _mk_group_accessors {
 
     ($name, $field) = @$field if ref $field;
 
-    my $accessor = $class->$maker($group, $field);
-    my $alias = "_${name}_accessor";
-
-    # warn "  $field $alias\n";
-    {
-      no strict 'refs';
-
-      $class->_deploy_accessor($name,  $accessor);
-      $class->_deploy_accessor($alias, $accessor);
+    for( $name, "_${name}_accessor" ) {
+      $class->_deploy_accessor(
+        $_,
+        $class->$maker($group, $field, $_)
+      );
     }
   }
 }
 
-sub all_columns { return shift->result_source_instance->columns; }
+sub all_columns { return shift->result_source->columns; }
 
 sub primary_column {
   my ($class) = @_;