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::thaw($_) } }); } undef $db; # avoid untie() gotcha return $db_ref; }