use strict;
use warnings;
use Test::More;
eval "use Cache::MemoryCache";
plan skip_all => 'Cache::Cache required' if $@;
eval "use DBD::SQLite";
plan skip_all => 'needs DBD::SQLite for testing' if $@;
plan tests => 31;
use lib 't/lib';
use_ok('SweetTest');
SweetTest->cache(Cache::MemoryCache->new(
{ namespace => 'SweetTest', default_expires_in => 60 } ) );
SweetTest->default_search_attributes(
{ use_resultset_cache => 1,
profile_cache => 1 });
SweetTest::Artist->profiling_data({ });
my ($artist) = SweetTest::Artist->search({ name => 'Caterwauler McCrae' });
is($artist->name, 'Caterwauler McCrae', 'Object ok');
is(SweetTest::Artist->profiling_data->{resultset_cache}[0][0],
'MISS', 'Resultset cache miss');
is(SweetTest::Artist->profiling_data->{object_cache}[0][0],
'MISS', 'Object cache miss');
SweetTest::Artist->profiling_data({ });
($artist) = SweetTest::Artist->search({ name => 'Caterwauler McCrae' });
is($artist->name, 'Caterwauler McCrae', 'Object ok');
is(SweetTest::Artist->profiling_data->{resultset_cache}[0][0],
'HIT', 'Resultset cache hit');
is(SweetTest::Artist->profiling_data->{object_cache}[0][0],
'HIT', 'Object cache hit');
SweetTest::Artist->profiling_data({ });
($artist) = SweetTest::Artist->retrieve($artist->artistid);
is($artist->name, 'Caterwauler McCrae', 'Object ok');
is(SweetTest::Artist->profiling_data->{object_cache}[0][0],
'HIT', 'Object cache hit for retrieve');
SweetTest::Artist->profiling_data({ });
$artist->name('Caterwauler McCrae (RIP)');
$artist->update;
sleep 2;
($artist) = SweetTest::Artist->retrieve($artist->artistid);
is($artist->name, 'Caterwauler McCrae (RIP)', 'Object ok');
is(SweetTest::Artist->profiling_data->{object_cache}[0][0],
'MISS', 'Object cache miss after update');
SweetTest::Artist->profiling_data({ });
my @res = SweetTest::Artist->search({ name => 'Caterwauler McCrae' });
cmp_ok(scalar @res, '==', 0, 'Nothing returned');
is(SweetTest::Artist->profiling_data->{resultset_cache}[0][0],
'MISS', 'Resultset cache miss after update');
SweetTest::Artist->profiling_data({ });
($artist) = SweetTest::Artist->search({ 'cds.title' => 'Spoonful of bees' });
is($artist->name, 'Caterwauler McCrae (RIP)', 'Object ok');
is(SweetTest::Artist->profiling_data->{resultset_cache}[0][0],
'MISS', 'Resultset cache miss');
SweetTest::Artist->profiling_data({ });
($artist) = SweetTest::Artist->search({ 'cds.title' => 'Spoonful of bees' });
is($artist->name, 'Caterwauler McCrae (RIP)', 'Object ok');
is(SweetTest::Artist->profiling_data->{resultset_cache}[0][0],
'HIT', 'Resultset cache hit (cross-table)');
SweetTest::CD->create({ artist => $artist, title => 'Foo', year => 2048 });
sleep 2;
SweetTest::Artist->profiling_data({ });
($artist) = SweetTest::Artist->search({ 'cds.title' => 'Spoonful of bees' });
is($artist->name, 'Caterwauler McCrae (RIP)', 'Object ok');
is(SweetTest::Artist->profiling_data->{resultset_cache}[0][0],
'MISS', 'Resultset cache miss (expired cross-table search)');
eval { SweetTest::Artist->search({ }, { prefetch => [ 'cds' ] }) };
like($@, qr/is not a has_a or might_have rel/, 'prefetch errors ok');
my @all = SweetTest::Artist->retrieve_all;
cmp_ok(scalar @all, '==', 3, 'All records retrieved successfully');
SweetTest::CD->profiling_data({ });
my ( $pager, $it ) = SweetTest::CD->pager(
{},
{ rows => 3,
page => 1,
disable_sql_paging => 1 } );
is( SweetTest::CD->profiling_data->{resultset_cache}[0][0],
'MISS', 'disable_sql_paging cache miss ok' );
SweetTest::CD->profiling_data({ });
( $pager, $it ) = SweetTest::CD->pager(
{},
{ rows => 3,
page => 2,
disable_sql_paging => 1 } );
is( SweetTest::CD->profiling_data->{resultset_cache}[0][0],
'HIT', 'disable_sql_paging second page cache hit ok' );
SweetTest::CD->profiling_data({ });
( $pager, $it ) = SweetTest::CD->pager(
{},
{ rows => 3,
page => 2 } );
is( SweetTest::CD->profiling_data->{resultset_cache}[0][0],
'MISS', 'normal paging second page cache miss ok' );
# Cache test for delete(). Add a new artist, get cached, then delete it
SweetTest::Artist->create( { name => 'One Hit Wonder' } );
my ( $new_artist ) = SweetTest::Artist->search( name => 'One Hit Wonder' );
SweetTest::Artist->profiling_data({ });
( $new_artist ) = SweetTest::Artist->search( name => 'One Hit Wonder' );
is( SweetTest::Artist->profiling_data->{resultset_cache}[0][0],
'HIT', 'new artist cache hit ok' );
$new_artist->delete;
SweetTest::Artist->profiling_data({ });
( $new_artist ) = SweetTest::Artist->search( name => 'One Hit Wonder' );
is( SweetTest::Artist->profiling_data->{resultset_cache}[0][0],
'MISS', 'new artist after delete cache miss ok' );
# New object inflation test. Add new CD for an artist. It will be
# cached during create(). Test that foreign data can be accessed.
my ( $new_cd ) = SweetTest::CD->create( {
artist => 2,
title => "Really Awful Music",
year => 2005,
} );
is( $new_cd->artist->name, 'Random Boy Band', 'cache create inflation ok' );
SKIP: {
skip "Requires a patch to Class::DBI", 2;
# Same test as above but with a double primary key table.
# This will fail without Perrin's primary key inflation patch
my ( $new_2pk ) = SweetTest::TwoKeys->create( {
artist => 2,
cd => 3,
} );
eval {
is( $new_2pk->artist->name, 'Random Boy Band', 'cached double primary key inflation ok' );
};
warn $@ if $@;
# Access through the new TwoKeys record via a has_many
( $artist ) = SweetTest::Artist->retrieve(2);
eval {
is( ($artist->twokeys)[1]->cd->artist->name, 'Caterwauler McCrae (RIP)', 'cached double primary key has_many inflation ok' );
};
warn $@ if $@;
}
# Repeat the above 2 tests using a workaround table with a single primary key
my ( $new_1pk ) = SweetTest::OneKey->create( {
artist => 2,
cd => 3,
} );
is( $new_1pk->artist->name, 'Random Boy Band', 'cached single primary key inflation ok' );
# Access through the new OneKey record via a has_many
( $artist ) = SweetTest::Artist->retrieve(2);
eval {
is( ($artist->onekeys)[1]->cd->artist->name, 'Caterwauler McCrae (RIP)', 'cached single primary key has_many inflation ok' );
};
warn $@ if $@;