Merge 'trunk' into 'autocast'

r7389@hlagh (orig r7388):  ribasushi | 2009-08-25 07:43:38 -0400
typo
r7390@hlagh (orig r7389):  ribasushi | 2009-08-25 08:29:37 -0400
 r7354@Thesaurus (orig r7351):  abraxxa | 2009-08-20 17:46:06 +0200
 new branch grouped_has_many_join

 r7382@Thesaurus (orig r7379):  ribasushi | 2009-08-24 22:50:13 +0200
 Seems like abraxxa's bug is fixed
 r7385@Thesaurus (orig r7382):  ribasushi | 2009-08-25 11:33:40 +0200
 One more test

r7394@hlagh (orig r7393):  ribasushi | 2009-08-26 12:07:51 -0400
Stop testing deprecated json::syck
r7395@hlagh (orig r7394):  ribasushi | 2009-08-26 12:08:24 -0400
Make sure sqlt_type gets called after determining driver
r7396@hlagh (orig r7395):  ribasushi | 2009-08-26 12:21:53 -0400
Make POD::Coverage happy... again
r7397@hlagh (orig r7396):  ribasushi | 2009-08-26 12:31:54 -0400
Clarify
r7398@hlagh (orig r7397):  frew | 2009-08-26 16:24:19 -0400
Remove dead, sketchtowne link
r7402@hlagh (orig r7401):  ribasushi | 2009-08-27 12:50:12 -0400
Changes

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index a7080e2..2451f55 100644 (file)
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -814,7 +814,7 @@ sub connection {
 
   $storage_class = 'DBIx::Class::Storage'.$storage_class
     if $storage_class =~ m/^::/;
-  eval "require ${storage_class};";
+  eval { $self->ensure_class_loaded ($storage_class) };
   $self->throw_exception(
     "No arguments to load_classes and couldn't load ${storage_class} ($@)"
   ) if $@;

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 3be0981..d461a0f 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -2078,6 +2078,13 @@ sub last_insert_id {
   $self->dbh_do('_dbh_last_insert_id', @_);
 }
 
+# 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 sqlt_type
 
 Returns the database driver name.

diff --git a/lib/DBIx/Class/Storage/DBI/AutoCast.pm b/lib/DBIx/Class/Storage/DBI/AutoCast.pm
new file mode 100644 (file)
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 (file)
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;

diff --git a/t/36datetime.t b/t/inflate/datetime_determine_parser.t
similarity index 100%
rename from t/36datetime.t
rename to t/inflate/datetime_determine_parser.t

diff --git a/t/lib/DBICTest/Schema/Track.pm b/t/lib/DBICTest/Schema/Track.pm
index a6de595..d7ba952 100644 (file)
--- a/t/lib/DBICTest/Schema/Track.pm
+++ b/t/lib/DBICTest/Schema/Track.pm
@@ -14,7 +14,7 @@ __PACKAGE__->add_columns(
     data_type => 'integer',
   },
   'position' => {
-    data_type => 'integer',
+    data_type => 'int',
     accessor => 'pos',
   },
   'title' => {

diff --git a/t/lib/sqlite.sql b/t/lib/sqlite.sql
index 1938e87..a160193 100644 (file)
--- a/t/lib/sqlite.sql
+++ b/t/lib/sqlite.sql
@@ -1,6 +1,6 @@
 -- 
 -- Created by SQL::Translator::Producer::SQLite
--- Created on Thu Aug 20 07:47:13 2009
+-- Created on Tue Aug 25 12:34:34 2009
 -- 
 
 
@@ -283,7 +283,7 @@ CREATE INDEX self_ref_alias_idx_self_ref ON self_ref_alias (self_ref);
 CREATE TABLE track (
   trackid INTEGER PRIMARY KEY NOT NULL,
   cd integer NOT NULL,
-  position integer NOT NULL,
+  position int NOT NULL,
   title varchar(100) NOT NULL,
   last_updated_on datetime,
   last_updated_at datetime,

diff --git a/t/92storage.t b/t/storage/base.t
similarity index 100%
rename from t/92storage.t
rename to t/storage/base.t

diff --git a/t/dbh_do.t b/t/storage/dbh_do.t
similarity index 100%
rename from t/dbh_do.t
rename to t/storage/dbh_do.t

diff --git a/t/32connect_code_ref.t b/t/storage/dbi_coderef.t
similarity index 100%
rename from t/32connect_code_ref.t
rename to t/storage/dbi_coderef.t

diff --git a/t/91debug.t b/t/storage/debug.t
similarity index 100%
rename from t/91debug.t
rename to t/storage/debug.t

diff --git a/t/35disable_sth_caching.t b/t/storage/disable_sth_caching.t
similarity index 100%
rename from t/35disable_sth_caching.t
rename to t/storage/disable_sth_caching.t

diff --git a/t/18inserterror.t b/t/storage/error.t
similarity index 100%
rename from t/18inserterror.t
rename to t/storage/error.t

diff --git a/t/92storage_on_connect_call.t b/t/storage/on_connect_call.t
similarity index 98%
rename from t/92storage_on_connect_call.t
rename to t/storage/on_connect_call.t
index 09befcd..be5e746 100644 (file)
--- a/t/92storage_on_connect_call.t
+++ b/t/storage/on_connect_call.t
@@ -7,6 +7,7 @@ use DBICTest;
 
 use Test::More tests => 9;
 
+use DBIx::Class::Storage::DBI;
 my $schema = DBICTest->init_schema(
   no_connect  => 1,
   no_deploy   => 1,

diff --git a/t/92storage_on_connect_do.t b/t/storage/on_connect_do.t
similarity index 100%
rename from t/92storage_on_connect_do.t
rename to t/storage/on_connect_do.t

diff --git a/t/92storage_ping_count.t b/t/storage/ping_count.t
similarity index 100%
rename from t/92storage_ping_count.t
rename to t/storage/ping_count.t

diff --git a/t/33storage_reconnect.t b/t/storage/reconnect.t
similarity index 97%
rename from t/33storage_reconnect.t
rename to t/storage/reconnect.t
index 8f1eba1..5ef22f2 100644 (file)
--- a/t/33storage_reconnect.t
+++ b/t/storage/reconnect.t
@@ -9,7 +9,7 @@ use DBICTest;
 
 plan tests => 6;
 
-my $db_orig = "$FindBin::Bin/var/DBIxClass.db";
+my $db_orig = "$FindBin::Bin/../var/DBIxClass.db";
 my $db_tmp  = "$db_orig.tmp";
 
 # Set up the "usual" sqlite for DBICTest

diff --git a/t/93storage_replication.t b/t/storage/replication.t
similarity index 100%
rename from t/93storage_replication.t
rename to t/storage/replication.t

diff --git a/t/31stats.t b/t/storage/stats.t
similarity index 100%
rename from t/31stats.t
rename to t/storage/stats.t