I'm trying to write a Perl module for a “persistent YAML hash”, with the following properties:
UNTIE
, so that the file isn't updated when you only read values.My first attempt seemed to work pretty well:
package YAMLHash;
use v5.24;
use warnings;
use experimental 'signatures';
use YAML::XS qw(DumpFile LoadFile);
use File::stat;
sub refresh($self)
{
if (-f $self->{file}) {
if (stat($self->{file})->mtime > $self->{mtime}) {
$self->{data} = LoadFile($self->{file});
$self->{mtime} = stat($self->{file})->mtime;
}
}
}
sub save($self)
{
DumpFile($self->{file}, $self->{data});
$self->{mtime} = stat($self->{file})->mtime;
}
sub TIEHASH($class, @args)
{
my ($filename) = $args[0];
die "No filename specified" unless $filename;
my $self = bless { data=>{}, file=>$filename, mtime=>0 }, $class;
refresh($self);
return $self;
}
sub FETCH($self, $key = '')
{
refresh($self);
return $self->{data}{$key};
}
sub EXISTS($self, $key)
{
refresh($self);
return exists($self->{data}{$key});
}
sub FIRSTKEY($self)
{
refresh($self);
my @ignore = keys %{$self->{data}}; # reset iterator
return each %{$self->{data}};
}
sub NEXTKEY($self, $lastkey)
{
refresh($self);
return each %{$self->{data}};
}
sub SCALAR($self)
{
return scalar %{$self->{data}};
}
sub STORE($self, $key, $value)
{
refresh($self);
$self->{data}{$key} = $value;
save($self);
}
sub DELETE($self, $key)
{
refresh($self);
delete $self->{data}{$key};
save($self);
}
sub CLEAR($self, $key)
{
$self->{data} = {};
save($self);
}
1;
I tried this as follows:
use YAMLHash;
tie my %foo, 'YAMLHash', 'test.yaml';
$foo{hello} = 'world';
$foo{answer} = 42;
$foo{counter}++;
and the resulting YAML file looks like this:
---
answer: 42
counter: 1
hello: world
But then I changed my example code to:
use YAMLHash;
tie my %foo, 'YAMLHash', 'test.yaml';
$foo{hello} = 'world';
$foo{answer} = 42;
$foo{counter}++;
$foo{a}{b}{c}{d} = 'e';
and the result is:
---
a: {}
answer: 42
counter: 2
hello: world
So, obviously, STORE
is called when $foo{a}
is created, but not when $foo{a}{b}{c}{d}
is assigned.
Is there any way to make this do what I want?
You will need to tie %{ $foo{a} }
, %{ $foo{a}{b} }
and %{ $foo{a}{b}{c} }
as well.
You could recursively tie the hashes and arrays in the data structure in TIEHASH
. Don't forget to the do the same thing to data added to the structure via STORE
!
You might want to use a different class for the root of the data structure and non-root nodes.
Warning: Using tie
will make accesses slower.
Note that you need to tie the scalars too, not just the hashes (and arrays). All of the following change the value of a hash element without calling STORE
:
++$foo{a};
chomp($foo{a});
$foo{a} =~ s/x/y/g;
my \$x = \$foo{a}; $x = 123;
my $r = \$foo{a}; $$r = 123;
for ($foo{a}) { $_ = 123; }
sub { $_[0] = 123; }->($foo{a});