[Bast-commits] r9821 - in DBIx-Class-Cursor-Cached/1.000/trunk: lib/DBIx/Class/Cursor t

[arcanez at dev.catalyst.perl.org]

Author: arcanez
Date: 2011-01-21 01:52:50 +0000 (Fri, 21 Jan 2011)
New Revision: 9821

Modified:
   DBIx-Class-Cursor-Cached/1.000/trunk/lib/DBIx/Class/Cursor/Cached.pm
   DBIx-Class-Cursor-Cached/1.000/trunk/t/simple.t
Log:
base cache key on sql and binds plus dbname and username

Modified: DBIx-Class-Cursor-Cached/1.000/trunk/lib/DBIx/Class/Cursor/Cached.pm
===================================================================
--- DBIx-Class-Cursor-Cached/1.000/trunk/lib/DBIx/Class/Cursor/Cached.pm	2010-12-19 05:25:03 UTC (rev 9820)
+++ DBIx-Class-Cursor-Cached/1.000/trunk/lib/DBIx/Class/Cursor/Cached.pm	2011-01-21 01:52:50 UTC (rev 9821)
@@ -48,7 +48,24 @@
 
 sub _build_cache_key {
   my ($class, $storage, $args, $attrs) = @_;
-  return Digest::SHA1::sha1_hex(Storable::nfreeze([ $args, $attrs ]));
+  # compose the query and bind values, like as_query(),
+  # so the cache key is only affected by what the database sees
+  # and not any other cruft in $attrs
+  my $ref = $storage->_select_args_to_query(@{$args}[0..2], $attrs);
+  my $connect_info = $storage->_dbi_connect_info;
+  my ($dbname, $username);
+  if (ref($connect_info->[0]) eq 'CODE') {
+    my $dbh = $connect_info->[0]->();
+    $dbname = $dbh->{Name};
+    $username = $dbh->{Username} || '';
+  } else {
+    $dbname = $connect_info->[0];
+    $username = $connect_info->[1] || '';
+  }
+  
+  local $Storable::canonical = 1;
+  return Digest::SHA1::sha1_hex(Storable::nfreeze( [ $ref, $dbname, $username ] ));
+
 }
 
 sub _fill_data {

Modified: DBIx-Class-Cursor-Cached/1.000/trunk/t/simple.t
===================================================================
--- DBIx-Class-Cursor-Cached/1.000/trunk/t/simple.t	2010-12-19 05:25:03 UTC (rev 9820)
+++ DBIx-Class-Cursor-Cached/1.000/trunk/t/simple.t	2011-01-21 01:52:50 UTC (rev 9821)
@@ -101,3 +101,52 @@
   'correct data in cache');
 
 }
+
+{
+  my $schema = SchemaClass->connect(
+    sub {
+      DBI->connect('dbi:SQLite:t/var/test.db', '', '', { RaiseError => 1 }) },
+        { cursor_class => 'DBIx::Class::Cursor::Cached' }
+  );
+
+  $schema->default_resultset_attributes({
+    cache_object => Cache::FileCache->new({ namespace => 'SchemaClass' }),
+  });
+
+my $cache = $schema->default_resultset_attributes->{cache_object};
+
+  my $rs = $schema->resultset('CD')->search(undef, { cache_for => 300 });
+
+  my @cds = $rs->all; # fills cache
+
+is_deeply([ map { [ $_->id, $_->title ] } @cds ], $expect_data,
+  'correct data in objects');
+is_deeply($cache->get($rs->cursor->cache_key), $expect_data,
+  'correct data in cache');
+
+  $rs = $schema->resultset('CD')->search(undef, { cache_for => 300 });
+    # refresh resultset
+
+$schema->storage->disconnect;
+
+  @cds = $rs->all; # uses cache, no SQL run
+
+ok(!$schema->storage->connected, 'no reconnect made since no SQL required');
+is_deeply([ map { [ $_->id, $_->title ] } @cds ], $expect_data,
+  'correct data in objects');
+is_deeply($cache->get($rs->cursor->cache_key), $expect_data,
+  'correct data in cache');
+
+  $rs->cursor->clear_cache; # deletes data from cache
+
+ok(!defined($cache->get($rs->cursor->cache_key)), 'cache cleared');
+
+  @cds = (); while (my $rec = $rs->next) { push(@cds, $rec); }
+
+is_deeply([ map { [ $_->id, $_->title ] } @cds ], $expect_data,
+  'correct data in objects');
+is_deeply($cache->get($rs->cursor->cache_key), $expect_data,
+  'correct data in cache');
+}
+
+