Centralize remaining uses of Sub::Name within _Util

[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 2dcd878..47eefd5 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
+++ b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
@@ -3,11 +3,13 @@ package # hide from PAUSE
 
 use strict;
 use warnings;
-use Sub::Name ();
-use Storable 'dclone';
 
 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 {
@@ -19,7 +21,10 @@ sub columns {
   $class->_add_column_group($group => @_) if @_;
   return $class->all_columns    if $group eq "All";
   return $class->primary_column if $group eq "Primary";
-  return keys %{$class->_column_groups->{$group}};
+
+  my $grp = $class->_column_groups->{$group};
+  my @grp_cols = sort { $grp->{$b} <=> $grp->{$a} } (keys %$grp);
+  return @grp_cols;
 }
 
 sub _add_column_group {
@@ -39,11 +44,13 @@ 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);
-    $groups->{'Essential'}{$_} ||= 1 for @cols;
+    delete $groups->{'Essential'}{$_} for @cols;
+    my $first = List::Util::max(values %{$groups->{'Essential'}});
+    $groups->{'Essential'}{$_} = ++$first for reverse @cols;
   }
 
   if ($group eq 'All') {
@@ -56,7 +63,9 @@ sub _register_column_group {
     }
   }
 
-  $groups->{$group}{$_} ||= 1 for @cols;
+  delete $groups->{$group}{$_} for @cols;
+  my $first = List::Util::max(values %{$groups->{$group}});
+  $groups->{$group}{$_} = ++$first for reverse @cols;
 
   $class->_column_groups($groups);
 }
@@ -73,10 +82,26 @@ sub _register_column_group {
 
   sub _has_custom_accessor {
     my($class, $name) = @_;
-    
+
     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 {
@@ -88,9 +113,9 @@ 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}++;
 
     return 1;
@@ -114,15 +139,11 @@ 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, $_)
+      );
     }
   }
 }
@@ -155,7 +176,8 @@ sub _find_columns {
   return map { $class->find_column($_) } @col;
 }
 
-package DBIx::Class::CDBICompat::ColumnGroups::GrouperShim;
+package # hide from PAUSE (should be harmless, no POD no Version)
+    DBIx::Class::CDBICompat::ColumnGroups::GrouperShim;
 
 sub groups_for {
   my ($self, @cols) = @_;
@@ -167,6 +189,5 @@ sub groups_for {
   }
   return keys %groups;
 }
-    
 
 1;