use strict;
use warnings;
use Test::More;
use File::Temp qw(tempdir);
use File::Spec;
use Carp;
$SIG{__DIE__} = sub { confess @_; };
my $add_tests;
my $overlap_tests;
my $mixed_tests;
my $remove_tests;
my $mixed_dup_tests;
BEGIN {
$add_tests = 5;
$overlap_tests = 5;
$mixed_tests = 5;
$remove_tests = 5;
$mixed_dup_tests = 5;
plan tests => 20 +
2 * $add_tests +
2 * $overlap_tests +
20 * $mixed_tests +
10 * $remove_tests +
20 * $mixed_dup_tests;
}
use_ok('Cache::File::Heap');
my $tempdir = tempdir(CLEANUP => 1);
my $dbfile = File::Spec->catfile($tempdir, 'test.db');
my $heap = Cache::File::Heap->new($dbfile);
ok($heap, "Heap created ($dbfile)");
# Test basic add and extract
my $val = 'Some data to go in the heap';
my $key = 1053523491;
eval { $heap->add($key, $val) };
ok(!$@, 'Entry added');
my $mkey = $heap->minimum;
ok($mkey, 'Minimum returned');
is($mkey, $key, 'Minimum key correct');
my ($okey, $oval) = $heap->extract_minimum();
is($okey, $key, 'Key of entry extracted');
is($oval, $val, 'Value of entry extracted');
# Test multiple add and extract
for (1..$add_tests) {
$heap->add($_, "Test entry $_");
}
$mkey = $heap->minimum;
is($mkey, 1, 'Minimum key correct');
undef $heap;
$heap = Cache::File::Heap->new($dbfile);
ok($heap, "Heap reopened ($dbfile)");
my $i = 1;
for (1..$add_tests) {
($okey, $oval) = $heap->extract_minimum();
is($okey, $_, "Key of min entry $_ correct ($i)");
is($oval, "Test entry $_", "Value of min entry $_ correct ($i)");
$i++;
}
is($heap->minimum, undef, 'Heap empty');
# Test multiple identical keys
for (1..$overlap_tests) {
$heap->add($key, "Test overlap entry $_");
}
$heap->close();
ok($heap->open($dbfile), "Heap reopened ($dbfile)");
$mkey = $heap->minimum;
is($mkey, $key, 'Minimum key correct');
$i = 1;
for (1..$overlap_tests) {
($okey, $oval) = $heap->extract_minimum();
is($okey, $key, "Key of min overlap entry $_ correct ($i)");
like($oval, qr/^Test overlap entry \d+$/,
"Value of min overlap entry $_ correct ($i)");
$i++;
}
is($heap->minimum, undef, 'Heap empty');
# Test mixed keys
for (1..$mixed_tests) {
$heap->add($_, "Test entry $_ : 1");
}
for (1..$mixed_tests) {
my $skey = $_;
for (2..5) {
$heap->add($skey, "Test entry $skey : $_");
}
}
for (1..$mixed_tests) {
my $skey = $_;
for (6..10) {
$heap->add($skey, "Test entry $skey : $_");
}
}
$mkey = $heap->minimum;
is($mkey, 1, 'Minimum key correct');
undef $heap;
$heap = Cache::File::Heap->new($dbfile);
ok($heap, "Heap reopened ($dbfile)");
$i = 1;
for my $skey (1..$mixed_tests) {
for (1..10) {
($okey, $oval) = $heap->extract_minimum();
is($okey, $skey,
"Key of min mixed entry $skey: $_ correct ($i)");
like($oval, qr/^Test entry $skey : \d+$/,
"Value of min mixed entry $skey : $_ correct ($i)");
$i++;
}
}
is($heap->minimum, undef, 'Heap empty');
# Test remove of items
my @data;
for (1..$remove_tests) {
my $skey = $_;
my $sval = "Test entry $skey : 1";
$heap->add($skey, $sval);
push(@data, [$skey, $sval]);
}
for (1..$remove_tests) {
my $skey = $_;
for (2..5) {
my $sval = "Test entry $skey : $_";
$heap->add($skey, $sval);
push(@data, [$skey, $sval]);
}
}
for (1..$remove_tests) {
my $skey = $_;
for (6..10) {
my $sval = "Test entry $skey : $_";
$heap->add($skey, $sval);
push(@data, [$skey, $sval]);
}
}
undef $heap;
$heap = Cache::File::Heap->new($dbfile);
ok($heap, "Heap reopened ($dbfile)");
# shuffle data
$i = @data;
while ($i--) {
my $j = int rand ($i+1);
@data[$i,$j] = @data[$j,$i];
}
$i = 1;
foreach (@data) {
my ($skey, $sval) = @$_;
ok($heap->delete($skey, $sval), "Entry removed for $skey ($i)");
$i++;
}
is($heap->minimum, undef, 'Heap empty');
# Test extraction of dups
for (1..$mixed_dup_tests) {
$heap->add($_, "Test entry $_ : 1");
}
for (1..$mixed_dup_tests) {
my $skey = $_;
for (2..5) {
$heap->add($skey, "Test entry $skey : $_");
}
}
for (1..$mixed_dup_tests) {
my $skey = $_;
for (6..9) {
$heap->add($skey, "Test entry $skey : $_");
}
}
$mkey = $heap->minimum;
is($mkey, 1, 'Minimum key correct');
$i = 1;
for my $skey (1..$mixed_dup_tests) {
my ($okey, $ovals) = $heap->extract_minimum_dup();
is($okey, $skey, "Key for extracted entries $skey correct");
is(scalar @$ovals, 9, "Correct number of records extracted for $skey");
@$ovals = sort @$ovals;
for (1..9) {
my $oval = shift @$ovals;
is($okey, $skey,
"Key of min dup entry $skey: $_ correct ($i)");
like($oval, qr/^Test\ entry\ $skey\ :\ $_ $/x,
"Value of min dup entry $skey : $_ correct ($i)");
$i++;
}
}
is($heap->minimum, undef, 'Heap empty');