[Dbix-class] Controlling column order

[Will Hawes]

Matt S Trout wrote:
> On Wed, Jan 11, 2006 at 01:16:12PM -0600, Brandon Black wrote:
>> On 1/11/06, Will Hawes <info at whawes.co.uk> wrote:
>>> Is it possible to control the order in which columns are returned from a
>>> DBIx::Class object?
>>>
>> You mean from DBIx::Class::Table->columns?  Perhaps this should be an
>> optional column_info attribute (sort_order?) that ->columns looks at.
> 
> or maybe just make the internal hash an IxHash like primaries do. Not sure
> what the performance impact of this would be though.
> 

I thought something along the lines of the attached patch (to SVN 
revision 462) might be useful here.
-------------- next part --------------
Index: Table.pm
===================================================================
--- Table.pm	(revision 462)
+++ Table.pm	(working copy)
@@ -10,10 +10,12 @@
 use base qw/DBIx::Class/;
 __PACKAGE__->load_components(qw/AccessorGroup/);
 
+__PACKAGE__->mk_classaccessor(qw/_ordered_columns/);
+
 __PACKAGE__->mk_group_accessors('simple' =>
   qw/_columns _primaries name resultset_class result_class schema/);
 
-=head1 NAME 
+=head1 NAME
 
 DBIx::Class::Table - Table object
 
@@ -21,7 +23,7 @@
 
 =head1 DESCRIPTION
 
-This class is responsible for defining and doing table-level operations on 
+This class is responsible for defining and doing table-level operations on
 L<DBIx::Class> classes.
 
 =head1 METHODS
@@ -33,6 +35,7 @@
   $class = ref $class if ref $class;
   my $new = bless({ %{$attrs || {}} }, $class);
   $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
+  $new->{_ordered_columns} ||= [];
   $new->{_columns} ||= {};
   $new->{name} ||= "!!NAME NOT SET!!";
   return $new;
@@ -40,6 +43,9 @@
 
 sub add_columns {
   my ($self, @cols) = @_;
+  $self->_ordered_columns( \@cols )
+    if !$self->_ordered_columns;
+  push @{ $self->_ordered_columns }, @cols;
   while (my $col = shift @cols) {
     $self->_columns->{$col} = (ref $cols[0] ? shift : {});
   }
@@ -69,27 +75,27 @@
   return $self->resultset_class->new($self);
 }
 
-=head2 has_column                                                                
-                                                                                
-  if ($obj->has_column($col)) { ... }                                           
-                                                                                
-Returns 1 if the table has a column of this name, 0 otherwise.                  
-                                                                                
-=cut                                                                            
+=head2 has_column
 
+  if ($obj->has_column($col)) { ... }
+
+Returns 1 if the table has a column of this name, 0 otherwise.
+
+=cut
+
 sub has_column {
   my ($self, $column) = @_;
   return exists $self->_columns->{$column};
 }
 
-=head2 column_info                                                               
-                                                                                
-  my $info = $obj->column_info($col);                                           
-                                                                                
+=head2 column_info
+
+  my $info = $obj->column_info($col);
+
 Returns the column metadata hashref for a column.
-                                                                                
-=cut                                                                            
 
+=cut
+
 sub column_info {
   my ($self, $column) = @_;
   croak "No such column $column" unless exists $self->_columns->{$column};
@@ -98,22 +104,27 @@
 
 =head2 columns
 
-  my @column_names = $obj->columns;                                             
-                                                                                
-=cut                                                                            
+  my @column_names = $obj->columns;
 
+=cut
+
 sub columns {
   croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
   return keys %{shift->_columns};
 }
 
-=head2 set_primary_key(@cols)                                                   
-                                                                                
-Defines one or more columns as primary key for this table. Should be            
+sub ordered_columns {
+  croak "ordered_columns() is a read-only accessor" if (@_ > 1);
+  return @{shift->_ordered_columns};
+}
+
+=head2 set_primary_key(@cols)
+
+Defines one or more columns as primary key for this table. Should be
 called after C<add_columns>.
-                                                                                
-=cut                                                                            
 
+=cut
+
 sub set_primary_key {
   my ($self, @cols) = @_;
   # check if primary key columns are valid columns
@@ -124,12 +135,12 @@
   $self->_primaries(\@cols);
 }
 
-=head2 primary_columns                                                          
-                                                                                
+=head2 primary_columns
+
 Read-only accessor which returns the list of primary keys.
-                                                                                
-=cut                                                                            
 
+=cut
+
 sub primary_columns {
   return @{shift->_primaries||[]};
 }