From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 4 Aug 2009 21:05:03 +0000 (+0000)
Subject: Merge 'prefetch_bug-related_resultset_order_by_plus_limit' into 'prefetch_redux'
X-Git-Tag: v0.08109~48^2~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e711f3168414b165f83499758dc669753cdf5be5;hp=23b67299bf3b2c3979f5193475088e780909109a;p=dbsrgits%2FDBIx-Class.git

Merge 'prefetch_bug-related_resultset_order_by_plus_limit' into 'prefetch_redux'

Move norbi's test to prefetch_redux - it's the same idea
---

diff --git a/Changes b/Changes
index 8145785..3a07811 100644
--- a/Changes
+++ b/Changes
@@ -6,11 +6,14 @@ Revision history for DBIx::Class
           'force_pool' attribute.  Lots of documentation updates, including a
           new Introduction.pod file. Fixed the way we detect transaction to 
           make this more reliable and forward looking. Fixed some trouble with
-          the way Moose Types are used.  
+          the way Moose Types are used.
+        - Added new MySQL specific on_connect_call macro 'set_strict_mode'
+          (also known as make_mysql_not_suck_as_much)
         - Added call to Pod::Inherit in Makefile.PL -
           currently at author-time only, so we need to add the produced
           .pod files to the MANIFEST
 
+
 0.08108 2009-07-05 23:15:00 (UTC)
         - Fixed the has_many prefetch with limit/group deficiency -
           it is now possible to select "top 5 commenters" while
diff --git a/Makefile.PL b/Makefile.PL
index 2c65cfe..d21951b 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -60,8 +60,8 @@ resources 'MailingList' => 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/db
 # re-build README and require extra modules for testing if we're in a checkout
 
 my %force_requires_if_author = (
+#  'Module::Install::Pod::Inherit' => 0.01,
   'Test::Pod::Coverage'       => 1.04,
-  'Module::Install::Pod::Inherit' => 0.01,
   'SQL::Translator'           => 0.09007,
 
   # CDBI-compat related
@@ -137,8 +137,8 @@ EOW
     unlink 'MANIFEST';
   }
 
-  eval { require Module::Install::Pod::Inherit };
-  PodInherit() if !$@;
+#  eval { require Module::Install::Pod::Inherit };
+#  PodInherit() if !$@;
 }
 
 auto_install();
diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index 4db8939..34ab70d 100644
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -73,9 +73,11 @@ Create a schema class called MyDB/Schema.pm:
 
   1;
 
-Create a table class to represent artists, who have many CDs, in
+Create a result class to represent artists, who have many CDs, in
 MyDB/Schema/Result/Artist.pm:
 
+See L<DBIx::Class::ResultSource> for docs on defining result classes.
+
   package MyDB::Schema::Result::Artist;
   use base qw/DBIx::Class/;
 
@@ -87,7 +89,7 @@ MyDB/Schema/Result/Artist.pm:
 
   1;
 
-A table class to represent a CD, which belongs to an artist, in
+A result class to represent a CD, which belongs to an artist, in
 MyDB/Schema/Result/CD.pm:
 
   package MyDB::Schema::Result::CD;
@@ -109,9 +111,17 @@ Then you can use these classes in your application's code:
 
   # Query for all artists and put them in an array,
   # or retrieve them as a result set object.
+  # $schema->resultset returns a DBIx::Class::ResultSet
   my @all_artists = $schema->resultset('Artist')->all;
   my $all_artists_rs = $schema->resultset('Artist');
 
+  # Output all artists names
+  # $artist here is a DBIx::Class::Row, which has accessors 
+  # for all its columns. Rows are also subclasses of your Result class.
+  foreach $artist (@artists) {
+    print $artist->name, "\n";
+  }
+
   # Create a result set to search for artists.
   # This does not query the DB.
   my $johns_rs = $schema->resultset('Artist')->search(
diff --git a/lib/DBIx/Class/InflateColumn/DateTime.pm b/lib/DBIx/Class/InflateColumn/DateTime.pm
index 1d19012..7e50807 100644
--- a/lib/DBIx/Class/InflateColumn/DateTime.pm
+++ b/lib/DBIx/Class/InflateColumn/DateTime.pm
@@ -119,6 +119,9 @@ sub register_column {
     if ($type eq "timestamp with time zone" || $type eq "timestamptz") {
       $type = "timestamp";
       $info->{_ic_dt_method} ||= "timestamp_with_timezone";
+    } elsif ($type eq "timestamp without time zone") {
+      $type = "timestamp";
+      $info->{_ic_dt_method} ||= "timestamp_without_timezone";
     } elsif ($type eq "smalldatetime") {
       $type = "datetime";
       $info->{_ic_dt_method} ||= "datetime";
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index ed1cdc0..e24dafe 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -1264,7 +1264,7 @@ sub _count_subq_rs {
   my $sub_attrs = { %$attrs };
 
   # extra selectors do not go in the subquery and there is no point of ordering it
-  delete $sub_attrs->{$_} for qw/collapse prefetch_select select as order_by/;
+  delete $sub_attrs->{$_} for qw/collapse select _prefetch_select as order_by/;
 
   # if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all
   # clobber old group_by regardless
@@ -2875,6 +2875,12 @@ sub _resolved_attrs {
     $attrs->{group_by} = [ $attrs->{group_by} ];
   }
 
+  # generate the distinct induced group_by early, as prefetch will be carried via a
+  # subquery (since a group_by is present)
+  if (delete $attrs->{distinct}) {
+    $attrs->{group_by} ||= [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ];
+  }
+
   $attrs->{collapse} ||= {};
   if ( my $prefetch = delete $attrs->{prefetch} ) {
     $prefetch = $self->_merge_attr( {}, $prefetch );
@@ -2886,19 +2892,16 @@ sub _resolved_attrs {
     my @prefetch =
       $source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
 
-    $attrs->{prefetch_select} = [ map { $_->[0] } @prefetch ];
-    push @{ $attrs->{select} }, @{$attrs->{prefetch_select}};
+    # we need to somehow mark which columns came from prefetch
+    $attrs->{_prefetch_select} = [ map { $_->[0] } @prefetch ];
+
+    push @{ $attrs->{select} }, @{$attrs->{_prefetch_select}};
     push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
 
     push( @{$attrs->{order_by}}, @$prefetch_ordering );
     $attrs->{_collapse_order_by} = \@$prefetch_ordering;
   }
 
-
-  if (delete $attrs->{distinct}) {
-    $attrs->{group_by} ||= [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ];
-  }
-
   # if both page and offset are specified, produce a combined offset
   # even though it doesn't make much sense, this is what pre 081xx has
   # been doing
@@ -2928,7 +2931,7 @@ sub _joinpath_aliases {
   for my $j (@$fromspec) {
 
     next if ref $j ne 'ARRAY';
-    next if $j->[0]{-relation_chain_depth} < $cur_depth;
+    next if ($j->[0]{-relation_chain_depth} || 0) < $cur_depth;
 
     my $jpath = $j->[0]{-join_path};
 
@@ -3377,6 +3380,42 @@ with that artist is given below (assuming many-to-many from artists to tags):
 B<NOTE:> If you specify a C<prefetch> attribute, the C<join> and C<select>
 attributes will be ignored.
 
+B<CAVEATs>: Prefetch does a lot of deep magic. As such, it may not behave
+exactly as you might expect.
+
+=over 4
+
+=item * 
+
+Prefetch uses the L</cache> to populate the prefetched relationships. This
+may or may not be what you want.
+
+=item * 
+
+If you specify a condition on a prefetched relationship, ONLY those
+rows that match the prefetched condition will be fetched into that relationship.
+This means that adding prefetch to a search() B<may alter> what is returned by
+traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
+
+  my $artist_rs = $schema->resultset('Artist')->search({
+      'cds.year' => 2008,
+  }, {
+      join => 'cds',
+  });
+
+  my $count = $artist_rs->first->cds->count;
+
+  my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
+
+  my $prefetch_count = $artist_rs_prefetch->first->cds->count;
+
+  cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
+
+that cmp_ok() may or may not pass depending on the datasets involved. This
+behavior may or may not survive the 0.09 transition.
+
+=back
+
 =head2 page
 
 =over 4
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 89b8eda..f50cffd 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -24,12 +24,75 @@ DBIx::Class::ResultSource - Result source object
 
 =head1 SYNOPSIS
 
+  # Create a table based result source, in a result class.
+
+  package MyDB::Schema::Result::Artist;
+  use base qw/DBIx::Class/;
+
+  __PACKAGE__->load_components(qw/Core/);
+  __PACKAGE__->table('artist');
+  __PACKAGE__->add_columns(qw/ artistid name /);
+  __PACKAGE__->set_primary_key('artistid');
+  __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
+
+  1;
+
+  # Create a query (view) based result source, in a result class
+  package MyDB::Schema::Result::Year2000CDs;
+
+  use DBIx::Class::ResultSource::View;
+
+  __PACKAGE__->load_components('Core');
+  __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
+
+  __PACKAGE__->table('year2000cds');
+  __PACKAGE__->result_source_instance->is_virtual(1);
+  __PACKAGE__->result_source_instance->view_definition(
+      "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
+      );
+
+
 =head1 DESCRIPTION
 
-A ResultSource is a component of a schema from which results can be directly
-retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
+A ResultSource is an object that represents a source of data for querying.
+
+This class is a base class for various specialised types of result
+sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
+default result source type, so one is created for you when defining a
+result class as described in the synopsis above.
+
+More specifically, the L<DBIx::Class::Core> component pulls in the
+L<DBIx::Class::ResultSourceProxy::Table> as a base class, which
+defines the L<table|DBIx::Class::ResultSourceProxy::Table/table>
+method. When called, C<table> creates and stores an instance of
+L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
+sources, you don't need to remember any of this.
+
+Result sources representing select queries, or views, can also be
+created, see L<DBIx::Class::ResultSource::View> for full details.
+
+=head2 Finding result source objects
+
+As mentioned above, a result source instance is created and stored for
+you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
+
+You can retrieve the result source at runtime in the following ways:
+
+=over
+
+=item From a Schema object:
+
+   $schema->source($source_name);
+
+=item From a Row object:
 
-Basic view support also exists, see L<<DBIx::Class::ResultSource::View>.
+   $row->result_source;
+
+=item From a ResultSet object:
+
+   $rs->result_source;
+
+=back
 
 =head1 METHODS
 
@@ -69,9 +132,9 @@ sub new {
 
   $source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
 
-Adds columns to the result source. If supplied key => hashref pairs, uses
-the hashref as the column_info for that column. Repeated calls of this
-method will add more columns, not replace them.
+Adds columns to the result source. If supplied colname => hashref
+pairs, uses the hashref as the L</column_info> for that column. Repeated
+calls of this method will add more columns, not replace them.
 
 The column names given will be created as accessor methods on your
 L<DBIx::Class::Row> objects. You can change the name of the accessor
@@ -84,40 +147,62 @@ keys are currently recognised/used by DBIx::Class:
 
 =item accessor
 
+   { accessor => '_name' }
+
+   # example use, replace standard accessor with one of your own:
+   sub name {
+       my ($self, $value) = @_;
+
+       die "Name cannot contain digits!" if($value =~ /\d/);
+       $self->_name($value);
+
+       return $self->_name();
+   }
+
 Use this to set the name of the accessor method for this column. If unset,
 the name of the column will be used.
 
 =item data_type
 
-This contains the column type. It is automatically filled by the
-L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
-L<DBIx::Class::Schema::Loader> module. If you do not enter a
-data_type, DBIx::Class will attempt to retrieve it from the
-database for you, using L<DBI>'s column_info method. The values of this
-key are typically upper-cased.
+   { data_type => 'integer' }
+
+This contains the column type. It is automatically filled if you use the
+L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
+L<DBIx::Class::Schema::Loader> module. 
 
 Currently there is no standard set of values for the data_type. Use
 whatever your database supports.
 
 =item size
 
+   { size => 20 }
+
 The length of your column, if it is a column type that can have a size
-restriction. This is currently only used by L<DBIx::Class::Schema/deploy>.
+restriction. This is currently only used to create tables from your
+schema, see L<DBIx::Class::Schema/deploy>.
 
 =item is_nullable
 
-Set this to a true value for a columns that is allowed to contain
-NULL values. This is currently only used by L<DBIx::Class::Schema/deploy>.
+   { is_nullable => 1 }
+
+Set this to a true value for a columns that is allowed to contain NULL
+values, default is false. This is currently only used to create tables
+from your schema, see L<DBIx::Class::Schema/deploy>.
 
 =item is_auto_increment
 
+   { is_auto_increment => 1 }
+
 Set this to a true value for a column whose value is somehow
-automatically set. This is used to determine which columns to empty
-when cloning objects using L<DBIx::Class::Row/copy>. It is also used by
+automatically set, defaults to false. This is used to determine which
+columns to empty when cloning objects using
+L<DBIx::Class::Row/copy>. It is also used by
 L<DBIx::Class::Schema/deploy>.
 
 =item is_numeric
 
+   { is_numeric => 1 }
+
 Set this to a true or false value (not C<undef>) to explicitly specify
 if this column contains numeric data. This controls how set_column
 decides whether to consider a column dirty after an update: if
@@ -130,22 +215,29 @@ result will be cached in this attribute.
 
 =item is_foreign_key
 
+   { is_foreign_key => 1 }
+
 Set this to a true value for a column that contains a key from a
-foreign table. This is currently only used by
-L<DBIx::Class::Schema/deploy>.
+foreign table, defaults to false. This is currently only used to
+create tables from your schema, see L<DBIx::Class::Schema/deploy>.
 
 =item default_value
 
-Set this to the default value which will be inserted into a column
-by the database. Can contain either a value or a function (use a
+   { default_value => \'now()' }
+
+Set this to the default value which will be inserted into a column by
+the database. Can contain either a value or a function (use a
 reference to a scalar e.g. C<\'now()'> if you want a function). This
-is currently only used by L<DBIx::Class::Schema/deploy>.
+is currently only used to create tables from your schema, see
+L<DBIx::Class::Schema/deploy>.
 
 See the note on L<DBIx::Class::Row/new> for more information about possible
 issues related to db-side default values.
 
 =item sequence
 
+   { sequence => 'my_table_seq' }
+
 Set this on a primary key column to the name of the sequence used to
 generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
 will attempt to retrieve the name of the sequence from the database
@@ -171,13 +263,13 @@ L<SQL::Translator::Producer::MySQL>.
 
 =over
 
-=item Arguments: $colname, [ \%columninfo ]
+=item Arguments: $colname, \%columninfo?
 
 =item Return value: 1/0 (true/false)
 
 =back
 
-  $source->add_column('col' => \%info?);
+  $source->add_column('col' => \%info);
 
 Add a single column and optional column info. Uses the same column
 info keys as L</add_columns>.
@@ -237,8 +329,8 @@ sub has_column {
   my $info = $source->column_info($col);
 
 Returns the column metadata hashref for a column, as originally passed
-to L</add_columns>. See the description of L</add_columns> for information
-on the contents of the hashref.
+to L</add_columns>. See L</add_columns> above for information on the
+contents of the hashref.
 
 =cut
 
@@ -362,14 +454,16 @@ sub remove_column { shift->remove_columns(@_); } # DO NOT CHANGE THIS TO GLOB
 
 =back
 
-Defines one or more columns as primary key for this source. Should be
+Defines one or more columns as primary key for this source. Must be
 called after L</add_columns>.
 
 Additionally, defines a L<unique constraint|add_unique_constraint>
 named C<primary>.
 
 The primary key columns are used by L<DBIx::Class::PK::Auto> to
-retrieve automatically created values from the database.
+retrieve automatically created values from the database. They are also
+used as default joining columns when specifying relationships, see
+L<DBIx::Class::Relationship>.
 
 =cut
 
@@ -408,7 +502,7 @@ sub primary_columns {
 
 =over 4
 
-=item Arguments: [ $name ], \@colnames
+=item Arguments: $name?, \@colnames
 
 =item Return value: undefined
 
@@ -426,11 +520,13 @@ Alternatively, you can specify only the columns:
 
   __PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
 
-This will result in a unique constraint named C<table_column1_column2>, where
-C<table> is replaced with the table name.
+This will result in a unique constraint named
+C<table_column1_column2>, where C<table> is replaced with the table
+name.
 
-Unique constraints are used, for example, when you call
-L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
+Unique constraints are used, for example, when you pass the constraint
+name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
+only columns in the constraint are searched.
 
 Throws an error if any of the given column names do not yet exist on
 the result source.
@@ -499,7 +595,8 @@ sub name_unique_constraint {
 
   $source->unique_constraints();
 
-Read-only accessor which returns a hash of unique constraints on this source.
+Read-only accessor which returns a hash of unique constraints on this
+source.
 
 The hash is keyed by constraint name, and contains an arrayref of
 column names as values.
@@ -659,11 +756,15 @@ but is cached from then on unless resultset_class changes.
 
 =back
 
-  package My::ResultSetClass;
+  package My::Schema::ResultSet::Artist;
   use base 'DBIx::Class::ResultSet';
   ...
 
-  $source->resultset_class('My::ResultSet::Class');
+  # In the result class
+  __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
+
+  # Or in code
+  $source->resultset_class('My::Schema::ResultSet::Artist');
 
 Set the class of the resultset. This is useful if you want to create your
 own resultset methods. Create your own class derived from
@@ -681,6 +782,10 @@ exists.
 
 =back
 
+  # In the result class
+  __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
+
+  # Or in code
   $source->resultset_attributes({ order_by => [ 'id' ] });
 
 Store a collection of resultset attributes, that will be set on every
diff --git a/lib/DBIx/Class/ResultSource/View.pm b/lib/DBIx/Class/ResultSource/View.pm
index 0bcb0fc..a9c3755 100644
--- a/lib/DBIx/Class/ResultSource/View.pm
+++ b/lib/DBIx/Class/ResultSource/View.pm
@@ -17,7 +17,7 @@ DBIx::Class::ResultSource::View - ResultSource object representing a view
 
 =head1 SYNOPSIS
 
-  package MyDB::Schema::Year2000CDs;
+  package MyDB::Schema::Result::Year2000CDs;
 
   use DBIx::Class::ResultSource::View;
 
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 1d1e57b..bfd7edf 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1401,8 +1401,21 @@ sub _select_args {
       my $fqcn = join ('.', $alias, $col);
       $bind_attrs->{$fqcn} = $bindtypes->{$col} if $bindtypes->{$col};
 
-      # so that unqualified searches can be bound too
-      $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq $rs_alias;
+      # Unqialified column names are nice, but at the same time can be
+      # rather ambiguous. What we do here is basically go along with
+      # the loop, adding an unqualified column slot to $bind_attrs,
+      # alongside the fully qualified name. As soon as we encounter
+      # another column by that name (which would imply another table)
+      # we unset the unqualified slot and never add any info to it
+      # to avoid erroneous type binding. If this happens the users
+      # only choice will be to fully qualify his column name
+
+      if (exists $bind_attrs->{$col}) {
+        $bind_attrs->{$col} = {};
+      }
+      else {
+        $bind_attrs->{$col} = $bind_attrs->{$fqcn};
+      }
     }
   }
 
@@ -1430,7 +1443,7 @@ sub _select_args {
     ( $attrs->{rows} && keys %{$attrs->{collapse}} )
        ||
     ( $attrs->{group_by} && @{$attrs->{group_by}} &&
-      $attrs->{prefetch_select} && @{$attrs->{prefetch_select}} )
+      $attrs->{_prefetch_select} && @{$attrs->{_prefetch_select}} )
   ) {
     ($ident, $select, $where, $attrs)
       = $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
@@ -1475,14 +1488,15 @@ sub _adjust_select_args_for_complex_prefetch {
   # 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/;
+  delete $sub_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/;
 
   my $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 = [];
-  for my $i (0 .. @{$attrs->{select}} - @{$attrs->{prefetch_select}} - 1) {
+  my $sub_group_by;
+  for my $i (0 .. @{$attrs->{select}} - @{$attrs->{_prefetch_select}} - 1) {
     my $sel = $attrs->{select}[$i];
 
     # alias any functions to the dbic-side 'as' label
@@ -1595,13 +1609,15 @@ sub _adjust_select_args_for_complex_prefetch {
 
   # 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
-  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;
-      last;
+  unless ($sub_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;
+        last;
+      }
     }
   }
 
diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index 9c50a3c..1593978 100644
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -26,9 +26,6 @@ This class implements autoincrements for Oracle.
 use base qw/DBIx::Class::Storage::DBI/;
 use mro 'c3';
 
-# For ORA_BLOB => 113, ORA_CLOB => 112
-use DBD::Oracle qw( :ora_types );
-
 sub _dbh_last_insert_id {
   my ($self, $dbh, $source, @columns) = @_;
   my @ids = ();
@@ -234,6 +231,7 @@ table with more than one LOB column.
 
 sub source_bind_attributes 
 {
+	require DBD::Oracle;
 	my $self = shift;
 	my($source) = @_;
 
@@ -246,8 +244,9 @@ sub source_bind_attributes
 		my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type);
 
 		if ($data_type =~ /^[BC]LOB$/i) {
-			$column_bind_attrs{'ora_type'}
-				= uc($data_type) eq 'CLOB' ? ORA_CLOB : ORA_BLOB;
+			$column_bind_attrs{'ora_type'} = uc($data_type) eq 'CLOB' ?
+				DBD::Oracle::ORA_CLOB() :
+				DBD::Oracle::ORA_BLOB();
 			$column_bind_attrs{'ora_field'} = $column;
 		}
 
diff --git a/lib/DBIx/Class/Storage/DBI/mysql.pm b/lib/DBIx/Class/Storage/DBI/mysql.pm
index cd4b6a0..bce1a07 100644
--- a/lib/DBIx/Class/Storage/DBI/mysql.pm
+++ b/lib/DBIx/Class/Storage/DBI/mysql.pm
@@ -20,6 +20,14 @@ sub with_deferred_fk_checks {
   $self->_do_query('SET FOREIGN_KEY_CHECKS = 1');
 }
 
+sub connect_call_set_strict_mode {
+  my $self = shift;
+
+  # the @@sql_mode puts back what was previously set on the session handle
+  $self->_do_query(q|SET SQL_MODE = CONCAT('ANSI,TRADITIONAL,ONLY_FULL_GROUP_BY,', @@sql_mode)|);
+  $self->_do_query(q|SET SQL_AUTO_IS_NULL = 0|);
+}
+
 sub _dbh_last_insert_id {
   my ($self, $dbh, $source, $col) = @_;
   $dbh->{mysql_insertid};
@@ -73,12 +81,16 @@ DBIx::Class::Storage::DBI::mysql - Storage::DBI class implementing MySQL specifi
 Storage::DBI autodetects the underlying MySQL database, and re-blesses the
 C<$storage> object into this class.
 
-  my $schema = MyDb::Schema->connect( $dsn, $user, $pass );
+  my $schema = MyDb::Schema->connect( $dsn, $user, $pass, { set_strict_mode => 1 } );
 
 =head1 DESCRIPTION
 
 This class implements MySQL specific bits of L<DBIx::Class::Storage::DBI>.
 
+It also provides a one-stop on-connect macro C<set_strict_mode> which sets
+session variables such that MySQL behaves more predictably as far as the
+SQL standard is concerned.
+
 =head1 AUTHORS
 
 See L<DBIx::Class/CONTRIBUTORS>
diff --git a/t/71mysql.t b/t/71mysql.t
index 78ecb61..031529c 100644
--- a/t/71mysql.t
+++ b/t/71mysql.t
@@ -164,10 +164,12 @@ lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die';
 ##
 ## Only way is to do a SET SQL_AUTO_IS_NULL = 0; on connect
 ## But I'm not sure if we should do this or not (Ash, 2008/06/03)
+#
+# There is now a built-in function to do this, test that everything works
+# with it (ribasushi, 2009/07/03)
 
 NULLINSEARCH: {
-    local $TODO = 'Fix pending in branches/mysql_ansi';
-    my $ansi_schema = DBICTest::Schema->connect ($dsn, $user, $pass);
+    my $ansi_schema = DBICTest::Schema->connect ($dsn, $user, $pass, { on_connect_call => 'set_strict_mode' });
 
     $ansi_schema->resultset('Artist')->create ({ name => 'last created artist' });
 
diff --git a/t/count/prefetch.t b/t/count/prefetch.t
index 2032a4b..8012e10 100644
--- a/t/count/prefetch.t
+++ b/t/count/prefetch.t
@@ -6,9 +6,6 @@ use lib qw(t/lib);
 use Test::More;
 use DBICTest;
 use DBIC::SqlMakerTest;
-use DBIC::DebugObj;
-
-plan tests => 6;
 
 my $schema = DBICTest->init_schema();
 
@@ -20,20 +17,58 @@ my $schema = DBICTest->init_schema();
                 { prefetch => [qw/tracks artist/] },
             );
   is ($rs->all, 5, 'Correct number of objects');
+  is ($rs->count, 5, 'Correct count');
 
+  is_same_sql_bind (
+    $rs->count_rs->as_query,
+    '(
+      SELECT COUNT( * )
+        FROM (
+          SELECT cds.cdid
+            FROM artist me
+            JOIN cd cds ON cds.artist = me.artistid
+            LEFT JOIN track tracks ON tracks.cd = cds.cdid
+            JOIN artist artist ON artist.artistid = cds.artist
+          WHERE tracks.position = ? OR tracks.position = ?
+          GROUP BY cds.cdid
+        ) count_subq
+    )',
+    [ map { [ 'tracks.position' => $_ ] } (1, 2) ],
+  );
+}
 
-  my ($sql, @bind);
-  $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
-  $schema->storage->debug(1);
-
-
-  is ($rs->count, 5, 'Correct count');
+# collapsing prefetch with distinct
+{
+  my $first_cd = $schema->resultset('Artist')->first->cds->first;
+  $first_cd->update ({
+    genreid => $first_cd->create_related (
+      genre => ({ name => 'vague genre' })
+    )->id
+  });
+
+  my $rs = $schema->resultset("Artist")->search(undef, {distinct => 1})
+            ->search_related('cds')->search_related('genre',
+                { 'genre.name' => { '!=', 'foo' } },
+                { prefetch => q(cds) },
+            );
+  is ($rs->all, 1, 'Correct number of objects');
+  is ($rs->count, 1, 'Correct count');
 
   is_same_sql_bind (
-    $sql,
-    \@bind,
-    'SELECT COUNT( * ) FROM (SELECT cds.cdid FROM artist me JOIN cd cds ON cds.artist = me.artistid LEFT JOIN track tracks ON tracks.cd = cds.cdid JOIN artist artist ON artist.artistid = cds.artist WHERE tracks.position = ? OR tracks.position = ? GROUP BY cds.cdid) count_subq',
-    [ qw/'1' '2'/ ],
+    $rs->count_rs->as_query,
+    '(
+      SELECT COUNT( * )
+        FROM (
+          SELECT genre.genreid
+            FROM artist me
+            JOIN cd cds ON cds.artist = me.artistid
+            JOIN genre genre ON genre.genreid = cds.genreid
+            LEFT JOIN cd cds_2 ON cds_2.genreid = genre.genreid
+          WHERE ( genre.name != ? )
+          GROUP BY genre.genreid
+        ) count_subq
+    )',
+    [ [ 'genre.name' => 'foo' ] ],
   );
 }
 
@@ -47,17 +82,20 @@ my $schema = DBICTest->init_schema();
   is ($rs->all, 10, 'Correct number of objects');
 
 
-  my ($sql, @bind);
-  $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
-  $schema->storage->debug(1);
-
-
   is ($rs->count, 10, 'Correct count');
 
   is_same_sql_bind (
-    $sql,
-    \@bind,
-    'SELECT COUNT( * ) FROM cd me JOIN track tracks ON tracks.cd = me.cdid JOIN cd disc ON disc.cdid = tracks.cd LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid WHERE ( ( position = ? OR position = ? ) )',
-    [ qw/'1' '2'/ ],
+    $rs->count_rs->as_query,
+    '(
+      SELECT COUNT( * )
+        FROM cd me
+        JOIN track tracks ON tracks.cd = me.cdid
+        JOIN cd disc ON disc.cdid = tracks.cd
+        LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid
+      WHERE position = ? OR position = ?
+    )',
+    [ map { [ position => $_ ] } (1, 2) ],
   );
 }
+
+done_testing;
diff --git a/t/inflate/datetime_pg.t b/t/inflate/datetime_pg.t
index 054edf1..2b19df4 100644
--- a/t/inflate/datetime_pg.t
+++ b/t/inflate/datetime_pg.t
@@ -13,7 +13,7 @@ use DBICTest;
 eval { require DateTime::Format::Pg };
 plan $@
   ? ( skip_all =>  'Need DateTime::Format::Pg for timestamp inflation tests')
-  : ( tests => 3 )
+  : ( tests => 6 )
 ;
 
 
@@ -27,4 +27,14 @@ my $schema = DBICTest->init_schema();
   is($event->created_on->time_zone->name, "America/Chicago", "Timezone changed");
   # Time zone difference -> -6hours
   is($event->created_on->iso8601, "2009-01-15T11:00:00", "Time with TZ correct");
+
+# test 'timestamp without time zone'
+  my $dt = DateTime->from_epoch(epoch => time);
+  $dt->set_nanosecond(int 500_000_000);
+  $event->update({ts_without_tz => $dt});
+  $event->discard_changes;
+  isa_ok($event->ts_without_tz, "DateTime") or diag $event->created_on;
+  is($event->ts_without_tz, $dt, 'timestamp without time zone inflation');
+  is($event->ts_without_tz->microsecond, $dt->microsecond,
+    'timestamp without time zone microseconds survived');
 }
diff --git a/t/lib/DBIC/SqlMakerTest.pm b/t/lib/DBIC/SqlMakerTest.pm
index 1098e25..44ccb4b 100644
--- a/t/lib/DBIC/SqlMakerTest.pm
+++ b/t/lib/DBIC/SqlMakerTest.pm
@@ -41,7 +41,8 @@ sub is_same_sql_bind {
   croak "Unexpected argument(s) supplied to is_same_sql_bind: " . join ('; ', @_)
     if @_;
 
-  SQL::Abstract::Test::is_same_sql_bind (@args);
+  @_ = @args;
+  goto &SQL::Abstract::Test::is_same_sql_bind;
 }
 
 *is_same_sql = \&SQL::Abstract::Test::is_same_sql;
diff --git a/t/lib/DBICTest/Schema/Event.pm b/t/lib/DBICTest/Schema/Event.pm
index c56c1bd..22b655e 100644
--- a/t/lib/DBICTest/Schema/Event.pm
+++ b/t/lib/DBICTest/Schema/Event.pm
@@ -15,6 +15,7 @@ __PACKAGE__->add_columns(
   varchar_date => { data_type => 'varchar', inflate_date => 1, size => 20, is_nullable => 1 },
   varchar_datetime => { data_type => 'varchar', inflate_datetime => 1, size => 20, is_nullable => 1 },
   skip_inflation => { data_type => 'datetime', inflate_datetime => 0, is_nullable => 1 },
+  ts_without_tz => { data_type => 'datetime', is_nullable => 1 }, # used in EventTZPg
 );
 
 __PACKAGE__->set_primary_key('id');
diff --git a/t/lib/DBICTest/Schema/EventTZPg.pm b/t/lib/DBICTest/Schema/EventTZPg.pm
index e2b512e..444fe69 100644
--- a/t/lib/DBICTest/Schema/EventTZPg.pm
+++ b/t/lib/DBICTest/Schema/EventTZPg.pm
@@ -12,6 +12,7 @@ __PACKAGE__->add_columns(
   id => { data_type => 'integer', is_auto_increment => 1 },
   starts_at => { data_type => 'datetime', timezone => "America/Chicago", locale => 'de_DE' },
   created_on => { data_type => 'timestamp with time zone', timezone => "America/Chicago" },
+  ts_without_tz => { data_type => 'timestamp without time zone' },
 );
 
 __PACKAGE__->set_primary_key('id');
diff --git a/t/lib/sqlite.sql b/t/lib/sqlite.sql
index f109493..463c2c6 100644
--- a/t/lib/sqlite.sql
+++ b/t/lib/sqlite.sql
@@ -1,6 +1,6 @@
 -- 
 -- Created by SQL::Translator::Producer::SQLite
--- Created on Sat Jun 27 14:02:39 2009
+-- Created on Thu Jul 30 08:44:22 2009
 -- 
 
 
@@ -63,7 +63,8 @@ CREATE TABLE event (
   created_on timestamp NOT NULL,
   varchar_date varchar(20),
   varchar_datetime varchar(20),
-  skip_inflation datetime
+  skip_inflation datetime,
+  ts_without_tz datetime
 );
 
 --
@@ -107,6 +108,14 @@ CREATE TABLE link (
 );
 
 --
+-- Table: money_test
+--
+CREATE TABLE money_test (
+  id INTEGER PRIMARY KEY NOT NULL,
+  amount money
+);
+
+--
 -- Table: noprimarykey
 --
 CREATE TABLE noprimarykey (
@@ -225,7 +234,7 @@ CREATE INDEX artist_undirected_map_idx_id2 ON artist_undirected_map (id2);
 --
 CREATE TABLE bookmark (
   id INTEGER PRIMARY KEY NOT NULL,
-  link integer NOT NULL
+  link integer
 );
 
 CREATE INDEX bookmark_idx_link ON bookmark (link);
diff --git a/t/prefetch/grouped.t b/t/prefetch/grouped.t
index 19fa923..9a85589 100644
--- a/t/prefetch/grouped.t
+++ b/t/prefetch/grouped.t
@@ -1,14 +1,13 @@
 use strict;
 use warnings;
+
 use Test::More;
+use Test::Exception;
 
 use lib qw(t/lib);
 use DBICTest;
 use DBIC::SqlMakerTest;
 
-#plan tests => 6;
-plan 'no_plan';
-
 my $schema = DBICTest->init_schema();
 my $sdebug = $schema->storage->debug;
 
@@ -203,3 +202,35 @@ for ($cd_rs->all) {
   $schema->storage->debugcb (undef);
   $schema->storage->debug ($sdebug);
 }
+
+# make sure that distinct still works
+{
+  my $rs = $schema->resultset("CD")->search({}, {
+    prefetch => 'tags',
+    order_by => 'cdid',
+    distinct => 1,
+  });
+
+  is_same_sql_bind (
+    $rs->as_query,
+    '(
+      SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+             tags.tagid, tags.cd, tags.tag 
+        FROM (
+          SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+            FROM cd me
+          GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+          ORDER BY cdid
+        ) me
+        LEFT JOIN tags tags ON tags.cd = me.cdid
+      ORDER BY cdid, tags.cd, tags.tag
+    )',
+    [],
+    'Prefetch + distinct resulted in correct group_by',
+  );
+
+  is ($rs->all, 5, 'Correct number of CD objects');
+  is ($rs->count, 5, 'Correct count of CDs');
+}
+
+done_testing;
diff --git a/t/prefetch/related_resultset_order_by_plus_limit.t b/t/prefetch/related_resultset_order_by_plus_limit.t
deleted file mode 100644
index e0a7a74..0000000
--- a/t/prefetch/related_resultset_order_by_plus_limit.t
+++ /dev/null
@@ -1,41 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use Test::Exception;
-use lib qw(t/lib);
-use DBICTest;
-
-plan tests => 3;
-
-my $schema = DBICTest->init_schema();
-
-
-my $no_prefetch = $schema->resultset('Track')->search_related(cd =>
-  {
-    'cd.year' => "2000",
-  },
-  {
-    join => 'tags',
-    order_by => 'me.trackid',
-    rows => 1,
-  }
-);
-
-my $use_prefetch = $no_prefetch->search(
-  {},
-  {
-    prefetch => 'tags',
-  }
-);
-
-lives_ok {
-  $use_prefetch->all;
-} "M -> 1 -> M with order_by using first rs and limit generates valid SQL";
-
-is($no_prefetch->count, $use_prefetch->count, '$no_prefetch->count == $use_prefetch->count');
-is(
-  scalar ($no_prefetch->all),
-  scalar ($use_prefetch->all),
-  "Amount of returned rows is right"
-);
diff --git a/t/prefetch/via_search_related.t b/t/prefetch/via_search_related.t
new file mode 100644
index 0000000..041c341
--- /dev/null
+++ b/t/prefetch/via_search_related.t
@@ -0,0 +1,93 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+lives_ok ( sub {
+  my $no_prefetch = $schema->resultset('Track')->search_related(cd =>
+    {
+      'cd.year' => "2000",
+    },
+    {
+      join => 'tags',
+      order_by => 'me.trackid',
+      rows => 1,
+    }
+  );
+
+  my $use_prefetch = $no_prefetch->search(
+    {},
+    {
+      prefetch => 'tags',
+    }
+  );
+
+  is($use_prefetch->count, $no_prefetch->count, 'counts with and without prefetch match');
+  is(
+    scalar ($use_prefetch->all),
+    scalar ($no_prefetch->all),
+    "Amount of returned rows is right"
+  );
+
+}, 'search_related prefetch with order_by works');
+
+
+lives_ok (sub {
+    my $rs = $schema->resultset("Artwork")->search(undef, {distinct => 1})
+              ->search_related('artwork_to_artist')->search_related('artist',
+                undef,
+                { prefetch => 'cds' },
+              );
+    is($rs->all, 0, 'prefetch without WHERE (objects)');
+    is($rs->count, 0, 'prefetch without WHERE (count)');
+
+    $rs = $schema->resultset("Artwork")->search(undef, {distinct => 1})
+              ->search_related('artwork_to_artist')->search_related('artist',
+                { 'cds.title' => 'foo' },
+                { prefetch => 'cds' },
+              );
+    is($rs->all, 0, 'prefetch with WHERE (objects)');
+    is($rs->count, 0, 'prefetch with WHERE (count)');
+
+
+# test where conditions at the root of the related chain
+    my $artist_rs = $schema->resultset("Artist")->search({artistid => 11});
+
+
+    $rs = $artist_rs->search_related('cds')->search_related('genre',
+                    { 'genre.name' => 'foo' },
+                    { prefetch => 'cds' },
+                 );
+    is($rs->all, 0, 'prefetch without distinct (objects)');
+    is($rs->count, 0, 'prefetch without distinct (count)');
+
+
+
+    $rs = $artist_rs->search(undef, {distinct => 1})
+                ->search_related('cds')->search_related('genre',
+                    { 'genre.name' => 'foo' },
+                 );
+    is($rs->all, 0, 'distinct without prefetch (objects)');
+    is($rs->count, 0, 'distinct without prefetch (count)');
+
+
+
+    $rs = $artist_rs->search({}, {distinct => 1})
+                ->search_related('cds')->search_related('genre',
+                    { 'genre.name' => 'foo' },
+                    { prefetch => 'cds' },
+                 );
+    is($rs->all, 0, 'distinct with prefetch (objects)');
+    is($rs->count, 0, 'distinct with prefetch (count)');
+
+
+
+}, 'distinct generally works with prefetch on deep search_related chains');
+
+done_testing;