[Dbix-class] Controlling column order

[Matt S Trout]

On Thu, Jan 12, 2006 at 10:33:56AM +0000, Will Hawes wrote:
> 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.

Why the classaccessor rather than creating _ordered_columns as part of the
simple group along with everything else?

> 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||[]};
>  }

> _______________________________________________
> List: http://lists.rawmode.org/cgi-bin/mailman/listinfo/dbix-class
> Wiki: http://dbix-class.shadowcatsystems.co.uk/
> IRC: irc.perl.org#dbix-class
> SVN: http://dev.catalyst.perl.org/repos/bast/trunk/DBIx-Class/

-- 
     Matt S Trout       Offering custom development, consultancy and support
  Technical Director    contracts for Catalyst, DBIx::Class and BAST. Contact
Shadowcat Systems Ltd.  mst (at) shadowcatsystems.co.uk for more information

 + Help us build a better perl ORM: http://dbix-class.shadowcatsystems.co.uk/ +