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

diff --git a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
index f9dd69d..d804d02 100644
--- a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
+++ b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
@@ -3,8 +3,9 @@ package # hide from PAUSE
 
 use strict;
 use warnings;
-
+use Sub::Name ();
 use Storable 'dclone';
+use List::Util ();
 
 use base qw/DBIx::Class::Row/;
 
@@ -19,15 +20,24 @@ 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 {
   my ($class, $group, @cols) = @_;
+  $class->mk_group_accessors(column => @cols);
   $class->add_columns(@cols);
   $class->_register_column_group($group => @cols);
 }
 
+sub add_columns {
+  my ($class, @cols) = @_;
+  $class->result_source_instance->add_columns(@cols);
+}
+
 sub _register_column_group {
   my ($class, $group, @cols) = @_;
 
@@ -37,7 +47,9 @@ sub _register_column_group {
 
   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') {
@@ -50,11 +62,79 @@ 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);
 }
 
+# CDBI will never overwrite an accessor, but it only uses one
+# accessor for all column types.  DBIC uses many different
+# accessor types so, for example, if you declare a column()
+# and then a has_a() for that same column it must overwrite.
+#
+# To make this work CDBICompat has decide if an accessor
+# method was put there by itself and only then overwrite.
+{
+  my %our_accessors;
+
+  sub _has_custom_accessor {
+    my($class, $name) = @_;
+
+    no strict 'refs';
+    my $existing_accessor = *{$class .'::'. $name}{CODE};
+    return $existing_accessor && !$our_accessors{$existing_accessor};
+  }
+
+  sub _deploy_accessor {
+    my($class, $name, $accessor) = @_;
+
+    return if $class->_has_custom_accessor($name);
+
+    {
+      no strict 'refs';
+      no warnings 'redefine';
+      my $fullname = join '::', $class, $name;
+      *$fullname = Sub::Name::subname $fullname, $accessor;
+    }
+
+    $our_accessors{$accessor}++;
+
+    return 1;
+  }
+}
+
+sub _mk_group_accessors {
+  my ($class, $type, $group, @fields) = @_;
+
+  # So we don't have to do lots of lookups inside the loop.
+  my $maker = $class->can($type) unless ref $type;
+
+  # warn "$class $type $group\n";
+  foreach my $field (@fields) {
+    if( $field eq 'DESTROY' ) {
+        carp("Having a data accessor named DESTROY in ".
+             "'$class' is unwise.");
+    }
+
+    my $name = $field;
+
+    ($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);
+    }
+  }
+}
+
 sub all_columns { return shift->result_source_instance->columns; }
 
 sub primary_column {
@@ -63,6 +143,10 @@ sub primary_column {
   return wantarray ? @pri : $pri[0];
 }
 
+sub _essential {
+    return shift->columns("Essential");
+}
+
 sub find_column {
   my ($class, $col) = @_;
   return $col if $class->has_column($col);
@@ -79,7 +163,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) = @_;
@@ -91,6 +176,5 @@ sub groups_for {
   }
   return keys %groups;
 }
-    
 
 1;