[Bast-commits] r7962 - in DBIx-Class/0.08/branches/get_inflated_columns_rt46953: lib/DBIx/Class t/resultset

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2009-11-26 14:56:20 +0000 (Thu, 26 Nov 2009)
New Revision: 7962

Added:
   DBIx-Class/0.08/branches/get_inflated_columns_rt46953/t/resultset/plus_select.t
Modified:
   DBIx-Class/0.08/branches/get_inflated_columns_rt46953/lib/DBIx/Class/Row.pm
Log:
Fix for rt46953

Modified: DBIx-Class/0.08/branches/get_inflated_columns_rt46953/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/get_inflated_columns_rt46953/lib/DBIx/Class/Row.pm	2009-11-26 14:51:42 UTC (rev 7961)
+++ DBIx-Class/0.08/branches/get_inflated_columns_rt46953/lib/DBIx/Class/Row.pm	2009-11-26 14:56:20 UTC (rev 7962)
@@ -751,10 +751,27 @@
 
 sub get_inflated_columns {
   my $self = shift;
-  return map {
-    my $accessor = $self->column_info($_)->{'accessor'} || $_;
-    ($_ => $self->$accessor);
-  } grep $self->has_column_loaded($_), $self->columns;
+
+  my %loaded_colinfo = (map
+    { $_ => $self->column_info($_) }
+    (grep { $self->has_column_loaded($_) } $self->columns)
+  );
+
+  my %inflated;
+  for my $col (keys %loaded_colinfo) {
+    if (exists $loaded_colinfo{$col}{accessor}) {
+      my $acc = $loaded_colinfo{$col}{accessor};
+      if (defined $acc) {
+        $inflated{$col} = $self->$acc;
+      }
+    }
+    else {
+      $inflated{$col} = $self->$col;
+    }
+  }
+
+  # return all loaded columns with the inflations overlayed on top
+  return ($self->get_columns, %inflated);
 }
 
 =head2 set_column

Added: DBIx-Class/0.08/branches/get_inflated_columns_rt46953/t/resultset/plus_select.t
===================================================================
--- DBIx-Class/0.08/branches/get_inflated_columns_rt46953/t/resultset/plus_select.t	                        (rev 0)
+++ DBIx-Class/0.08/branches/get_inflated_columns_rt46953/t/resultset/plus_select.t	2009-11-26 14:56:20 UTC (rev 7962)
@@ -0,0 +1,63 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+my $cd_rs = $schema->resultset('CD')->search ({genreid => { '!=', undef } }, { order_by => 'cdid' });
+my $track_cnt = $cd_rs->search({}, { rows => 1 })->search_related ('tracks')->count;
+
+my %basecols = $cd_rs->first->get_columns;
+
+# the current implementation of get_inflated_columns will "inflate"
+# relationships by simply calling the accessor, when you have
+# identically named columns and relationships (you shouldn't anyway)
+# I consider this wrong, but at the same time appreciate the
+# ramifications of changing this. Thus the value override  and the
+# TODO to go with it. Delete all of this if ever resolved.
+my %todo_rel_inflation_override = ( artist => $basecols{artist} );
+TODO: {
+  local $TODO = 'Treating relationships as inflatable data is wrong - see comment in ' . __FILE__;
+  ok (! keys %todo_rel_inflation_override);
+}
+
+my $plus_rs = $cd_rs->search (
+  {},
+  { join => 'tracks', distinct => 1, '+select' => { count => 'tracks.trackid' }, '+as' => 'tr_cnt' },
+);
+
+is_deeply (
+  { $plus_rs->first->get_columns },
+  { %basecols, tr_cnt => $track_cnt },
+  'extra columns returned by get_columns',
+);
+
+is_deeply (
+  { $plus_rs->first->get_inflated_columns, %todo_rel_inflation_override },
+  { %basecols, tr_cnt => $track_cnt },
+  'extra columns returned by get_inflated_columns without inflatable columns',
+);
+
+SKIP: {
+  eval { require DateTime };
+  skip "Need DateTime for +select/get_inflated_columns tests" if $@;
+
+  $schema->class('CD')->inflate_column( 'year',
+    { inflate => sub { DateTime->new( year => shift ) },
+      deflate => sub { shift->year } }
+  );
+
+  $basecols{year} = DateTime->new ( year => $basecols{year} );
+
+  is_deeply (
+    { $plus_rs->first->get_inflated_columns, %todo_rel_inflation_override },
+    { %basecols, tr_cnt => $track_cnt },
+    'extra columns returned by get_inflated_columns',
+  );
+}
+
+done_testing;