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

matthewt at dev.catalyst.perl.org matthewt at dev.catalyst.perl.org
Mon Aug 6 18:58:43 GMT 2007


Author: matthewt
Date: 2007-08-06 18:58:42 +0100 (Mon, 06 Aug 2007)
New Revision: 3649

Added:
   DBIx-Class-Cursor-Cached/1.000/trunk/t/
   DBIx-Class-Cursor-Cached/1.000/trunk/t/simple.t
Modified:
   DBIx-Class-Cursor-Cached/1.000/trunk/lib/DBIx/Class/Cursor/Cached.pm
Log:
tests

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	2007-08-05 15:49:08 UTC (rev 3648)
+++ DBIx-Class-Cursor-Cached/1.000/trunk/lib/DBIx/Class/Cursor/Cached.pm	2007-08-06 17:58:42 UTC (rev 3649)
@@ -68,6 +68,8 @@
   delete $self->{data};
 }
 
+sub cache_key { shift->{cache_key} }
+
 1;
 
 =head1 NAME

Added: DBIx-Class-Cursor-Cached/1.000/trunk/t/simple.t
===================================================================
--- DBIx-Class-Cursor-Cached/1.000/trunk/t/simple.t	                        (rev 0)
+++ DBIx-Class-Cursor-Cached/1.000/trunk/t/simple.t	2007-08-06 17:58:42 UTC (rev 3649)
@@ -0,0 +1,104 @@
+BEGIN {
+  package SchemaClass::CD;
+
+  use base qw(DBIx::Class::Core);
+
+  __PACKAGE__->table('cd');
+  __PACKAGE__->add_columns(
+    'id' => {
+      data_type => 'integer',
+      is_auto_increment => 1,
+    },
+    'title' => {
+      data_type => 'varchar',
+      size      => 100,
+    },
+  );
+  __PACKAGE__->set_primary_key('id');
+
+  package SchemaClass;
+
+  use base qw(DBIx::Class::Schema);
+
+  __PACKAGE__->register_class(CD => 'SchemaClass::CD');
+
+  sub deploy {
+    my $self = shift;
+    $self->storage->dbh->do(q{
+      CREATE TABLE cd (
+        id INTEGER PRIMARY KEY NOT NULL,
+        title varchar(100) NOT NULL
+      );
+    });
+  }
+
+  sub init {
+    my $self = shift;
+    $self->deploy;
+    $self->resultset('CD')->populate([
+      map { { title => $_ } } 'CD one', 'CD two'
+    ]);
+  }
+
+}
+
+use Cache::FileCache;
+use DBIx::Class::Cursor::Cached;
+use Test::More 'no_plan';
+
+unlink('t/var/test.db');
+
+my ($dsn, $user, $pass) = ('dbi:SQLite:t/var/test.db');
+
+SchemaClass->connect($dsn,$user,$pass)->init;
+
+require Data::Dumper;
+
+my $expect_data = [ [ 1, 'CD one' ], [ 2, 'CD two' ] ];
+
+{ ## start test block
+
+  my $schema = SchemaClass->connect(
+    $dsn, $user, $pass, { 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 = $rs->all; # refills 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');
+
+}




More information about the Bast-commits mailing list