Merge 'trunk' into 'sybase'
Rafael Kitover [Sat, 29 Aug 2009 06:50:56 +0000 (06:50 +0000)]
r7370@hlagh (orig r7369):  caelum | 2009-08-24 06:32:57 -0400
bump CAG dep
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
r7404@hlagh (orig r7403):  ribasushi | 2009-08-27 18:11:29 -0400
Add a test proving how dumb I am
r7405@hlagh (orig r7404):  ribasushi | 2009-08-28 10:34:46 -0400
Warning to spare mst explanations
r18700@hlagh (orig r7419):  caelum | 2009-08-29 02:34:07 -0400
 r7381@hlagh (orig r7380):  ribasushi | 2009-08-24 17:07:58 -0400
 Branch to add autocast support as a standalone piece of code
 r7382@hlagh (orig r7381):  ribasushi | 2009-08-25 05:06:43 -0400
 Move storage tests to their own dir
 r7385@hlagh (orig r7384):  ribasushi | 2009-08-25 06:35:19 -0400
 Switch storage class loading to ensure_class_loaded
 r7386@hlagh (orig r7385):  ribasushi | 2009-08-25 06:37:48 -0400
 Change a datatype for test purposes
 r7387@hlagh (orig r7386):  ribasushi | 2009-08-25 06:45:35 -0400
 Fix two storage tests
 r7388@hlagh (orig r7387):  ribasushi | 2009-08-25 06:45:52 -0400
 Actual autocast code
 r18697@hlagh (orig r7416):  caelum | 2009-08-29 01:42:29 -0400
 rename method and add docs
 r18698@hlagh (orig r7417):  ribasushi | 2009-08-29 02:07:18 -0400
 Make sure arrays work
 r18699@hlagh (orig r7418):  caelum | 2009-08-29 02:11:14 -0400
 rename _map_data_type to _native_data_type

29 files changed:
Changes
Makefile.PL
lib/DBIx/Class/InflateColumn/DateTime.pm
lib/DBIx/Class/Manual/FAQ.pod
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/Schema.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBI/AutoCast.pm [new file with mode: 0644]
t/03podcoverage.t
t/72pg.t
t/89dbicadmin.t
t/93autocast.t [new file with mode: 0644]
t/inflate/datetime_determine_parser.t [moved from t/36datetime.t with 100% similarity]
t/lib/DBICTest/Schema/Track.pm
t/lib/sqlite.sql
t/prefetch/grouped.t
t/search/subquery.t
t/storage/base.t [moved from t/92storage.t with 100% similarity]
t/storage/dbh_do.t [moved from t/dbh_do.t with 100% similarity]
t/storage/dbi_coderef.t [moved from t/32connect_code_ref.t with 100% similarity]
t/storage/debug.t [moved from t/91debug.t with 100% similarity]
t/storage/disable_sth_caching.t [moved from t/35disable_sth_caching.t with 100% similarity]
t/storage/error.t [moved from t/18inserterror.t with 100% similarity]
t/storage/on_connect_call.t [moved from t/92storage_on_connect_call.t with 98% similarity]
t/storage/on_connect_do.t [moved from t/92storage_on_connect_do.t with 100% similarity]
t/storage/ping_count.t [moved from t/92storage_ping_count.t with 100% similarity]
t/storage/reconnect.t [moved from t/33storage_reconnect.t with 97% similarity]
t/storage/replication.t [moved from t/93storage_replication.t with 100% similarity]
t/storage/stats.t [moved from t/31stats.t with 100% similarity]

diff --git a/Changes b/Changes
index e47fc10..18b153f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -4,9 +4,17 @@ Revision history for DBIx::Class
           - Support for TEXT/IMAGE columns
           - Support for the 'money' datatype
           - Transaction savepoints support
-          - Support for bind variables when connecting via Sybase OpenClient
+          - Support for bind variables when connecting to a newer Sybase with
+            OpenClient libraries
+          - Support for bind variables over FreeTDS with CASTs when needed
           - Support for interpolated variables with proper quoting when
-            connecting via FreeTDS
+            connecting to an older Sybase or via FreeTDS
+        - Fixed a complex prefetch + regular join regression introduced
+          in 0.08108
+        - SQLT related fixes:
+          - sqlt_type is now called on the correct storage object
+          - hooks can now see the correct producer_type
+        - POD improvements
 
 0.08109 2009-08-18 08:35:00 (UTC)
         - Replication updates:
index a5e2f6f..d1dcf06 100644 (file)
@@ -29,7 +29,7 @@ requires 'Encode'                   => 0 if ($] <= 5.008000);
 
 # Dependencies (keep in alphabetical order)
 requires 'Carp::Clan'               => 6.0;
-requires 'Class::Accessor::Grouped' => 0.08003;
+requires 'Class::Accessor::Grouped' => 0.09000;
 requires 'Class::C3::Componentised' => 1.0005;
 requires 'Class::Inspector'         => 1.24;
 requires 'Data::Page'               => 2.00;
index a7a13a6..35aa3e6 100644 (file)
@@ -71,7 +71,7 @@ that this feature is new as of 0.07, so it may not be perfect yet - bug
 reports to the list very much welcome).
 
 If the data_type of a field is C<date>, C<datetime> or C<timestamp> (or
-a derivative of these datatypes, e.g. C<timestamp with timezone>, this
+a derivative of these datatypes, e.g. C<timestamp with timezone>), this
 module will automatically call the appropriate parse/format method for
 deflation/inflation as defined in the storage class. For instance, for
 a C<datetime> field the methods C<parse_datetime> and C<format_datetime>
index d0f6634..05e057a 100644 (file)
@@ -26,8 +26,7 @@ need to do is to install L<DBD::SQLite> from CPAN, and it's usable).
 
 Next, spend some time defining which data you need to store, and how
 it relates to the other data you have. For some help on normalisation,
-go to L<http://b62.tripod.com/doc/dbbase.htm> or
-L<http://209.197.234.36/db/simple.html>.
+go to L<http://b62.tripod.com/doc/dbbase.htm>.
 
 Now, decide whether you want to have the database itself be the
 definitive source of information about the data layout, or your
index 77732e0..ae15cde 100644 (file)
@@ -2278,6 +2278,19 @@ C<belongs_to>resultset. Note Hashref.
     }
   });
 
+=over
+
+=item WARNING
+
+When subclassing ResultSet never attempt to override this method. Since
+it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a
+lot of the internals simply never call it, so your override will be
+bypassed more often than not. Override either L<new|DBIx::Class::Row/new>
+or L<insert|DBIx::Class::Row/insert> depending on how early in the
+L</create> process you need to intervene.
+
+=back
+
 =cut
 
 sub create {
index a7080e2..2451f55 100644 (file)
@@ -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 $@;
index 0d8a855..1c1ddfe 100644 (file)
@@ -1597,179 +1597,224 @@ sub _select_args {
 sub _adjust_select_args_for_complex_prefetch {
   my ($self, $from, $select, $where, $attrs) = @_;
 
-  $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
-    if (ref $from ne 'ARRAY');
-
-  # copies for mangling
-  $from = [ @$from ];
-  $select = [ @$select ];
-  $attrs = { %$attrs };
+  $self->throw_exception ('Nothing to prefetch... how did we get here?!')
+    if not @{$attrs->{_prefetch_select}};
 
-  # separate attributes
-  my $sub_attrs = { %$attrs };
-  delete $attrs->{$_} for qw/where bind rows offset group_by having/;
-  delete $sub_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/;
+  $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
+    if (ref $from ne 'ARRAY' || ref $from->[0] ne 'HASH' || ref $from->[1] ne 'ARRAY');
 
-  my $select_root_alias = $attrs->{alias};
-  my $sql_maker = $self->sql_maker;
 
-  # create subquery select list - consider only stuff *not* brought in by the prefetch
-  my $sub_select = [];
-  my $sub_group_by;
-  for my $i (0 .. @{$attrs->{select}} - @{$attrs->{_prefetch_select}} - 1) {
-    my $sel = $attrs->{select}[$i];
+  # generate inner/outer attribute lists, remove stuff that doesn't apply
+  my $outer_attrs = { %$attrs };
+  delete $outer_attrs->{$_} for qw/where bind rows offset group_by having/;
 
-    # alias any functions to the dbic-side 'as' label
-    # adjust the outer select accordingly
-    if (ref $sel eq 'HASH' ) {
-      $sel->{-as} ||= $attrs->{as}[$i];
-      $select->[$i] = join ('.', $attrs->{alias}, ($sel->{-as} || "select_$i") );
-    }
+  my $inner_attrs = { %$attrs };
+  delete $inner_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/;
 
-    push @$sub_select, $sel;
-  }
 
   # bring over all non-collapse-induced order_by into the inner query (if any)
   # the outer one will have to keep them all
-  delete $sub_attrs->{order_by};
-  if (my $ord_cnt = @{$attrs->{order_by}} - @{$attrs->{_collapse_order_by}} ) {
-    $sub_attrs->{order_by} = [
-      @{$attrs->{order_by}}[ 0 .. $ord_cnt - 1]
+  delete $inner_attrs->{order_by};
+  if (my $ord_cnt = @{$outer_attrs->{order_by}} - @{$outer_attrs->{_collapse_order_by}} ) {
+    $inner_attrs->{order_by} = [
+      @{$outer_attrs->{order_by}}[ 0 .. $ord_cnt - 1]
     ];
   }
 
-  # mangle {from}, keep in mind that $from is "headless" from here on
-  my $join_root = shift @$from;
 
-  my %inner_joins;
-  my %join_info = map { $_->[0]{-alias} => $_->[0] } (@$from);
+  # generate the inner/outer select lists
+  # for inside we consider only stuff *not* brought in by the prefetch
+  # on the outside we substitute any function for its alias
+  my $outer_select = [ @$select ];
+  my $inner_select = [];
+  for my $i (0 .. ( @$outer_select - @{$outer_attrs->{_prefetch_select}} - 1) ) {
+    my $sel = $outer_select->[$i];
 
-  # in complex search_related chains $select_root_alias may *not* be
-  # 'me' so always include it in the inner join
-  $inner_joins{$select_root_alias} = 1 if ($join_root->{-alias} ne $select_root_alias);
+    if (ref $sel eq 'HASH' ) {
+      $sel->{-as} ||= $attrs->{as}[$i];
+      $outer_select->[$i] = join ('.', $attrs->{alias}, ($sel->{-as} || "inner_column_$i") );
+    }
 
+    push @$inner_select, $sel;
+  }
 
-  # decide which parts of the join will remain on the inside
-  #
-  # this is not a very viable optimisation, but it was written
-  # before I realised this, so might as well remain. We can throw
-  # away _any_ branches of the join tree that are:
-  # 1) not mentioned in the condition/order
-  # 2) left-join leaves (or left-join leaf chains)
-  # Most of the join conditions will not satisfy this, but for real
-  # complex queries some might, and we might make some RDBMS happy.
-  #
-  #
-  # since we do not have introspectable SQLA, we fall back to ugly
-  # scanning of raw SQL for WHERE, and for pieces of ORDER BY
-  # in order to determine what goes into %inner_joins
+  # normalize a copy of $from, so it will be easier to work with further
+  # down (i.e. promote the initial hashref to an AoH)
+  $from = [ @$from ];
+  $from->[0] = [ $from->[0] ];
+  my %original_join_info = map { $_->[0]{-alias} => $_->[0] } (@$from);
+
+
+  # decide which parts of the join will remain in either part of
+  # the outer/inner query
+
+  # First we compose a list of which aliases are used in restrictions
+  # (i.e. conditions/order/grouping/etc). Since we do not have
+  # introspectable SQLA, we fall back to ugly scanning of raw SQL for
+  # WHERE, and for pieces of ORDER BY in order to determine which aliases
+  # need to appear in the resulting sql.
   # It may not be very efficient, but it's a reasonable stop-gap
+  # Also unqualified column names will not be considered, but more often
+  # than not this is actually ok
+  #
+  # In the same loop we enumerate part of the selection aliases, as
+  # it requires the same sqla hack for the time being
+  my ($restrict_aliases, $select_aliases, $prefetch_aliases);
   {
     # produce stuff unquoted, so it can be scanned
+    my $sql_maker = $self->sql_maker;
     local $sql_maker->{quote_char};
     my $sep = $self->_sql_maker_opts->{name_sep} || '.';
     $sep = "\Q$sep\E";
 
-    my @order_by = (map
+    my $non_prefetch_select_sql = $sql_maker->_recurse_fields ($inner_select);
+    my $prefetch_select_sql = $sql_maker->_recurse_fields ($outer_attrs->{_prefetch_select});
+    my $where_sql = $sql_maker->where ($where);
+    my $group_by_sql = $sql_maker->_order_by({
+      map { $_ => $inner_attrs->{$_} } qw/group_by having/
+    });
+    my @non_prefetch_order_by_chunks = (map
       { ref $_ ? $_->[0] : $_ }
-      $sql_maker->_order_by_chunks ($sub_attrs->{order_by})
+      $sql_maker->_order_by_chunks ($inner_attrs->{order_by})
     );
 
-    my $where_sql = $sql_maker->where ($where);
-    my $select_sql = $sql_maker->_recurse_fields ($sub_select);
 
-    # sort needed joins
-    for my $alias (keys %join_info) {
+    for my $alias (keys %original_join_info) {
+      my $seen_re = qr/\b $alias $sep/x;
 
-      # any table alias found on a column name in where or order_by
-      # gets included in %inner_joins
-      # Also any parent joins that are needed to reach this particular alias
-      for my $piece ($select_sql, $where_sql, @order_by ) {
-        if ($piece =~ /\b $alias $sep/x) {
-          $inner_joins{$alias} = 1;
+      for my $piece ($where_sql, $group_by_sql, @non_prefetch_order_by_chunks ) {
+        if ($piece =~ $seen_re) {
+          $restrict_aliases->{$alias} = 1;
         }
       }
+
+      if ($non_prefetch_select_sql =~ $seen_re) {
+          $select_aliases->{$alias} = 1;
+      }
+
+      if ($prefetch_select_sql =~ $seen_re) {
+          $prefetch_aliases->{$alias} = 1;
+      }
+
     }
   }
 
-  # scan for non-leaf/non-left joins and mark as needed
-  # also mark all ancestor joins that are needed to reach this particular alias
-  # (e.g.  join => { cds => 'tracks' } - tracks will bring cds too )
-  #
-  # traverse by the size of the -join_path i.e. reverse depth first
-  for my $alias (sort { @{$join_info{$b}{-join_path}} <=> @{$join_info{$a}{-join_path}} } (keys %join_info) ) {
-
-    my $j = $join_info{$alias};
-    $inner_joins{$alias} = 1 if (! $j->{-join_type} || ($j->{-join_type} !~ /^left$/i) );
+  # Add any non-left joins to the restriction list (such joins are indeed restrictions)
+  for my $j (values %original_join_info) {
+    my $alias = $j->{-alias} or next;
+    $restrict_aliases->{$alias} = 1 if (
+      (not $j->{-join_type})
+        or
+      ($j->{-join_type} !~ /^left (?: \s+ outer)? $/xi)
+    );
+  }
 
-    if ($inner_joins{$alias}) {
-      $inner_joins{$_} = 1 for (@{$j->{-join_path}});
+  # mark all join parents as mentioned
+  # (e.g.  join => { cds => 'tracks' } - tracks will need to bring cds too )
+  for my $collection ($restrict_aliases, $select_aliases) {
+    for my $alias (keys %$collection) {
+      $collection->{$_} = 1
+        for (@{ $original_join_info{$alias}{-join_path} || [] });
     }
   }
 
   # construct the inner $from for the subquery
-  my $inner_from = [ $join_root ];
+  my %inner_joins = (map { %{$_ || {}} } ($restrict_aliases, $select_aliases) );
+  my @inner_from;
   for my $j (@$from) {
-    push @$inner_from, $j if $inner_joins{$j->[0]{-alias}};
+    push @inner_from, $j if $inner_joins{$j->[0]{-alias}};
   }
 
   # if a multi-type join was needed in the subquery ("multi" is indicated by
   # presence in {collapse}) - add a group_by to simulate the collapse in the subq
-  unless ($sub_attrs->{group_by}) {
+  unless ($inner_attrs->{group_by}) {
     for my $alias (keys %inner_joins) {
 
       # the dot comes from some weirdness in collapse
       # remove after the rewrite
       if ($attrs->{collapse}{".$alias"}) {
-        $sub_attrs->{group_by} ||= $sub_select;
+        $inner_attrs->{group_by} ||= $inner_select;
         last;
       }
     }
   }
 
+  # demote the inner_from head
+  $inner_from[0] = $inner_from[0][0];
+
   # generate the subquery
   my $subq = $self->_select_args_to_query (
-    $inner_from,
-    $sub_select,
+    \@inner_from,
+    $inner_select,
     $where,
-    $sub_attrs
+    $inner_attrs,
   );
+
   my $subq_joinspec = {
-    -alias => $select_root_alias,
-    -source_handle => $join_root->{-source_handle},
-    $select_root_alias => $subq,
+    -alias => $attrs->{alias},
+    -source_handle => $inner_from[0]{-source_handle},
+    $attrs->{alias} => $subq,
   };
 
-  # Generate a new from (really just replace the join slot with the subquery)
-  # Before we would start the outer chain from the subquery itself (i.e.
-  # SELECT ... FROM (SELECT ... ) alias JOIN ..., but this turned out to be
-  # a bad idea for search_related, as the root of the chain was effectively
-  # lost (i.e. $artist_rs->search_related ('cds'... ) would result in alias
-  # of 'cds', which would prevent from doing things like order_by artist.*)
-  # See t/prefetch/via_search_related.t for a better idea
+  # Generate the outer from - this is relatively easy (really just replace
+  # the join slot with the subquery), with a major caveat - we can not
+  # join anything that is non-selecting (not part of the prefetch), but at
+  # the same time is a multi-type relationship, as it will explode the result.
+  #
+  # There are two possibilities here
+  # - either the join is non-restricting, in which case we simply throw it away
+  # - it is part of the restrictions, in which case we need to collapse the outer
+  #   result by tackling yet another group_by to the outside of the query
+
+  # so first generate the outer_from, up to the substitution point
   my @outer_from;
-  if ($join_root->{-alias} eq $select_root_alias) { # just swap the root part and we're done
-    @outer_from = (
-      $subq_joinspec,
-      @$from,
-    )
-  }
-  else {  # this is trickier
-    @outer_from = ($join_root);
-
-    for my $j (@$from) {
-      if ($j->[0]{-alias} eq $select_root_alias) {
-        push @outer_from, [
-          $subq_joinspec,
-          @{$j}[1 .. $#$j],
-        ];
-      }
-      else {
-        push @outer_from, $j;
-      }
+  while (my $j = shift @$from) {
+    if ($j->[0]{-alias} eq $attrs->{alias}) { # time to swap
+      push @outer_from, [
+        $subq_joinspec,
+        @{$j}[1 .. $#$j],
+      ];
+      last; # we'll take care of what's left in $from below
+    }
+    else {
+      push @outer_from, $j;
+    }
+  }
+
+  # see what's left - throw away if not selecting/restricting
+  # also throw in a group_by if restricting to guard against
+  # cross-join explosions
+  #
+  while (my $j = shift @$from) {
+    my $alias = $j->[0]{-alias};
+
+    if ($select_aliases->{$alias} || $prefetch_aliases->{$alias}) {
+      push @outer_from, $j;
+    }
+    elsif ($restrict_aliases->{$alias}) {
+      push @outer_from, $j;
+
+      # FIXME - this should be obviated by SQLA2, as I'll be able to 
+      # have restrict_inner and restrict_outer... or something to that
+      # effect... I think...
+
+      # FIXME2 - I can't find a clean way to determine if a particular join
+      # is a multi - instead I am just treating everything as a potential
+      # explosive join (ribasushi)
+      #
+      # if (my $handle = $j->[0]{-source_handle}) {
+      #   my $rsrc = $handle->resolve;
+      #   ... need to bail out of the following if this is not a multi,
+      #       as it will be much easier on the db ...
+
+          $outer_attrs->{group_by} ||= $outer_select;
+      # }
     }
   }
 
+  # demote the outer_from head
+  $outer_from[0] = $outer_from[0][0];
+
   # This is totally horrific - the $where ends up in both the inner and outer query
   # Unfortunately not much can be done until SQLA2 introspection arrives, and even
   # then if where conditions apply to the *right* side of the prefetch, you may have
@@ -1777,7 +1822,7 @@ sub _adjust_select_args_for_complex_prefetch {
   # the outer select to exclude joins you didin't want in the first place
   #
   # OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
-  return (\@outer_from, $select, $where, $attrs);
+  return (\@outer_from, $outer_select, $where, $outer_attrs);
 }
 
 sub _resolve_ident_sources {
@@ -2065,14 +2110,36 @@ sub last_insert_id {
   $self->dbh_do('_dbh_last_insert_id', @_);
 }
 
-=head2 sqlt_type
+=head2 _native_data_type
 
-Returns the database driver name.
+=over 4
 
-=cut
+=item Arguments: $type_name
+
+=back
+
+This API is B<EXPERIMENTAL>, will almost definitely change in the future, and
+currently only used by L<::AutoCast|DBIx::Class::Storage::DBI::AutoCast> and
+L<::Sybase|DBIx::Class::Storage::DBI::Sybase>.
+
+The default implementation returns C<undef>, implement in your Storage driver if
+you need this functionality.
 
-sub sqlt_type { shift->_get_dbh->{Driver}->{Name} }
+Should map types from other databases to the native RDBMS type, for example
+C<VARCHAR2> to C<VARCHAR>.
 
+Types with modifiers should map to the underlying data type. For example,
+C<INTEGER AUTO_INCREMENT> should become C<INTEGER>.
+
+Composite types should map to the container type, for example
+C<ENUM(foo,bar,baz)> becomes C<ENUM>.
+
+=cut
+
+sub _native_data_type {
+  #my ($self, $data_type) = @_;
+  return undef
+}
 
 # Check if placeholders are supported at all
 sub _placeholders_supported {
@@ -2104,6 +2171,22 @@ sub _typeless_placeholders_supported {
   return $@ ? 0 : 1;
 }
 
+=head2 sqlt_type
+
+Returns the database driver name.
+
+=cut
+
+sub sqlt_type {
+  my ($self) = @_;
+
+  if (not $self->_driver_determined) {
+    $self->_determine_driver;
+    goto $self->can ('sqlt_type');
+  }
+
+  $self->_get_dbh->{Driver}->{Name};
+}
 
 =head2 bind_attribute_by_data_type
 
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..3391cfb
--- /dev/null
@@ -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
+
+In 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 base RDBMS native type via L</_native_data_type> as
+defined in your Storage driver, the placeholder for this column will be
+converted to:
+
+  CAST(? as $mapped_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 $type = $self->_native_data_type($col_info->{$col}{data_type});
+
+      foreach my $data (@{$bound}[1..$#$bound]) {
+        $new_sql .= shift(@sql_part) .
+          ($type ? "CAST(? AS $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;
index 65e61a1..a2eaa47 100644 (file)
@@ -22,41 +22,48 @@ plan tests => scalar(@modules);
 #             do not need to be documented.
 my $exceptions = {
     'DBIx::Class' => {
-        ignore => [
-            qw/MODIFY_CODE_ATTRIBUTES
-              component_base_class
-              mk_classdata
-              mk_classaccessor/
-        ]
+        ignore => [qw/
+            MODIFY_CODE_ATTRIBUTES
+            component_base_class
+            mk_classdata
+            mk_classaccessor
+        /]
     },
     'DBIx::Class::Row' => {
-        ignore => [
-           qw( MULTICREATE_DEBUG )
-        ],
+        ignore => [qw/
+            MULTICREATE_DEBUG
+        /],
     },
     'DBIx::Class::ResultSource' => {
         ignore => [qw/
-          compare_relationship_keys
-          pk_depends_on
-          resolve_condition
-          resolve_join
-          resolve_prefetch
+            compare_relationship_keys
+            pk_depends_on
+            resolve_condition
+            resolve_join
+            resolve_prefetch
+        /],
+    },
+    'DBIx::Class::ResultSourceHandle' => {
+        ignore => [qw/
+            schema
+            source_moniker
         /],
     },
     'DBIx::Class::Storage' => {
-        ignore => [
-            qw(cursor)
-        ]
+        ignore => [qw/
+            schema
+            cursor
+        /]
     },
     'DBIx::Class::Schema' => {
-        ignore => [
-            qw(setup_connection_class)
-        ]
+        ignore => [qw/
+            setup_connection_class
+        /]
     },
     'DBIx::Class::Storage::DBI::Sybase' => {
-        ignore => [
-            qw/should_quote_data_type/,
-        ]
+        ignore => [qw/
+            should_quote_data_type
+        /]
     },
     'DBIx::Class::CDBICompat::AccessorMapping'          => { skip => 1 },
     'DBIx::Class::CDBICompat::AbstractSearch' => {
@@ -105,6 +112,7 @@ my $exceptions = {
     'DBIx::Class::ResultSetProxy'                       => { skip => 1 },
     'DBIx::Class::ResultSetManager'                     => { skip => 1 },
     'DBIx::Class::ResultSourceProxy'                    => { skip => 1 },
+    'DBIx::Class::Storage::Statistics'                  => { skip => 1 },
     'DBIx::Class::Storage::DBI'                         => { skip => 1 },
     'DBIx::Class::Storage::DBI::Replicated::Types'      => { skip => 1 },
     'DBIx::Class::Storage::DBI::DB2'                    => { skip => 1 },
index b53916b..94d063a 100644 (file)
--- a/t/72pg.t
+++ b/t/72pg.t
@@ -50,8 +50,16 @@ plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test '.
     unless ($dsn && $user);
 
 DBICTest::Schema->load_classes( 'Casecheck', 'ArrayTest' );
-my $schema = DBICTest::Schema->connect($dsn, $user, $pass,);
 
+# make sure sqlt_type overrides work (::Storage::DBI::Pg does this)
+{
+  my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+
+  ok (!$schema->storage->_dbh, 'definitely not connected');
+  is ($schema->storage->sqlt_type, 'PostgreSQL', 'sqlt_type correct pre-connection');
+}
+
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
 # Check that datetime_parser returns correctly before we explicitly connect.
 SKIP: {
     eval { require DateTime::Format::Pg };
index 53930c2..1729d2d 100644 (file)
@@ -16,7 +16,7 @@ if ($@) {
     plan skip_all => 'Install Text::CSV_XS or Text::CSV_PP to run this test' if ($@);
 }
 
-my @json_backends = qw/XS JSON DWIW Syck/;
+my @json_backends = qw/XS JSON DWIW/;
 my $tests_per_run = 5;
 
 plan tests => $tests_per_run * @json_backends;
diff --git a/t/93autocast.t b/t/93autocast.t
new file mode 100644 (file)
index 0000000..4d9eee0
--- /dev/null
@@ -0,0 +1,82 @@
+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 _native_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,
+  'tracks.single_track' => \[ '= ?', [ single_track => [1, 2, 3 ] ] ],
+}, { join => 'tracks' });
+
+my $bind = [
+  [ cdid => 5 ],
+  [ 'tracks.last_updated_on' => 2009 ],
+  [ 'tracks.position' => 4 ],
+  [ 'single_track' => [ 1, 2, 3] ],
+];
+
+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 = ?
+      AND tracks.single_track = ?
+  )',
+  $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 = ?
+      AND tracks.single_track = CAST(? AS INT)
+  )',
+  $bind,
+  'expected sql with casting on',
+);
+
+done_testing;
index a6de595..d7ba952 100644 (file)
@@ -14,7 +14,7 @@ __PACKAGE__->add_columns(
     data_type => 'integer',
   },
   'position' => {
-    data_type => 'integer',
+    data_type => 'int',
     accessor => 'pos',
   },
   'title' => {
index ac09dbb..888ccd0 100644 (file)
@@ -1,4 +1,4 @@
--- Created on Thu Aug 20 07:47:13 2009
+-- Created on Tue Aug 25 12:34:34 2009
 -- 
 
 
@@ -281,7 +281,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,
index 8e07612..7f97943 100644 (file)
@@ -271,4 +271,62 @@ for ($cd_rs->all) {
   );
 }
 
+{
+    my $cd_rs = $schema->resultset('CD')->search({}, {
+            distinct => 1,
+            join     => [qw/ tracks /],
+            prefetch => [qw/ artist /],
+        });
+    is($cd_rs->count, 5, 'complex prefetch + non-prefetching has_many join count correct');
+    is($cd_rs->all, 5, 'complex prefetch + non-prefetching has_many join number of objects correct');
+
+    # make sure join tracks was thrown out
+    is_same_sql_bind (
+      $cd_rs->as_query,
+      '(
+        SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+               artist.artistid, artist.name, artist.rank, artist.charfield
+          FROM (
+            SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+              FROM cd me
+              JOIN artist artist ON artist.artistid = me.artist
+            GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+          ) me
+          JOIN artist artist ON artist.artistid = me.artist
+      )',
+      [],
+    );
+
+
+
+    # try the same as above, but add a condition so the tracks join can not be thrown away
+    my $cd_rs2 = $cd_rs->search ({ 'tracks.title' => { '!=' => 'ugabuganoexist' } });
+    is($cd_rs2->count, 5, 'complex prefetch + non-prefetching restricted has_many join count correct');
+    is($cd_rs2->all, 5, 'complex prefetch + non-prefetching restricted has_many join number of objects correct');
+
+    # the outer group_by seems like a necessary evil, if someone can figure out how to take it away
+    # without breaking compat - be my guest
+    is_same_sql_bind (
+      $cd_rs2->as_query,
+      '(
+        SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+               artist.artistid, artist.name, artist.rank, artist.charfield
+          FROM (
+            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
+              JOIN artist artist ON artist.artistid = me.artist
+            WHERE ( tracks.title != ? )
+            GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+          ) me
+          LEFT JOIN track tracks ON tracks.cd = me.cdid
+          JOIN artist artist ON artist.artistid = me.artist
+        WHERE ( tracks.title != ? )
+        GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+                 artist.artistid, artist.name, artist.rank, artist.charfield
+      )',
+      [ map { [ 'tracks.title' => 'ugabuganoexist' ] } (1 .. 2) ],
+    );
+}
+
 done_testing;
index 72eaeec..1f72b07 100644 (file)
@@ -19,6 +19,17 @@ my $cdrs = $schema->resultset('CD');
 my @tests = (
   {
     rs => $cdrs,
+    search => \[ "title = ? AND year LIKE ?", 'buahaha', '20%' ],
+    attrs => { rows => 5 },
+    sqlbind => \[
+      "( SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE (title = ? AND year LIKE ?) LIMIT 5)",
+      'buahaha',
+      '20%',
+    ],
+  },
+
+  {
+    rs => $cdrs,
     search => {
       artist_id => { 'in' => $art_rs->search({}, { rows => 1 })->get_column( 'id' )->as_query },
     },
similarity index 100%
rename from t/92storage.t
rename to t/storage/base.t
similarity index 100%
rename from t/dbh_do.t
rename to t/storage/dbh_do.t
similarity index 100%
rename from t/91debug.t
rename to t/storage/debug.t
similarity index 100%
rename from t/18inserterror.t
rename to t/storage/error.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)
@@ -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,
similarity index 97%
rename from t/33storage_reconnect.t
rename to t/storage/reconnect.t
index 8f1eba1..5ef22f2 100644 (file)
@@ -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
similarity index 100%
rename from t/31stats.t
rename to t/storage/stats.t