http://paperlined.org/src/pl/jollies/backend/dbm/edhashstorable.pl

#!/usr/bin/perl

# allows the user to edit a value in a Berkeley DB, given its key

    use strict;
    use warnings;

    use BerkeleyDB;
    use Storable;
    use File::Temp qw/ tempfile tempdir /;
    use Safe;


    use Data::Dumper;


@ARGV >= 2
    or die "Syntax: $0 <db_file> <key>\n";

my $filename = shift;
my $key = shift;

#-e $filename or die "Please specify a valid db file.\n";




my $env = new BerkeleyDB::Env;

my %hash;
my $db  = tie %hash, 'BerkeleyDB::Btree',
            -Filename => $filename,
            -Flags    => DB_CREATE
    or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ;



my $contents;
my $contents_txt;
if (! exists $hash{$key}) {
    print "Key '$key' did not exist.  Creating.\n";
    sleep(2);
    $contents_txt = '';
} else {
    $contents = Storable::thaw($hash{$key});
    $Data::Dumper::Terse++;
    $contents_txt = Data::Dumper::Dumper($contents);
}



my ($fh, $tempfilename) = tempfile();
print $fh $contents_txt;
close $fh;


while (1) {
    system "vim", $tempfilename;


    open FIN, "<$tempfilename" or die "Unable to read temporary file back in ('$filename'): $!\n";
    $contents_txt = do {local $/=undef; <FIN>};
    close FIN;

    #print "Got:\n$contents_txt\n";


    # find out whether it compiles okay
    my $cpt = new Safe;
    $cpt->permit(qw( :base_core :base_mem :base_loop  ));
    my @contents = $cpt->reval($contents_txt);
    if ($@) {
        print "Unable to compile.\n$@\n\nPress enter to edit again, Ctrl-C to cancel.\n";
        my $linein = <STDIN>;
    } else {
        if (scalar(@contents) == 1) {
            $contents = $contents[0];
        } else {
            print "Got[*]:\n", Dumper \@contents;
            $contents = \@contents;
        }

        if (!ref($contents)) {
            print "Error, value must be a reference.\n";
            next;
        }
    
        last;
    }
}
unlink $tempfilename;


print "Got:\n", Dumper($contents);

$hash{$key} = Storable::freeze($contents);