An interesting problem, so I wanted to know if I could do it. Although there's some bugs, I think I did a reasonable job. The code below keeps a cache of indexes so it doesn't have to iterate over the entire file all the time, and does what you want.
package Tie::NameThis;
use Tie::File;
use Carp;
use strict;
sub TIEHASH {
my ($class, $file) = @_;
my $self = {
lines => [],
scanpointer => 0,
keypointer => 0,
indexes => {}
};
$self->{tie} = tie @{ $self->{lines} }, 'Tie::File', $file;
$self->{tie}->flock();
return bless $self, $class;
}
sub _scan {
my ($self, $key, $wantindex) = @_;
my $indexes = $self->{indexes};
my $lines = $self->{lines};
if (exists $indexes->{$key}) {
return $wantindex
? $indexes->{$key}
: [ split /[=|]/, $lines->[$indexes->{$key}] ];
}
my $pointer = \$self->{scanpointer};
for (; $$pointer < @$lines; $$pointer++) {
if ($lines->[$$pointer] =~ /^([^=]+)=/) {
$indexes->{$1} = $$pointer;
if ($1 eq $key) {
return $wantindex
? $indexes->{$key}
: [ split /[=|]/, $lines->[$indexes->{$key}] ];
}
}
}
return undef;
}
sub _next {
my ($self) = @_;
my $indexes = $self->{indexes};
my $lines = $self->{lines};
my $pointer = \$self->{keypointer};
for (; $$pointer < @$lines; $$pointer++) {
if ($lines->[$$pointer] =~ /^([^=]+)=/) {
$indexes->{$1} = $$pointer;
return $1;
}
}
return undef;
}
sub FETCH {
my ($self, $key) = @_;
if (my $found = $self->_scan($key)) {
return { DOWN => $found->[1], UP => $found->[2] };
}
return undef;
}
sub STORE {
my ($self, $key, $value) = @_;
print "$key, $value\n";
unless (ref($value) eq 'HASH'
and join($;, sort values %$value) eq "DOWN$;UP") {
croak 'Not unnaturally, many elevators imbued with ' .
'intelligence and precognition became terribly ' .
'frustrated with the mindless business of going ' .
'up and down, up and down, experimented briefly ' .
'with the notion of going sideways, as a sort of ' .
'existential protest, demanded participation in ' .
'the decision-making process and finally took to ' .
'squatting in basements sulking';
# -- Douglas Adams
}
my $index = $self->_scan($key, 'wantindex');
$index = @{ $self->{lines} } unless defined $index;
$self->{lines}->[$index] = "$key=$value->{DOWN}|$value->{UP}";
}
sub DELETE {
my ($self, $key) = @_;
my $index = $self->_scan($key, 'wantindex');
return undef unless defined $index;
my $lines = $self->{lines};
$self->{scanpointer}-- if $self->{scanpointer} > $index;
return splice @$lines, $index, 1;
}
sub CLEAR {
my ($self) = @_;
@{ $self->{lines} } = ();
$self->{scanpointer} = 0;
$self->{keypointer} = 0;
%{ $self->{indexes} } = ();
}
sub EXISTS {
my ($self, $key) = @_;
return defined $self->_scan($key, 'wantindex');
}
sub FIRSTKEY {
my ($self) = @_;
$self->{keypointer} = 0;
return $self->_next;
}
sub NEXTKEY {
my ($self) = @_;
return $self->_next;
}
sub UNTIE { }
sub DESTROY { }
'Why oh why did I actually code this?'
There is some endless loop in the key stuff, but I leave the debugging of FIRSTKEY, NEXTKEY and _next up to you. If you find the bug and can fix it, please do let me know. As long as you don't use keys or the hash itself, you'll be fine. Fetching and storing values seems to work.
use strict;
tie my %hash, 'Tie::NameThis', 'myupdowntimes.dat';
# Now, assign to or access $hash{machine}{UP} and $hash{machine}{DOWN}
Have fun!
- Yes, I reinvent wheels.
- Spam: Visit eurotraQ.
|