begin work on column aliasing feature
Arthur Axel 'fREW' Schmidt [Thu, 23 Feb 2012 01:58:20 +0000 (19:58 -0600)]
Tests and attempt at initial implementation at a column aliasing feature
for queries. Specifying sql_alias => 'real_name' for a column in the
add_columns call would use the 'real_name' in SQL queries when the given
column name is encountered in a SQL::Abstract query.

lib/DBIx/Class/SQLMaker.pm
lib/DBIx/Class/Storage/DBI.pm
t/lib/DBICTest/Schema.pm
t/lib/DBICTest/Schema/BadNames1.pm [new file with mode: 0644]
t/sqlmaker/alias_column.t [new file with mode: 0644]

index 34b9c80..16c73cf 100644 (file)
@@ -43,7 +43,7 @@ use DBIx::Class::Carp;
 use DBIx::Class::Exception;
 use namespace::clean;
 
-__PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect/);
+__PACKAGE__->mk_group_accessors (simple => qw/quote_char name_sep limit_dialect storage/);
 
 # for when I need a normalized l/r pair
 sub _quote_chars {
@@ -91,10 +91,24 @@ sub __max_int () { 0x7FFFFFFF };
 
 # poor man's de-qualifier
 sub _quote {
-  $_[0]->next::method( ( $_[0]{_dequalify_idents} and ! ref $_[1] )
+  return undef if not defined $_[1];
+
+  my $col = ( $_[0]{_dequalify_idents} and ! ref $_[1] )
     ? $_[1] =~ / ([^\.]+) $ /x
     : $_[1]
-  );
+  ;
+
+  if (
+    $_[0]->{FROM}
+      and
+    $_[0]->storage
+      and
+    my $alias = ($_[0]->storage->_resolve_column_info($_[0]->{FROM}, [$col]) || {})->{$col}{sql_alias}
+  ) {
+    $col =~ s/[^\.]+$/$alias/;
+  }
+
+  $_[0]->next::method( $col );
 }
 
 sub _where_op_NEST {
@@ -110,6 +124,7 @@ sub select {
   my ($self, $table, $fields, $where, $rs_attrs, $limit, $offset) = @_;
 
 
+  local $self->{FROM} = $table;
   $fields = $self->_recurse_fields($fields);
 
   if (defined $offset) {
@@ -194,6 +209,7 @@ sub insert {
 # optimized due to hotttnesss
 #  my ($self, $table, $data, $options) = @_;
 
+  local $_[0]->{FROM} = $_[1];
   # SQLA will emit INSERT INTO $table ( ) VALUES ( )
   # which is sadly understood only by MySQL. Change default behavior here,
   # until SQLA2 comes with proper dialect support
@@ -215,6 +231,17 @@ sub insert {
   next::method(@_);
 }
 
+sub update {
+  local $_[0]->{FROM} = $_[1];
+
+  shift->next::method(@_);
+}
+
+sub delete {
+
+  shift->next::method(@_);
+}
+
 sub _recurse_fields {
   my ($self, $fields) = @_;
   my $ref = ref $fields;
index 5332582..68bb845 100644 (file)
@@ -986,14 +986,18 @@ sub sql_maker {
     }
 
     $self->_sql_maker($sql_maker_class->new(
-      bindtype=>'columns',
+      bindtype => 'columns',
       array_datatypes => 1,
       limit_dialect => $dialect,
       ($quote_char ? (quote_char => $quote_char) : ()),
       name_sep => ($name_sep || '.'),
+      storage => $self,
       %opts,
     ));
+
+    weaken($self->_sql_maker->{storage});
   }
+
   return $self->_sql_maker;
 }
 
index 8abb593..3a4dddc 100644 (file)
@@ -18,6 +18,7 @@ __PACKAGE__->mk_group_accessors(simple => 'custom_attr');
 
 __PACKAGE__->load_classes(qw/
   Artist
+  BadNames1
   SequenceTest
   BindType
   Employee
diff --git a/t/lib/DBICTest/Schema/BadNames1.pm b/t/lib/DBICTest/Schema/BadNames1.pm
new file mode 100644 (file)
index 0000000..06583d3
--- /dev/null
@@ -0,0 +1,20 @@
+package # hide from PAUSE
+    DBICTest::Schema::BadNames1;
+
+use base qw/DBICTest::BaseResult/;
+
+__PACKAGE__->table('bad_names_1');
+
+__PACKAGE__->add_columns(
+  id => {
+    data_type => 'integer',
+    is_auto_increment => 1,
+  },
+  'good_name' => {
+    data_type => 'int',
+    is_nullable => 1,
+    sql_alias => 'stupid_name',
+  },
+);
+__PACKAGE__->set_primary_key('id');
+1;
diff --git a/t/sqlmaker/alias_column.t b/t/sqlmaker/alias_column.t
new file mode 100644 (file)
index 0000000..c5b6b0f
--- /dev/null
@@ -0,0 +1,61 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+use DBIC::SqlMakerTest;
+
+
+use_ok('DBICTest');
+use_ok('DBIC::DebugObj');
+my $schema = DBICTest->init_schema();
+
+my ($sql, @bind);
+$schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
+$schema->storage->debug(1);
+
+my $rs = $schema->resultset('BadNames1');
+
+eval {
+   $rs->create({ good_name => 2002, })
+};
+
+is_same_sql_bind(
+  $sql, \@bind,
+  "INSERT INTO bad_names_1( stupid_name ) VALUES ( ? )", ["'2002'"],
+  'insert'
+);
+
+eval {
+   $rs->search({ 'me.good_name' => 2001 })->all
+};
+
+is_same_sql_bind(
+  $sql, \@bind,
+  "SELECT me.id, me.stupid_name FROM bad_names_1 me WHERE ( me.stupid_name = ? )", ["'2001'"],
+  'select'
+);
+
+eval {
+   $rs->search({ 'me.good_name' => 2001 })->update({ good_name => 2112 })
+};
+
+
+is_same_sql_bind(
+  $sql, \@bind,
+  "UPDATE bad_names_1 SET stupid_name = ? WHERE ( stupid_name = ? )", ["'2112'", "'2001'"],
+  'update'
+);
+
+eval {
+   $rs->search({ 'me.good_name' => 2001 })->delete
+};
+
+is_same_sql_bind(
+  $sql, \@bind,
+  "DELETE FROM bad_names_1 WHERE ( me.stupid_name = ? )", ["'2001'"],
+  'delete'
+);
+
+done_testing;