From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 6 May 2010 14:30:35 +0000 (+0000)
Subject: Play nicer with lower-level methods
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cde96798a03e3e65b2bca2a3246164faab434a03;p=dbsrgits%2FDBIx-Class-Historic.git

Play nicer with lower-level methods
---

diff --git a/lib/DBIx/Class/FilterColumn.pm b/lib/DBIx/Class/FilterColumn.pm
index 2f9b4f1..9bea8a3 100644
--- a/lib/DBIx/Class/FilterColumn.pm
+++ b/lib/DBIx/Class/FilterColumn.pm
@@ -74,9 +74,16 @@ sub set_column {
 sub set_filtered_column {
   my ($self, $col, $filtered) = @_;
 
-  $self->set_column($col, $self->_column_to_storage($col, $filtered));
+  # do not blow up the cache via set_column unless necessary
+  # (filtering may be expensive!)
+  if (exists $self->{_filtered_column}{$col}) {
+    return $filtered
+      if ($self->_eq_column_values ($col, $filtered, $self->{_filtered_column}{$col} ) );
 
-  delete $self->{_filtered_column}{$col};
+    $self->make_column_dirty ($col); # so the comparison won't run again
+  }
+
+  $self->set_column($col, $self->_column_to_storage($col, $filtered));
 
   return $filtered;
 }
@@ -163,11 +170,3 @@ Returns the filtered value of the column
  $obj->set_filtered_column(colname => 'new_value')
 
 Sets the filtered value of the column
-
-=head2 update
-
-Just overridden to filter changed columns through this component
-
-=head2 new
-
-Just overridden to filter columns through this component
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 4ce8153..6945cd6 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -865,29 +865,15 @@ sub set_column {
   my $old_value = $self->get_column($column);
   $new_value = $self->store_column($column, $new_value);
 
-  my $dirty;
-  if (!$self->in_storage) { # no point tracking dirtyness on uninserted data
-    $dirty = 1;
-  }
-  elsif (defined $old_value xor defined $new_value) {
-    $dirty = 1;
-  }
-  elsif (not defined $old_value) {  # both undef
-    $dirty = 0;
-  }
-  elsif ($old_value eq $new_value) {
-    $dirty = 0;
-  }
-  else {  # do a numeric comparison if datatype allows it
-    if ($self->_is_column_numeric($column)) {
-      $dirty = $old_value != $new_value;
-    }
-    else {
-      $dirty = 1;
-    }
-  }
-
-  # sadly the update code just checks for keys, not for their value
+  my $dirty =
+    $self->{_dirty_columns}{$column}
+      ||
+    $self->in_storage # no point tracking dirtyness on uninserted data
+      ? ! $self->_eq_column_values ($column, $old_value, $new_value)
+      : 1
+  ;
+
+  # FIXME sadly the update code just checks for keys, not for their value
   $self->{_dirty_columns}{$column} = 1 if $dirty;
 
   # XXX clear out the relation cache for this column
@@ -896,6 +882,26 @@ sub set_column {
   return $new_value;
 }
 
+sub _eq_column_values {
+  my ($self, $col, $old, $new) = @_;
+
+  if (defined $old xor defined $new) {
+    return 0;
+  }
+  elsif (not defined $old) {  # both undef
+    return 1;
+  }
+  elsif ($old eq $new) {
+    return 1;
+  }
+  elsif ($self->_is_column_numeric($col)) {  # do a numeric comparison if datatype allows it
+    return $old == $new;
+  }
+  else {
+    return 0;
+  }
+}
+
 =head2 set_columns
 
   $row->set_columns({ $col => $val, ... });
@@ -1375,7 +1381,6 @@ second argument to $resultset->search($cond, $attrs);
 
 sub discard_changes {
   my ($self, $attrs) = @_;
-  delete $self->{_dirty_columns};
   return unless $self->in_storage; # Don't reload if we aren't real!
 
   # add a replication default to read from the master only
diff --git a/t/03podcoverage.t b/t/03podcoverage.t
index 3115234..0b2bbbe 100644
--- a/t/03podcoverage.t
+++ b/t/03podcoverage.t
@@ -46,6 +46,13 @@ my $exceptions = {
             MULTICREATE_DEBUG
         /],
     },
+    'DBIx::Class::FilterColumn' => {
+        ignore => [qw/
+            new
+            update
+            set_column
+        /],
+    },
     'DBIx::Class::ResultSource' => {
         ignore => [qw/
             compare_relationship_keys
diff --git a/t/row/filter_column.t b/t/row/filter_column.t
index 60c305d..a844962 100644
--- a/t/row/filter_column.t
+++ b/t/row/filter_column.t
@@ -68,51 +68,66 @@ MC: {
    is $cd->artist->rank, 20, 'artist rank gets correctly filtered w/ MC';
 }
 
-my $initial_from = $from_storage_ran;
-my $initial_to   = $to_storage_ran;
+my $expected_from = $from_storage_ran;
+my $expected_to   = $to_storage_ran;
 
 # ensure we are creating a fresh obj
 $artist = $schema->resultset('Artist')->single($artist->ident_condition);
 
-is $initial_from, $from_storage_ran, 'from has not run yet';
-is $initial_from, $from_storage_ran, 'to has not run yet';
+is $from_storage_ran, $expected_from, 'from has not run yet';
+is $to_storage_ran, $expected_to, 'to has not run yet';
 
 $artist->rank;
-$artist->get_filtered_column('rank');
-$artist->get_column('rank');
+cmp_ok (
+  $artist->get_filtered_column('rank'),
+    '!=',
+  $artist->get_column('rank'),
+  'filter/unfilter differ'
+);
+is $from_storage_ran, ++$expected_from, 'from ran once, therefor caches';
+is $to_storage_ran, $expected_to,  'to did not run';
 
-is $from_storage_ran, $initial_from + 1, 'from ran once, therefor caches';
-is $to_storage_ran, $initial_to,  'to ran none';
-$initial_from = $from_storage_ran;
-$initial_to   = $to_storage_ran;
+$artist->rank(6);
+is $from_storage_ran, $expected_from, 'from did not run';
+is $to_storage_ran, ++$expected_to,  'to ran once';
 
-$artist->rank(1);
-
-is $from_storage_ran, $initial_from, 'from ran none';
-is $to_storage_ran, $initial_to + 1,  'to ran once';
-$initial_from = $from_storage_ran;
-$initial_to   = $to_storage_ran;
+ok ($artist->is_column_changed ('rank'), 'Column marked as dirty');
 
 $artist->rank;
-
-is $from_storage_ran, $initial_from + 1, 'from ran once';
-is $to_storage_ran, $initial_to,  'to ran none';
-$initial_from = $from_storage_ran;
-$initial_to   = $to_storage_ran;
+is $from_storage_ran, ++$expected_from, 'from ran once';
+is $to_storage_ran, $expected_to,  'to did not run';
 
 $artist->rank;
+is $from_storage_ran, $expected_from, 'from did not run';
+is $to_storage_ran, $expected_to,  'to did not run';
 
-is $from_storage_ran, $initial_from, 'from ran none';
-is $to_storage_ran, $initial_to,  'to ran none';
-$initial_from = $from_storage_ran;
-$initial_to   = $to_storage_ran;
-
-$artist->set_column(rank => 1);
-$artist->rank;
+$artist->update;
 
-is $from_storage_ran, $initial_from + 1, 'from ran once (set column blows cache)';
-is $to_storage_ran, $initial_to,  'to ran none';
-$initial_from = $from_storage_ran;
-$initial_to   = $to_storage_ran;
+$artist->set_column(rank => 3);
+ok (! $artist->is_column_changed ('rank'), 'Column not marked as dirty on same set_column value');
+is ($artist->rank, '6', 'Column set properly (cache blown)');
+is $from_storage_ran, ++$expected_from, 'from ran once (set_column blew cache)';
+is $to_storage_ran, $expected_to,  'to did not run';
+
+$artist->rank(6);
+ok (! $artist->is_column_changed ('rank'), 'Column not marked as dirty on same accessor-set value');
+is ($artist->rank, '6', 'Column set properly');
+is $from_storage_ran, $expected_from, 'from did not run';
+is $to_storage_ran, $expected_to,  'to did not run';
+
+$artist->store_column(rank => 4);
+ok (! $artist->is_column_changed ('rank'), 'Column not marked as dirty on differing store_column value');
+is ($artist->rank, '6', 'Filtered column still contains old value (cache not blown)');
+is $from_storage_ran, $expected_from, 'from did not run';
+is $to_storage_ran, $expected_to,  'to did not run';
+
+$artist->set_column(rank => 4);
+TODO: {
+  local $TODO = 'There seems to be no way around that much wizardry... which is ok';
+  ok ($artist->is_column_changed ('rank'), 'Column marked as dirty on out-of-sync set_column value');
+}
+is ($artist->rank, '8', 'Column set properly (cache blown)');
+is $from_storage_ran, ++$expected_from, 'from ran once (set_column blew cache)';
+is $to_storage_ran, $expected_to,  'to did not run';
 
 done_testing;