Tie-ing hashes clobbers data

[Dave05]

Peace be upon the Monksters;

I have a simple (or so I thought) class ('FileHash') that ties a hash to a file, reading data into the hash upon instantiation, and writing the hash out to the file when DESTROYed.

I want to use the class for several hashes e.g.

my (%pwds, %boxes); 
tie (%pwds,  'FileHash', "$dir/pwds"); 
tie (%boxes, 'FileHash', "$dir/boxes");

but the second call to tie clears out any data that may have been read into the first hash and replaces it with the data from the second hash.

I just can't get my head around why this happens.

Here is the code for my class:

package FileHash;
use strict;
use warnings;
use Tie::Hash;
use Data::Dumper;
our @ISA = ("Tie::Hash");

sub TIEHASH {
   my ($class, $file) = @_;
   my $s = {}; 
   $s->{DATA} = _read($file) || {};
   $s->{FILE} = $file;
   bless $s, $class;
}

sub STORE    { $_[0]->{DATA}{$_[1]} = $_[2] }
sub CLEAR    { $_[0]->{DATA} = () }
sub FETCH    { $_[0]->{DATA}{$_[1]} }
sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]->{DATA}} }
sub NEXTKEY  { each %{$_[0]->{DATA}} }
sub EXISTS   { exists $_[0]->{DATA}{$_[1]} }
sub DELETE   { delete $_[0]->{DATA}{$_[1]} }
sub DESTROY  { _write ($_[0]) }

# ----- private subs -----
sub _write { # still need to deal with race conditions
   my %data = %{$_[0]->{DATA}};
   my $file =   $_[0]->{FILE} ;
   open (FH, "> $file") or die "Can't open $file for FileHash _write: 
+$!";
   print FH Data::Dumper->Dump([\%data], ['*data']); 
   close FH or die "Can't close $file for FileHash _write: $!";
}

sub _read { # still need to deal with race conditions
   no strict;
   my $file = shift;
   return undef unless -f $file;
   unless (my $ret = do $file) {
      warn "couldn't parse $file: $@" if $@;
      warn "couldn't do $file: $!"    unless defined $ret;
   }
   return \%data;
}

1;

[demerphq]

Couple of points. A cyclic or self-referential structure will break your Tie. Second in the _write sub you are making a _copy_ of the hash. This may or may not be what you want to do.

But I think the heart of your problem is here:

print FH Data::Dumper->Dump([\%data], ['*data']);

and here

my $ret = do $file

This line sets the $ret value to be equal to the glob *data which was just overwritten by you. (ok, so you ignore the $ret and use the global var \%data, but that was just overwritten so... Same dif.) So its the copy semantics in the _write and _read subs that are causing you trouble. Change them to use scalar refs and not globs and the problem will go away. Oh and lose the shallow copy in _read its misleading and unnecessary.

UPDATE

A question: Why are you mixing proper method calls and procedural calls? _write() is a method, but you call it as a procedure. This means it wont be overidable in a subclass...

sub DESTROY  { _write ($_[0]) } #not overidable!

Yves / DeMerphq
---
Writing a good benchmark isnt as easy as it might look.

[Anonymous Monk]

_write() is a method, but you call it as a procedure. This means it wont be overidable in a subclass...

...and that's the point. A leading underscore indicates a private method.

[demerphq]

...and that's the point. A leading underscore indicates a private method

Er, no.

The point is that its not a method. Its not a private method and its not a public method because it is not a method at all.

Yves / DeMerphq
---
Writing a good benchmark isnt as easy as it might look.

[Joost]

Your problem is in the last line of the _read() method:

return \%data; 

this returns a reference to the GLOBAL %FileHash::data that is set by the do $file, so you are using the same hash for all FileHash objects.

The quickest way to solve this is to change the offending line with:

return {%data};

which returns a reference to a COPY of %data, leaving %FileHash::data free to be clobbered by a new do $file

anyway, this will still leave your race conditions intact :-)

Joost.

[demerphq]

The quickest way to solve this is to change the offending line with:

return {%data};

Hmm, so now he makes a copy of a copy of a copy.... I dont think this is the best call. Do away with the glob semantics and this all becomes very straightforward...

Yves / DeMerphq
---
Writing a good benchmark isnt as easy as it might look.

[Joost]

That's why it's called the quick fix :-)

How about...

package FileHash;
use strict;
use warnings;
use Tie::Hash;
use Data::Dumper;
our @ISA = ("Tie::Hash");

sub TIEHASH {
   my ($class, $file) = @_;
   my $s = bless {
        FILE => $file,
        DATA => {},
    },$class;
   $s->_read();
   return $s;
}


sub STORE    { $_[0]->{DATA}->{$_[1]} = $_[2] }
sub CLEAR    { $_[0]->{DATA} = () }
sub FETCH    { $_[0]->{DATA}->{$_[1]} }
sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]->{DATA}} }
sub NEXTKEY  { each %{$_[0]->{DATA}} }
sub EXISTS   { exists $_[0]->{DATA}->{$_[1]} }
sub DELETE   { delete $_[0]->{DATA}->{$_[1]} }
sub DESTROY  { $_[0]->_write }

# ----- private subs -----
sub _write { # still need to deal with race conditions
   my $file =   $_[0]->{FILE} ;
   open (FH, "> $file") or die "Can't open $file for FileHash _write: 
+$!";
   print FH Dumper($_[0]->{DATA});  # writes out as $VAR1 = { ..... }
   close FH or die "Can't close $file for FileHash _write: $!";
}

sub _read { # still need to deal with race conditions
   my $self = shift;
   return unless -f $self->{FILE};
   $self->{DATA} = do $self->{FILE};

}


1;

[dragonchild]

Your problem is very simple. All I had to do was look for the one place you have 'no strict' and dig.

You're constantly setting (and re-setting) a global variable called %data. Since you give a reference to this back to your TIEHASH function, any time you write into (or over) %data, that will appear in every single instance of this TIEHASH you have.

Now, a good solution would be to not return a reference, but return a hash. Then, take a reference to the copied hash (which is now not called %data), and you're fine.

A better solution would be this:

# Untested change!!!
sub _read { # still need to deal with race conditions
   my $file = shift;

   return undef unless -f $file;

   our %data;
   unless (my $ret = do $file) {
      warn "couldn't parse $file: $@" if $@;
      warn "couldn't do $file: $!"    unless defined $ret;
   }

   return \%data;
}

That should work. :-)

------
We are the carpenters and bricklayers of the Information Age.

Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

[Dave05]

A question: Why are you mixing proper method calls and procedural calls? _write() is a method, but you call it as a procedure. This means it wont be overidable in a subclass...

Well, this is my first foray into tieing, and writing classes, so basically I don't know what I'm doing here.

I've tried the return (%data) thing, and to declare the our %data;, but these don't work. But I can see that I'm over-writing globals without understanding what I'm doing and that the problem is in there somewhere. So I'm going to play around with getting rid of the glob.

[Dave05]

Thanks guys, I think I've got it now. I simplified the Dumper call and just pass refs around, which I think is what demerphq was talking about. The new _read and _write are:

# ----- private subs -----
sub _write { # still need to deal with race conditions
    my $file =   $_[0]->{FILE} ;
    open (FH, "> $file") or die "Can't open $file for FileHash _write:
+ $!";
    print FH Dumper($_[0]->{DATA}); 
    close FH or die "Can't close $file for FileHash _write: $!";
}

sub _read { # still need to deal with race conditions
    my $file = shift;
    return undef unless -f $file;
    my $ret;
    unless ($ret = do $file) {
        warn "couldn't parse $file: $@" if $@;
        warn "couldn't do $file: $!"    unless defined $ret;
    }
    return $ret;
}

Now I have to read up on writing methods...

[demerphq]

Well, dont forget to change _read to a method now...

Yves / DeMerphq
---
Writing a good benchmark isnt as easy as it might look.