The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w

# QDBM_File::Multiple large object test script based on DB_File - db_hash.t

use strict;
use Test::More tests => 24;
use Fcntl;
use File::Path;
use File::Spec;

BEGIN {
    use_ok('QDBM_File');
}

my $class = "QDBM_File::Multiple";
my $tempdir = "t/db_hash_multi_lob_temp";
mkpath($tempdir);
my $tempfile = File::Spec->catfile($tempdir, "db_hash_multi_lob_test");

my %tie;
my $db = tie %tie, $class, $tempfile, O_RDWR|O_CREAT, 0640;

END {
    rmtree($tempdir);
}

isa_ok($db, $class);

$db->store_lob('abc', 'ABC');

ok( $db->exists_lob('abc') );
is( $db->fetch_lob('abc'), 'ABC' );
ok( !$db->exists_lob('def') );
ok( !defined $db->fetch_lob('def') );

$db->store_lob('abc', "Null \0 Value");
is( $db->fetch_lob('abc'), "Null \0 Value" );

$db->delete_lob('abc');
ok( !$db->exists_lob('abc') );

$db->store_lob("null\0key", "Null Key");
is( $db->fetch_lob("null\0key"), "Null Key" );
$db->delete_lob("null\0key");
ok( !$db->exists_lob("null\0key") );

$db->store_lob("a", "A");
$db->store_lob("b", "B");

undef $db;
untie %tie;

$db = tie %tie, $class, $tempfile, O_RDWR, 0640;
ok($db);

is( $db->fetch_lob("a"), "A" );
is( $db->fetch_lob("b"), "B" );

$db->store_lob("c", "C");
$db->store_lob("d", "D");
$db->store_lob("e", "E");
$db->store_lob("f", "F");

is( $db->count_lob_records, 6 );

$db->store_lob("empty value", "");
ok( $db->fetch_lob("empty value") eq "" );

SKIP: {
    my $stat1 = eval { $db->store_lob("", "empty key") };

    if (!$stat1) {
        skip("LOB: can not use empty key", 1);
    }

    ok($stat1);
}

$db->store_lob("cattest", "CAT");
$db->store_cat_lob("cattest", "TEST");
is( $db->fetch_lob("cattest"), "CATTEST" );

my $stat2 = eval { $db->store_keep_lob("keeptest", "KEEP"); };
ok($stat2);
is( $db->fetch_lob("keeptest"), "KEEP" );
$stat2 = eval { $db->store_keep_lob("keeptest", "KEEP2"); };
ok(!$stat2);
is( $db->fetch_lob("keeptest"), "KEEP" );

ok(0 < eval { $db->get_size; });
ok(eval { $db->sync; });
ok(eval { $db->optimize; });

undef $db;
untie %tie;