The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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');