From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 25 Aug 2009 10:45:52 +0000 (+0000)
Subject: Actual autocast code
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d047d650648a9566e84ca994cf699eebaf0cd156;p=dbsrgits%2FDBIx-Class-Historic.git

Actual autocast code
---

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index e08ff9c..91ea170 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -2041,6 +2041,13 @@ Returns the database driver name.
 
 sub sqlt_type { shift->_get_dbh->{Driver}->{Name} }
 
+# By default there is no resolution of DBIC data types to DBI data types
+# In essence this makes e.g. AutoCast a noop
+sub _dbi_data_type {
+  #my ($self, $data_type) = @_;
+  return undef
+};
+
 =head2 bind_attribute_by_data_type
 
 Given a datatype from column info, returns a database specific bind
diff --git a/lib/DBIx/Class/Storage/DBI/AutoCast.pm b/lib/DBIx/Class/Storage/DBI/AutoCast.pm
new file mode 100644
index 0000000..e405d02
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/AutoCast.pm
@@ -0,0 +1,74 @@
+package DBIx::Class::Storage::DBI::AutoCast;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+__PACKAGE__->mk_group_accessors('simple' => 'auto_cast' );
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::AutoCast
+
+=head1 SYNOPSIS
+
+  $schema->storage->auto_cast(1);
+
+=head1 DESCRIPTION
+
+Some combinations of RDBMS and DBD drivers (e.g. FreeTDS and Sybase)
+statements with values bound to columns or conditions that are not strings
+will throw implicit type conversion errors.
+
+As long as a column L<data_type|DBIx::Class::ResultSource/add_columns> is
+defined, and it resolves to a L<DBI> C<$dbi_type> via C<_dbi_data_type()>
+as defined in your Storage driver, the placeholder for this column will
+be converted to:
+
+  CAST(? as $dbi_type)
+
+=cut
+
+sub _prep_for_execute {
+  my $self = shift;
+  my ($op, $extra_bind, $ident, $args) = @_;
+
+  my ($sql, $bind) = $self->next::method (@_);
+
+# If we're using ::NoBindVars, there are no binds by this point so this code
+# gets skippeed.
+  if ($self->auto_cast && @$bind) {
+    my $new_sql;
+    my @sql_part = split /\?/, $sql;
+    my $col_info = $self->_resolve_column_info($ident,[ map $_->[0], @$bind ]);
+
+    foreach my $bound (@$bind) {
+      my $col = $bound->[0];
+      my $dbi_type = $self->_dbi_data_type($col_info->{$col}{data_type});
+
+      foreach my $data (@{$bound}[1..$#$bound]) {   # <--- this will multiply the amount of ?'s no...?
+        $new_sql .= shift(@sql_part) .
+          ($dbi_type ? "CAST(? AS $dbi_type)" : '?');
+      }
+    }
+    $new_sql .= join '', @sql_part;
+    $sql = $new_sql;
+  }
+
+  return ($sql, $bind);
+}
+
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/t/93autocast.t b/t/93autocast.t
new file mode 100644
index 0000000..bbedcab
--- /dev/null
+++ b/t/93autocast.t
@@ -0,0 +1,74 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+{ # Fake storage driver for sqlite with autocast
+    package DBICTest::SQLite::AutoCast;
+    use base qw/
+        DBIx::Class::Storage::DBI::AutoCast
+        DBIx::Class::Storage::DBI::SQLite
+    /;
+    use mro 'c3';
+
+    my $type_map = {
+      datetime => 'DateTime',
+      integer => 'INT',
+      int => undef, # no conversion
+    };
+
+    sub _dbi_data_type {
+      return $type_map->{$_[1]};
+    }
+}
+
+my $schema = DBICTest->init_schema (storage_type => 'DBICTest::SQLite::AutoCast');
+
+# 'me.id' will be cast unlike the unqualified 'id'
+my $rs = $schema->resultset ('CD')->search ({
+  cdid => { '>', 5 },
+  'tracks.last_updated_at' => { '!=', undef },
+  'tracks.last_updated_on' => { '<', 2009 },
+  'tracks.position' => 4,
+}, { join => 'tracks' });
+
+my $bind = [ [ cdid => 5 ], [ 'tracks.last_updated_on' => 2009 ], [ 'tracks.position' => 4 ] ];
+
+is_same_sql_bind (
+  $rs->as_query,
+  '(
+    SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+      FROM cd me
+      LEFT JOIN track tracks ON tracks.cd = me.cdid
+    WHERE
+          cdid > ?
+      AND tracks.last_updated_at IS NOT NULL
+      AND tracks.last_updated_on < ?
+      AND tracks.position = ?
+  )',
+  $bind,
+  'expected sql with casting off',
+);
+
+$schema->storage->auto_cast (1);
+
+is_same_sql_bind (
+  $rs->as_query,
+  '(
+    SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+      FROM cd me
+      LEFT JOIN track tracks ON tracks.cd = me.cdid
+    WHERE
+          cdid > CAST(? AS INT)
+      AND tracks.last_updated_at IS NOT NULL
+      AND tracks.last_updated_on < CAST (? AS yyy)
+      AND tracks.position = ?
+  )',
+  $bind,
+  'expected sql with casting on',
+);
+
+done_testing;