#!/usr/bin/perl

use strict;
use warnings;

use Benchmark qw( :all );
use BerkeleyDB;
use Carp qw( croak );
use DB_File;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC);
use File::Path qw( remove_tree );
use FsDB;
use GDBM_File;
use QDBM_File;
use SQLite_File;

our $db = "honk";
our $KEY = 'BONK';
our $data = "ab" x 1024;

my $N = 0;

cleanup();

timethese( 5000, {
        BerkeleyDB => \&berkeleydb,
        SQLite_File => \&sqlite,
        FsDB => \&fsdb,
        'FsDB;depth=1;primed' => \&fsdb1,
        'FsDB;depth=1' => \&fsdb1,
        DB_File => \&db_file,
        QDBM_File => \&qdbm_file,
        GDBM_File => \&gdbm_file
    } );
#cleanup();

sub work
{
    my( $tie ) = @_;
    croak $! unless tied %$tie;

    $tie->{$KEY} = $data;

    my $v = $tie->{$KEY};
    # delete $tie->{$KEY};

    $tie->{$N++} = $data;

    my $foo = $tie->{$N-1};
    die "Failed" unless $foo eq $data;
}
    
sub berkeleydb 
{
    my $file = "$db.data";
    my %tie;
    tie %tie, 'BerkeleyDB::Hash', ( -Filename => $file, -Flags => DB_CREATE );
    work( \%tie );
}

sub sqlite
{
    my $file = "$db.sqlite";
    my %tie;
    tie %tie, 'SQLite_File', $file, O_CREAT;
    work( \%tie );
}

sub fsdb
{
    my $file = "$db.fsdb";
    my %tie;
    tie %tie, 'FsDB', { dir=>$file, depth=>0 };
    work( \%tie );    
}

sub fsdb1
{
    my $file = "$db.fsdb1";
    my %tie;
    tie %tie, 'FsDB', { dir=>$file, depth=>1 };
    work( \%tie );    
}

sub db_file
{
    my $file = "$db.db";
    my %tie;
    tie %tie, 'DB_File', $file, O_CREAT;
    work( \%tie );    
}

sub qdbm_file
{
    my $file = "$db.qdbm";
    my %tie;
    tie %tie, 'QDBM_File', $file, O_RDWR|O_CREAT, 0640;
    work( \%tie );    
}

sub gdbm_file
{
    my $file = "$db.gdbm";
    my %tie;
    tie %tie, 'GDBM_File', $file, GDBM_WRCREAT, 0640;
    work( \%tie );    
}

sub cleanup
{
    foreach my $ext ( qw( data sqlite fsdb fsdb1 db qdbm gdbm ) ) {
        remove_tree "$db.$ext";
    }
}
