Merge 'trunk' into 'on_connect_call'
Rafael Kitover [Mon, 22 Jun 2009 23:05:13 +0000 (23:05 +0000)]
r5588@hlagh (orig r6733):  ribasushi | 2009-06-20 01:16:02 -0700
todoify skip
r5590@hlagh (orig r6735):  ribasushi | 2009-06-20 03:37:52 -0700
Clarify test
r5594@hlagh (orig r6739):  ribasushi | 2009-06-20 06:22:06 -0700
Disambiguate populate() return
r5603@hlagh (orig r6742):  ribasushi | 2009-06-20 14:30:23 -0700
 r6737@Thesaurus (orig r6736):  ribasushi | 2009-06-20 12:39:34 +0200
 new branch to streamline count() and introduce count_rs()
 r6738@Thesaurus (orig r6737):  ribasushi | 2009-06-20 12:44:09 +0200
 Add count_rs, move the code back from DBI - leave only sql specific hooks
 r6739@Thesaurus (orig r6738):  ribasushi | 2009-06-20 12:54:11 +0200
 Test count_rs
 r6742@Thesaurus (orig r6741):  ribasushi | 2009-06-20 23:30:10 +0200
 More tests and a really working count_rs

r5613@hlagh (orig r6752):  ribasushi | 2009-06-21 00:00:21 -0700
Clenaup text
r5614@hlagh (orig r6753):  ribasushi | 2009-06-21 05:37:56 -0700
make_column_dirty fix
r5617@hlagh (orig r6755):  ribasushi | 2009-06-21 14:12:40 -0700
Fix borked test

12 files changed:
Changes
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/Row.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBI/mysql.pm
t/96multi_create_torture.t
t/count/count_rs.t [new file with mode: 0644]
t/count/distinct.t
t/inflate/serialize.t
t/prefetch/with_limit.t
t/relationship/core.t
t/zzzzzzz_perl_perf_bug.t

diff --git a/Changes b/Changes
index 0ff9a38..5ebf0e7 100644 (file)
--- a/Changes
+++ b/Changes
@@ -5,6 +5,10 @@ Revision history for DBIx::Class
         - Fixed HRI returning too many empty results on multilevel
           nonexisting prefetch
         - Fixed the prefetch with limit bug
+        - New resultsed method count_rs, returns a ::ResultSetColumn
+          which in turn returns a single count value
+        - make_column_dirty() now overwrites the deflated value with an
+          inflated one if such exists
 
 0.08107 2009-06-14 08:21:00 (UTC)
         - Fix serialization regression introduced in 0.08103 (affects
index 6faf118..f0a5790 100644 (file)
@@ -1154,17 +1154,122 @@ sub count {
   return $self->search(@_)->count if @_ and defined $_[0];
   return scalar @{ $self->get_cache } if $self->get_cache;
 
-  my $meth = $self->_has_resolved_attr (qw/collapse group_by/)
-    ? 'count_grouped'
-    : 'count'
-  ;
-
   my $attrs = $self->_resolved_attrs_copy;
+
+  # this is a little optimization - it is faster to do the limit
+  # adjustments in software, instead of a subquery
+  my $rows = delete $attrs->{rows};
+  my $offset = delete $attrs->{offset};
+
+  my $crs;
+  if ($self->_has_resolved_attr (qw/collapse group_by/)) {
+    $crs = $self->_count_subq_rs ($attrs);
+  }
+  else {
+    $crs = $self->_count_rs ($attrs);
+  }
+  my $count = $crs->next;
+
+  $count -= $offset if $offset;
+  $count = $rows if $rows and $rows < $count;
+  $count = 0 if ($count < 0);
+
+  return $count;
+}
+
+=head2 count_rs
+
+=over 4
+
+=item Arguments: $cond, \%attrs??
+
+=item Return Value: $count_rs
+
+=back
+
+Same as L</count> but returns a L<DBIx::Class::ResultSetColumn> object.
+This can be very handy for subqueries:
+
+  ->search( { amount => $some_rs->count_rs->as_query } )
+
+As with regular resultsets the SQL query will be executed only after
+the resultset is accessed via L</next> or L</all>. That would return
+the same single value obtainable via L</count>.
+
+=cut
+
+sub count_rs {
+  my $self = shift;
+  return $self->search(@_)->count_rs if @_;
+
+  # this may look like a lack of abstraction (count() does about the same)
+  # but in fact an _rs *must* use a subquery for the limits, as the
+  # software based limiting can not be ported if this $rs is to be used
+  # in a subquery itself (i.e. ->as_query)
+  if ($self->_has_resolved_attr (qw/collapse group_by offset rows/)) {
+    return $self->_count_subq_rs;
+  }
+  else {
+    return $self->_count_rs;
+  }
+}
+
+#
+# returns a ResultSetColumn object tied to the count query
+#
+sub _count_rs {
+  my ($self, $attrs) = @_;
+
+  my $rsrc = $self->result_source;
+  $attrs ||= $self->_resolved_attrs;
+
+  my $tmp_attrs = { %$attrs };
+
+  # take off any limits, record_filter is cdbi, and no point of ordering a count 
+  delete $tmp_attrs->{$_} for (qw/select as rows offset order_by record_filter/);
+
+  # overwrite the selector (supplied by the storage)
+  $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs);
+  $tmp_attrs->{as} = 'count';
+
+  my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
+
+  return $tmp_rs;
+}
+
+#
+# same as above but uses a subquery
+#
+sub _count_subq_rs {
+  my ($self, $attrs) = @_;
+
   my $rsrc = $self->result_source;
+  $attrs ||= $self->_resolved_attrs_copy;
 
-  return $rsrc->storage->$meth ($rsrc, $attrs);
+  my $sub_attrs = { %$attrs };
+
+  # these can not go in the subquery, and there is no point of ordering it
+  delete $sub_attrs->{$_} for qw/collapse 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
+  if ( keys %{$attrs->{collapse}} ) {
+    $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->primary_columns) ]
+  }
+
+  $sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $sub_attrs);
+
+  $attrs->{from} = [{
+    count_subq => $rsrc->resultset_class->new ($rsrc, $sub_attrs )->as_query
+  }];
+
+  # the subquery replaces this
+  delete $attrs->{$_} for qw/where bind collapse group_by having having_bind rows offset/;
+
+  return $self->_count_rs ($attrs);
 }
 
+
 sub _bool {
   return 1;
 }
@@ -1514,8 +1619,9 @@ In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
 to insert the data, as this is a faster method.
 
 Otherwise, each set of data is inserted into the database using
-L<DBIx::Class::ResultSet/create>, and a arrayref of the resulting row
-objects is returned.
+L<DBIx::Class::ResultSet/create>, and the resulting objects are
+accumulated into an array. The array itself, or an array reference
+is returned depending on scalar or list context.
 
 Example:  Assuming an Artist Class that has many CDs Classes relating:
 
@@ -1581,7 +1687,7 @@ sub populate {
     foreach my $item (@$data) {
       push(@created, $self->create($item));
     }
-    return @created;
+    return wantarray ? @created : \@created;
   } else {
     my ($first, @rest) = @$data;
 
@@ -2571,22 +2677,24 @@ sub _resolved_attrs {
     $self->{attrs}{alias} => $source->from,
   } ];
 
-  if ( exists $attrs->{join} || exists $attrs->{prefetch} ) {
+  if ( $attrs->{join} || $attrs->{prefetch} ) {
+
+    $self->throw_exception ('join/prefetch can not be used with a literal scalarref {from}')
+      if ref $attrs->{from} ne 'ARRAY';
+
     my $join = delete $attrs->{join} || {};
 
     if ( defined $attrs->{prefetch} ) {
       $join = $self->_merge_attr( $join, $attrs->{prefetch} );
-
     }
 
     $attrs->{from} =    # have to copy here to avoid corrupting the original
       [
-      @{ $attrs->{from} },
-      $source->_resolve_join(
-        $join, $alias, { %{ $attrs->{seen_join} || {} } }
-      )
+        @{ $attrs->{from} },
+        $source->_resolve_join(
+          $join, $alias, { %{ $attrs->{seen_join} || {} } }
+        )
       ];
-
   }
 
   if ( $attrs->{order_by} ) {
index bde2989..72bb2fc 100644 (file)
@@ -710,7 +710,21 @@ sub make_column_dirty {
 
   $self->throw_exception( "No such column '${column}'" )
     unless exists $self->{_column_data}{$column} || $self->has_column($column);
+
+  # the entire clean/dirty code relieas on exists, not on true/false
+  return 1 if exists $self->{_dirty_columns}{$column};
+
   $self->{_dirty_columns}{$column} = 1;
+
+  # if we are just now making the column dirty, and if there is an inflated
+  # value, force it over the deflated one
+  if (exists $self->{_inflated_column}{$column}) {
+    $self->store_column($column,
+      $self->_deflated_column(
+        $column, $self->{_inflated_column}{$column}
+      )
+    );
+  }
 }
 
 =head2 get_inflated_columns
index a6006dc..749c790 100644 (file)
@@ -1461,6 +1461,7 @@ sub _adjust_select_args_for_limited_prefetch {
   $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a custom from attribute')
     if (ref $from ne 'ARRAY');
 
+
   # separate attributes
   my $sub_attrs = { %$attrs };
   delete $attrs->{$_} for qw/where bind rows offset/;
@@ -1479,13 +1480,31 @@ sub _adjust_select_args_for_limited_prefetch {
     ];
   }
 
+  # mangle {from}
+  $from = [ @$from ];
+  my $select_root = shift @$from;
+  my @outer_from = @$from;
 
-  # mangle the head of the {from}
-  my $self_ident = shift @$from;
-
+  my %inner_joins;
   my %join_info = map { $_->[0]{-alias} => $_->[0] } (@$from);
 
-  my (%inner_joins);
+  # in complex search_related chains $alias may *not* be 'me'
+  # so always include it in the inner join, and also shift away
+  # from the outer stack, so that the two datasets actually do
+  # meet
+  if ($select_root->{-alias} ne $alias) {
+    $inner_joins{$alias} = 1;
+
+    while (@outer_from && $outer_from[0][0]{-alias} ne $alias) {
+      shift @outer_from;
+    }
+    if (! @outer_from) {
+      $self->throw_exception ("Unable to find '$alias' in the {from} stack, something is wrong");
+    }
+
+    shift @outer_from; # the new subquery will represent this alias, so get rid of it
+  }
+
 
   # decide which parts of the join will remain on the inside
   #
@@ -1544,22 +1563,21 @@ sub _adjust_select_args_for_limited_prefetch {
   }
 
   # construct the inner $from for the subquery
-  my $inner_from = [ $self_ident ];
-  if (keys %inner_joins) {
-    for my $j (@$from) {
-      push @$inner_from, $j if $inner_joins{$j->[0]{-alias}};
-    }
+  my $inner_from = [ $select_root ];
+  for my $j (@$from) {
+    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
-    for my $alias (keys %inner_joins) {
+  # 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
 
-      # the dot comes from some weirdness in collapse
-      # remove after the rewrite
-      if ($attrs->{collapse}{".$alias"}) {
-        $sub_attrs->{group_by} = $sub_select;
-        last;
-      }
+  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;
     }
   }
 
@@ -1571,14 +1589,14 @@ sub _adjust_select_args_for_limited_prefetch {
     $sub_attrs
   );
 
-  # put it back in $from
-  unshift @$from, { $alias => $subq };
+  # put it in the new {from}
+  unshift @outer_from, { $alias => $subq };
 
   # 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
   #
   # OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
-  return ($from, $select, $where, $attrs);
+  return (\@outer_from, $select, $where, $attrs);
 }
 
 sub _resolve_ident_sources {
@@ -1611,75 +1629,37 @@ sub _resolve_ident_sources {
   return $alias2source;
 }
 
-sub count {
-  my ($self, $source, $attrs) = @_;
-
-  my $tmp_attrs = { %$attrs };
-
-  # take off any limits, record_filter is cdbi, and no point of ordering a count
-  delete $tmp_attrs->{$_} for (qw/select as rows offset order_by record_filter/);
-
-  # overwrite the selector
-  $tmp_attrs->{select} = { count => '*' };
-
-  my $tmp_rs = $source->resultset_class->new($source, $tmp_attrs);
-  my ($count) = $tmp_rs->cursor->next;
-
-  # if the offset/rows attributes are still present, we did not use
-  # a subquery, so we need to make the calculations in software
-  $count -= $attrs->{offset} if $attrs->{offset};
-  $count = $attrs->{rows} if $attrs->{rows} and $attrs->{rows} < $count;
-  $count = 0 if ($count < 0);
-
-  return $count;
-}
-
-sub count_grouped {
-  my ($self, $source, $attrs) = @_;
-
-  # copy for the subquery, we need to do some adjustments to it too
-  my $sub_attrs = { %$attrs };
-
-  # these can not go in the subquery, and there is no point of ordering it
-  delete $sub_attrs->{$_} for qw/collapse 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
-  # simply deleting group_by suffices, as the code below will re-fill it
-  # Note: we check $attrs, as $sub_attrs has collapse deleted
-  if (ref $attrs->{collapse} and keys %{$attrs->{collapse}} ) {
-    delete $sub_attrs->{group_by};
-  }
-
-  $sub_attrs->{group_by} ||= [ map { "$attrs->{alias}.$_" } ($source->primary_columns) ];
-  $sub_attrs->{select} = $self->_grouped_count_select ($source, $sub_attrs);
-
-  $attrs->{from} = [{
-    count_subq => $source->resultset_class->new ($source, $sub_attrs )->as_query
-  }];
-
-  # the subquery replaces this
-  delete $attrs->{$_} for qw/where bind collapse group_by having having_bind rows offset/;
-
-  return $self->count ($source, $attrs);
+# Returns a counting SELECT for a simple count
+# query. Abstracted so that a storage could override
+# this to { count => 'firstcol' } or whatever makes
+# sense as a performance optimization
+sub _count_select {
+  #my ($self, $source, $rs_attrs) = @_;
+  return { count => '*' };
 }
 
+# Returns a SELECT which will end up in the subselect
+# There may or may not be a group_by, as the subquery
+# might have been called to accomodate a limit
 #
-# Returns a SELECT to go with a supplied GROUP BY
-# (caled by count_grouped so a group_by is present)
-# Most databases expect them to match, but some
-# choke in various ways.
+# Most databases would be happy with whatever ends up
+# here, but some choke in various ways.
 #
-sub _grouped_count_select {
-  my ($self, $source, $rs_args) = @_;
-  return $rs_args->{group_by};
+sub _subq_count_select {
+  my ($self, $source, $rs_attrs) = @_;
+  return $rs_attrs->{group_by} if $rs_attrs->{group_by};
+
+  my @pcols = map { join '.', $rs_attrs->{alias}, $_ } ($source->primary_columns);
+  return @pcols ? \@pcols : [ 1 ];
 }
 
+
 sub source_bind_attributes {
   my ($self, $source) = @_;
-  
+
   my $bind_attributes;
   foreach my $column ($source->columns) {
-  
+
     my $data_type = $source->column_info($column)->{data_type} || '';
     $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
      if $data_type;
index 221548a..53b8e16 100644 (file)
@@ -64,10 +64,10 @@ sub _subq_update_delete {
 # primary keys of the main table in the inner query. This hopefully still
 # hits the indexes and keeps mysql happy.
 # (mysql does not care if the SELECT and the GROUP BY match)
-sub _grouped_count_select {
-  my ($self, $source, $rs_args) = @_;
-  my @pcols = map { join '.', $rs_args->{alias}, $_ } ($source->primary_columns);
-  return @pcols ? \@pcols : $rs_args->{group_by};
+sub _subq_count_select {
+  my ($self, $source, $rs_attrs) = @_;
+  my @pcols = map { join '.', $rs_attrs->{alias}, $_ } ($source->primary_columns);
+  return @pcols ? \@pcols : [ 1 ];
 }
 
 1;
index e3a552d..28a4e1d 100644 (file)
@@ -143,7 +143,11 @@ eval {
   is (
     $cds_2012->search(
       { 'tags.tag' => { -in => [qw/A B/] } },
-      { join => 'tags', group_by => 'me.cdid' }
+      {
+        join => 'tags',
+        group_by => 'me.cdid',
+        having => 'count(me.cdid) = 2',
+      }
     ),
     5,
     'All 10 tags were pairwise distributed between 5 year-2012 CDs'
diff --git a/t/count/count_rs.t b/t/count/count_rs.t
new file mode 100644 (file)
index 0000000..7153d3e
--- /dev/null
@@ -0,0 +1,119 @@
+use strict;
+use warnings;
+
+use lib qw(t/lib);
+
+use Test::More;
+use DBICTest;
+use DBIC::SqlMakerTest;
+use DBIC::DebugObj;
+
+plan tests => 10;
+
+my $schema = DBICTest->init_schema();
+
+# non-collapsing prefetch (no multi prefetches)
+{
+  my $rs = $schema->resultset("CD")
+            ->search_related('tracks',
+                { position => [1,2] },
+                { prefetch => [qw/disc lyrics/], rows => 3, offset => 8 },
+            );
+  is ($rs->all, 2, 'Correct number of objects');
+
+
+  my ($sql, @bind);
+  $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
+  $schema->storage->debug(1);
+
+  is ($rs->count, 2, 'Correct count via count()');
+
+  is_same_sql_bind (
+    $sql,
+    \@bind,
+    'SELECT COUNT( * )
+      FROM cd me
+      LEFT 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'/ ],
+    'count softlimit applied',
+  );
+
+  my $crs = $rs->count_rs;
+  is ($crs->next, 2, 'Correct count via count_rs()');
+
+  is_same_sql_bind (
+    $crs->as_query,
+    '(SELECT COUNT( * )
+       FROM (
+        SELECT tracks.trackid
+          FROM cd me
+          LEFT 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 = ? ) )
+        LIMIT 3 OFFSET 8
+       ) count_subq
+    )',
+    [ [ position => 1 ], [ position => 2 ] ],
+    'count_rs db-side limit applied',
+  );
+}
+
+# has_many prefetch with limit
+{
+  my $rs = $schema->resultset("Artist")
+            ->search_related('cds',
+                { 'tracks.position' => [1,2] },
+                { prefetch => [qw/tracks artist/], rows => 3, offset => 4 },
+            );
+  is ($rs->all, 1, 'Correct number of objects');
+
+  my ($sql, @bind);
+  $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
+  $schema->storage->debug(1);
+
+  is ($rs->count, 1, 'Correct count via count()');
+
+  is_same_sql_bind (
+    $sql,
+    \@bind,
+    'SELECT COUNT( * )
+      FROM (
+        SELECT cds.cdid
+          FROM artist me
+          LEFT 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'/ ],
+    'count softlimit applied',
+  );
+
+  my $crs = $rs->count_rs;
+  is ($crs->next, 1, 'Correct count via count_rs()');
+
+  is_same_sql_bind (
+    $crs->as_query,
+    '(SELECT COUNT( * )
+      FROM (
+        SELECT cds.cdid
+          FROM artist me
+          LEFT 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
+        LIMIT 3 OFFSET 4
+      ) count_subq
+    )',
+    [ [ 'tracks.position' => 1 ], [ 'tracks.position' => 2 ] ],
+    'count_rs db-side limit applied',
+  );
+}
index 8e956b5..00ee411 100644 (file)
@@ -11,9 +11,7 @@ use DBIC::SqlMakerTest;
 
 my $schema = DBICTest->init_schema();
 
-eval "use DBD::SQLite";
-plan skip_all => 'needs DBD::SQLite for testing' if $@;
-plan tests => 22;
+plan tests => 58;
 
 # The tag Blue is assigned to cds 1 2 3 and 5
 # The tag Cheesy is assigned to cds 2 4 and 5
@@ -23,59 +21,64 @@ plan tests => 22;
 my $rs;
 my $in_rs = $schema->resultset('Tag')->search({ tag => [ 'Blue', 'Cheesy' ] });
 
-$rs = $schema->resultset('Tag')->search({ tag => 'Blue' });
-is($rs->count, 4, 'Count without DISTINCT');
+for my $get_count (
+  sub { shift->count },
+  sub { my $crs = shift->count_rs; isa_ok ($crs, 'DBIx::Class::ResultSetColumn'); $crs->next }
+) {
+  $rs = $schema->resultset('Tag')->search({ tag => 'Blue' });
+  is($get_count->($rs), 4, 'Count without DISTINCT');
 
-$rs = $schema->resultset('Tag')->search({ tag => [ 'Blue', 'Cheesy' ] }, { group_by => 'tag' });
-is($rs->count, 2, 'Count with single column group_by');
+  $rs = $schema->resultset('Tag')->search({ tag => [ 'Blue', 'Cheesy' ] }, { group_by => 'tag' });
+  is($get_count->($rs), 2, 'Count with single column group_by');
 
-$rs = $schema->resultset('Tag')->search({ tag => [ 'Blue', 'Cheesy' ] }, { group_by => 'cd' });
-is($rs->count, 5, 'Count with another single column group_by');
+  $rs = $schema->resultset('Tag')->search({ tag => [ 'Blue', 'Cheesy' ] }, { group_by => 'cd' });
+  is($get_count->($rs), 5, 'Count with another single column group_by');
 
-$rs = $schema->resultset('Tag')->search({ tag => 'Blue' }, { group_by => [ qw/tag cd/ ]});
-is($rs->count, 4, 'Count with multiple column group_by');
+  $rs = $schema->resultset('Tag')->search({ tag => 'Blue' }, { group_by => [ qw/tag cd/ ]});
+  is($get_count->($rs), 4, 'Count with multiple column group_by');
 
-$rs = $schema->resultset('Tag')->search({ tag => 'Blue' }, { distinct => 1 });
-is($rs->count, 4, 'Count with single column distinct');
+  $rs = $schema->resultset('Tag')->search({ tag => 'Blue' }, { distinct => 1 });
+  is($get_count->($rs), 4, 'Count with single column distinct');
 
-$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } });
-is($rs->count, 7, 'Count with IN subquery');
+  $rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } });
+  is($get_count->($rs), 7, 'Count with IN subquery');
 
-$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } }, { group_by => 'tag' });
-is($rs->count, 2, 'Count with IN subquery with outside group_by');
+  $rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } }, { group_by => 'tag' });
+  is($get_count->($rs), 2, 'Count with IN subquery with outside group_by');
 
-$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } }, { distinct => 1 });
-is($rs->count, 7, 'Count with IN subquery with outside distinct');
+  $rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } }, { distinct => 1 });
+  is($get_count->($rs), 7, 'Count with IN subquery with outside distinct');
 
-$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } }, { distinct => 1, select => 'tag' }), 
-is($rs->count, 2, 'Count with IN subquery with outside distinct on a single column');
+  $rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } }, { distinct => 1, select => 'tag' }), 
+  is($get_count->($rs), 2, 'Count with IN subquery with outside distinct on a single column');
 
-$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->search({}, { group_by => 'tag' })->get_column('tag')->as_query } });
-is($rs->count, 7, 'Count with IN subquery with single group_by');
+  $rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->search({}, { group_by => 'tag' })->get_column('tag')->as_query } });
+  is($get_count->($rs), 7, 'Count with IN subquery with single group_by');
 
-$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->search({}, { group_by => 'cd' })->get_column('tag')->as_query } });
-is($rs->count, 7, 'Count with IN subquery with another single group_by');
+  $rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->search({}, { group_by => 'cd' })->get_column('tag')->as_query } });
+  is($get_count->($rs), 7, 'Count with IN subquery with another single group_by');
 
-$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->search({}, { group_by => [ qw/tag cd/ ] })->get_column('tag')->as_query } });
-is($rs->count, 7, 'Count with IN subquery with multiple group_by');
+  $rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->search({}, { group_by => [ qw/tag cd/ ] })->get_column('tag')->as_query } });
+  is($get_count->($rs), 7, 'Count with IN subquery with multiple group_by');
 
-$rs = $schema->resultset('Tag')->search({ tag => \"= 'Blue'" });
-is($rs->count, 4, 'Count without DISTINCT, using literal SQL');
+  $rs = $schema->resultset('Tag')->search({ tag => \"= 'Blue'" });
+  is($get_count->($rs), 4, 'Count without DISTINCT, using literal SQL');
 
-$rs = $schema->resultset('Tag')->search({ tag => \" IN ('Blue', 'Cheesy')" }, { group_by => 'tag' });
-is($rs->count, 2, 'Count with literal SQL and single group_by');
+  $rs = $schema->resultset('Tag')->search({ tag => \" IN ('Blue', 'Cheesy')" }, { group_by => 'tag' });
+  is($get_count->($rs), 2, 'Count with literal SQL and single group_by');
 
-$rs = $schema->resultset('Tag')->search({ tag => \" IN ('Blue', 'Cheesy')" }, { group_by => 'cd' });
-is($rs->count, 5, 'Count with literal SQL and another single group_by');
+  $rs = $schema->resultset('Tag')->search({ tag => \" IN ('Blue', 'Cheesy')" }, { group_by => 'cd' });
+  is($get_count->($rs), 5, 'Count with literal SQL and another single group_by');
 
-$rs = $schema->resultset('Tag')->search({ tag => \" IN ('Blue', 'Cheesy')" }, { group_by => [ qw/tag cd/ ] });
-is($rs->count, 7, 'Count with literal SQL and multiple group_by');
+  $rs = $schema->resultset('Tag')->search({ tag => \" IN ('Blue', 'Cheesy')" }, { group_by => [ qw/tag cd/ ] });
+  is($get_count->($rs), 7, 'Count with literal SQL and multiple group_by');
 
-$rs = $schema->resultset('Tag')->search({ tag => 'Blue' }, { '+select' => { max => 'tagid' }, distinct => 1 });
-is($rs->count, 4, 'Count with +select aggreggate');
+  $rs = $schema->resultset('Tag')->search({ tag => 'Blue' }, { '+select' => { max => 'tagid' }, distinct => 1 });
+  is($get_count->($rs), 4, 'Count with +select aggreggate');
 
-$rs = $schema->resultset('Tag')->search({}, { select => 'length(me.tag)', distinct => 1 });
-is($rs->count, 3, 'Count by distinct function result as select literal');
+  $rs = $schema->resultset('Tag')->search({}, { select => 'length(me.tag)', distinct => 1 });
+  is($get_count->($rs), 3, 'Count by distinct function result as select literal');
+}
 
 eval {
   my @warnings;
@@ -90,7 +93,7 @@ ok ($@, 'Exception on deprecated distinct usage thrown') if $DBIx::Class::VERSIO
 
 throws_ok(
   sub { my $row = $schema->resultset('Tag')->search({}, { select => { distinct => [qw/tag cd/] } })->first },
-  qr/select => { distinct => ... } syntax is not supported for multiple columns/,
+  qr/select => { distinct => \.\.\. } syntax is not supported for multiple columns/,
   'throw on unsupported syntax'
 );
 
index 59c0997..c2be971 100644 (file)
@@ -32,7 +32,7 @@ foreach my $serializer (@serializers) {
 
 plan (skip_all => "No suitable serializer found") unless $selected;
 
-plan (tests => 8);
+plan (tests => 11);
 DBICTest::Schema::Serialized->inflate_column( 'serialized',
     { inflate => $selected->{inflater},
       deflate => $selected->{deflater},
@@ -84,3 +84,17 @@ is_deeply($object->serialized, $struct_hash, 'inflated hash matches original');
 ok($object->update( { serialized => $struct_array } ), 'arrayref deflation');
 ok($inflated = $object->serialized, 'arrayref inflation');
 is_deeply($inflated, $struct_array, 'inflated array matches original');
+
+
+#===== make sure make_column_dirty ineracts reasonably with inflation
+$object = $rs->first;
+$object->update ({serialized => { x => 'y'}});
+
+$object->serialized->{x} = 'z'; # change state without notifying $object
+ok (!$object->get_dirty_columns, 'no dirty columns yet');
+is_deeply ($object->serialized, { x => 'z' }, 'object data correct');
+
+$object->make_column_dirty('serialized');
+$object->update;
+
+is_deeply ($rs->first->serialized, { x => 'z' }, 'changes made it to the db' );
index 08df104..1dd0829 100644 (file)
@@ -14,19 +14,18 @@ my $schema = DBICTest->init_schema();
 
 
 my $no_prefetch = $schema->resultset('Artist')->search(
-  undef,
-  { rows => 3 }
-);
-
-my $use_prefetch = $schema->resultset('Artist')->search(
   [   # search deliberately contrived
     { 'artwork.cd_id' => undef },
     { 'tracks.title' => { '!=' => 'blah-blah-1234568' }}
   ],
+  { rows => 3, join => { cds => [qw/artwork tracks/] },
+ }
+);
+
+my $use_prefetch = $no_prefetch->search(
+  {},
   {
     prefetch => 'cds',
-    join => { cds => [qw/artwork tracks/] },
-    rows     => 3,
     order_by => { -desc => 'name' },
   }
 );
index 65093c4..a55b296 100644 (file)
@@ -40,8 +40,8 @@ if ($INC{'DBICTest/HelperRels.pm'}) {
       year => 2005,
   } );
 
- SKIP:{
-    skip "Can't fix right now", 1 if $DBIx::Class::VERSION < 0.09;
+ TODO: {
+    local $TODO = "Can't fix right now" if $DBIx::Class::VERSION < 0.09;
     lives_ok { $big_flop->genre} "Don't throw exception when col is not loaded after insert";
   };
 }
index 3ccd4a7..fd86646 100644 (file)
@@ -68,7 +68,7 @@ ok( ( $ratio < 2 ), 'Overload/bless performance acceptable' )
     "in the Troubleshooting POD documentation entitled\n",
     "'Perl Performance Issues on Red Hat Systems'\n",
     "As this is an extremely serious condition, the only way to skip\n",
-    "over this test is to --force the installation, or to edit the test\n",
+    "over this test is to --force the installation, or to look in the test\n",
     "file " . __FILE__ . "\n",
   );
 
@@ -115,7 +115,7 @@ SKIP: {
         "Please read the section in the Troubleshooting POD documentation\n",
         "entitled 'Perl Performance Issues on Red Hat Systems'\n",
         "As this is an extremely serious condition, the only way to skip\n",
-        "over this test is to --force the installation, or to edit the test\n",
+        "over this test is to --force the installation, or to look in the test\n",
         "file " . __FILE__ . "\n",
       );
 }