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;
}