On-disk hash/array data structures

[repellent]

Please note that there are already modules that do this: DBM::Deep and MLDBM come to mind.

Here are a couple of drop-in functions to return a hash or array reference to a temporary DB_File. Not really a new idea - just had to be put together for ease.

This serves as a useful hack if we wanted our large data structure to be on-disk instead of in-memory. Remember to untie the references when done using them.

• Use db_ref() to generate a new hash/array reference.
• Use db_open_ref() to open an existing DB_File.

use warnings;
use strict;

use Data::Dumper;

my $h1 = db_ref("HASH");
my $h2 = db_ref("HASH");

$h1->{hello} = { 123 => 456, 789 => [ 3, 4, 5 ] };
$h1->{crazy} = 747;
$h2->{world} = [ 5, 6, 7, $h1->{hello} ];

print "key> $_\n" for keys %{ $h1 };
print Dumper($h2->{world});

untie %{ $h1 };
untie %{ $h2 };

my $a = db_ref("ARRAY", 1); # no serialization

push @{ $a }, 1..4;
print "item> $_\n" for @{ $a };

untie @{ $a };

sub db_ref {
    my $type = shift() || "HASH"; # "HASH"  = DB_HASH
                                  # "BTREE" = DB_BTREE
                                  # others  = DB_RECNO
    my $simple_db = shift(); # set true to disable serialized DB
    my $keep_db   = shift(); # set true to not remove DB upon exit

    # optional 4th arg = CODE ref for filter_store_value()
    # optional 5th arg = CODE ref for filter_fetch_value()

    require File::Temp;
    require File::Spec;

    # create temporary file
    (undef, my $filename) = File::Temp::tempfile(
        File::Spec->catfile(
            File::Spec->tmpdir(),
            substr($type, 0, 1) . "_XXXXXX",
        ),
        UNLINK => !$keep_db,
    );

    # open new DB with temporary file
    return db_open_ref($filename, $type, $simple_db, @_);
}

sub db_open_ref {
    my $filename  = shift();
    my $type      = shift() || "HASH";
    my $simple_db = shift();

    # optional 4th arg = CODE ref for filter_store_value()
    # optional 5th arg = CODE ref for filter_fetch_value()

    return () unless defined($filename);

    require DB_File;
    require Fcntl;

    # determine database type
    my $db_type;
    {
        no warnings qw(once);

        $db_type = $type eq "HASH"
            ? $DB_File::DB_HASH
            : $type eq "BTREE"
                ? $DB_File::DB_BTREE
                : $DB_File::DB_RECNO;
    }

    # return tied hash/array reference to database
    my $db_ref;
    my $db = tie(
        ($type eq "HASH" || $type eq "BTREE"
            ? %{ $db_ref }
            : @{ $db_ref }
        ),
        "DB_File",
        $filename,
        Fcntl::O_RDWR() | Fcntl::O_CREAT(),
        0600,
        $db_type,
    ) or return ();

    # add DB filters to serialize complex data structures
    unless ($simple_db)
    {
        require Storable unless @_ >= 2;
        $db->filter_store_value(shift() || sub { $_ = Storable::freeze
+(\$_) });
        $db->filter_fetch_value(shift() || sub { $_ = ${ Storable::tha
+w($_) } });
    }
    undef $db; # avoid untie() gotcha

    return $db_ref;
}