package HashFile;
# persistent tied Hash ín File


use strict;
use warnings;
use Tie::Hash;
use IO::File;
use Fcntl qw(:flock);
use base qw(Tie::StdHash);

sub TIEHASH{
    my $class = shift;
    my %opts = (
        flock => 0,
        file  => '',
    @_);
    return eval{
        my $self = $class->SUPER::TIEHASH();
        my $fh = IO::File->new();
        $fh->open($opts{file}, O_CREAT|O_BINARY|O_RDWR) || die $!;
        flock $fh, LOCK_EX if $opts{flock};
        *self->{FH} = $fh;
        *self->{OPTS} = \%opts;
        my $h = $self->_thaw();        
        %$self = %$h;
        $self;
    };
}

sub write{
    my $self = shift;
    $self->_freeze;
}

sub _freeze{
    my $self = shift;
    my $fh = *self->{FH};
    $fh->seek(0,0);
    $fh->truncate(0);
    use bytes;
    while( my ($k, $v) = each %$self){
        my $def = defined $v ? 1 : 0; 
        $v ||= '';
        $fh->print(pack("V", length $k), pack("V", length $v), $k, $v, $def);
    }
}
sub _thaw{
    my $self = shift;
    my $fh = *self->{FH};
    $fh->seek(0,0);
    my %h = ();
    use bytes;
    while( read($fh, my $lens, 8) ){
        my ($klen, $vlen) = unpack "VV", $lens;
        read($fh, my $k, $klen);
        read($fh, my $v, $vlen);
        read($fh, my $def, 1);
        $h{$k} = $def ? $v : undef;
    }
    \%h;
}

sub DESTROY{
    my $self = shift;
    $self->_freeze if *self->{OPTS}{auto};
}
1;#########################################################################
package main;

use strict;
use warnings;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

tie my %h, 'HashFile', file => 'hashfile.bin', auto => 1 or die $@;
#%h = (foo => '', bar => 1, baz => undef);
print Dumper \%h;