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