package BerkeleyDB::Hash::CasePreserve;
use BerkeleyDB;
use base 'BerkeleyDB::Hash';

my %LCKeys; # to keep the lc $key => $key mapping for all hashes
sub TIEHASH {
	my $obj = &BerkeleyDB::Hash::TIEHASH;
	my %lckeys;
	my $key = $obj->FIRSTKEY();
	$lckeys{lc $key} = $key;
	$lckeys{lc $key} = $key while $key = $obj->NEXTKEY($key);
	$LCKeys{$obj->[0]} = \%lckeys;
	return $obj;
}

sub FETCH {
	my $self = shift;
	my $key = shift();
	$key = $LCKeys{$self->[0]}->{lc $key}
		or return;
	return $self->SUPER::FETCH($key);
}

sub EXISTS {
	my $self = shift;
	my $key = shift();
	$key = $LCKeys{$self->[0]}->{lc $key}
		or return;
	return $self->SUPER::EXISTS($key);
}

sub STORE {
	my $self = shift;
	my ($key, $value) = @_;
	if (exists $LCKeys{$self->[0]}->{lc $key}) {
		$key = $LCKeys{$self->[0]}->{lc $key};
	} else {
		$LCKeys{$self->[0]}->{lc $key} = $key;
	}
	return $self->SUPER::STORE($key, $value);
}

sub DESTROY {
	my $self = shift();
	delete $LCKeys{$self->[0]};
}

1;