#!perl -T
=head1 PURPOSE
Test retrieving objects by unique field via retrieve_list(), with different
cache options.
=cut
use strict;
use warnings;
use lib 't/lib';
use LocalTest;
use DBIx::NinjaORM;
use Test::Exception;
use Test::More;
LocalTest::ok_memcache();
# Tests.
my $tests =
[
{
skip_cache => undef,
second_retrieve_list =>
{
list_cache_used => 0,
object_cache_used => 1,
},
},
{
skip_cache => 0,
second_retrieve_list =>
{
list_cache_used => 0,
object_cache_used => 1,
},
},
{
skip_cache => 1,
second_retrieve_list =>
{
list_cache_used => 0,
object_cache_used => 0,
},
},
];
plan( tests => scalar( @$tests ) );
# Run tests.
my $count = 0;
foreach my $test ( @$tests )
{
$count++;
my $skip_cache = $test->{'skip_cache'};
subtest(
'Test with skip_cache=' . ( $skip_cache // 'undef' ). '.',
sub
{
plan( tests => 10 );
# Insert row.
ok(
defined(
my $insert_test = DBIx::NinjaORM::Test->new()
),
'Create DBIx::NinjaORM::Test object.',
);
my $name = 'by_unique_field_' . $count . '_' . time();
lives_ok(
sub
{
$insert_test->insert(
{
name => $name,
}
);
},
'Insert new row.',
);
# Retrieve the corresponding object for the first time. It obviously
# can't/shouldn't be in the cache at this stage, since it was just
# inserted.
ok(
my $tests1 = DBIx::NinjaORM::Test->retrieve_list(
name => $name,
skip_cache => $skip_cache,
),
'Retrieve rows by ID.',
);
is(
scalar( @$tests1 ),
1,
'Found one row.',
);
my $test1 = $tests1->[0];
is(
$test1->{'_debug'}->{'list_cache_used'},
0,
'The list cache is not used.',
) || diag( explain( $test1->{'_debug'} ) );
is(
$test1->{'_debug'}->{'object_cache_used'},
0,
'The object cache is not used.',
) || diag( explain( $test1->{'_debug'} ) );
# Retrieve the corresponding object a second time. If cache options are
# set accordingly and we're not explicitely skipping the cache, we should
# have it in the cache.
ok(
my $tests2 = DBIx::NinjaORM::Test->retrieve_list(
name => $name,
skip_cache => $skip_cache,
),
'Retrieve rows by ID.',
);
is(
scalar( @$tests2 ),
1,
'Found one row.',
);
my $test2 = $tests2->[0];
my $expected_list_cache = $test->{'second_retrieve_list'}->{'list_cache_used'};
is(
$test2->{'_debug'}->{'list_cache_used'},
$expected_list_cache,
'The list cache is ' . ( $expected_list_cache ? 'used' : 'not used' ) . '.',
) || diag( explain( $test2->{'_debug'} ) );
my $expected_object_cache = $test->{'second_retrieve_list'}->{'object_cache_used'};
is(
$test2->{'_debug'}->{'object_cache_used'},
$expected_object_cache,
'The object cache is ' . ( $expected_object_cache ? 'used' : 'not used' ) . '.',
) || diag( explain( $test2->{'_debug'} ) );
}
);
}
# Test subclass with enough information to insert rows properly, and with both
# 'object_cache_time' and 'list_cache_time' set.
package DBIx::NinjaORM::Test;
use strict;
use warnings;
use lib 't/lib';
use LocalTest;
use base 'DBIx::NinjaORM';
sub static_class_info
{
my ( $class ) = @_;
my $info = $class->SUPER::static_class_info();
$info->{'default_dbh'} = LocalTest::get_database_handle();
$info->{'table_name'} = 'tests';
$info->{'primary_key_name'} = 'test_id';
$info->{'unique_fields'} = [ 'name' ];
$info->{'object_cache_time'} = 3;
$info->{'list_cache_time'} = 3;
$info->{'memcache'} = LocalTest::get_memcache();
return $info;
}
1;