Search code examples
perltie

Possible to call STORE on deeper level tied hash assignment?


I'm trying to write a Perl module for a “persistent YAML hash”, with the following properties:

  • With every access, check if the YAML file has changed, and if so, reload.
  • As soon as any data in the hash is changed, save.
  • Don't save on 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?


Solution

  • 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:

    • Changing the scalar directly:
      • ++$foo{a};
      • chomp($foo{a});
      • $foo{a} =~ s/x/y/g;
      • ...
    • Changing a scalar via an alias or a reference:
      • my \$x = \$foo{a}; $x = 123;
      • my $r = \$foo{a}; $$r = 123;
      • for ($foo{a}) { $_ = 123; }
      • sub { $_[0] = 123; }->($foo{a});
      • ...