X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FColumnGroups.pm;h=d804d029c6e578980ff28c63b274a3334d0b22ae;hb=70171cd740b6a10899819c54332397e0eec18397;hp=fa87ac1924c7112be6e484a15f978cd23be56c84;hpb=8da46543004ecb546d27b1cc40450d7160e8178f;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm index fa87ac1..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,7 +62,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); } @@ -67,7 +81,7 @@ 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}; @@ -81,9 +95,10 @@ sub _register_column_group { { no strict 'refs'; no warnings 'redefine'; - *{$class .'::'. $name} = $accessor; + my $fullname = join '::', $class, $name; + *$fullname = Sub::Name::subname $fullname, $accessor; } - + $our_accessors{$accessor}++; return 1; @@ -113,7 +128,7 @@ sub _mk_group_accessors { # warn " $field $alias\n"; { no strict 'refs'; - + $class->_deploy_accessor($name, $accessor); $class->_deploy_accessor($alias, $accessor); } @@ -148,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) = @_; @@ -160,6 +176,5 @@ sub groups_for { } return keys %groups; } - 1;