perlknight has asked for the wisdom of the Perl Monks concerning the following question:

All, this is my first attempt in using tiehash. I have a file which look like "hostname=time_system_down|time_system_up" and I want to use tiehash on it. I am able to fetch the value but not store it. Here's the code: 
package Triger;
use strict;
use Carp;

# Create tie hash
sub TIEHASH {
        my $self = shift;
        my $path = shift;
        my $mode = shift || 'r';

        if(@_) {
                croak("Usage: tie(\%hash, \$file, [mode])");
        my($line, $id, $status, $time_down, $time_up);
        foreach $line (@lines) {
                ($id,$status) = split(/=/,$line);
                ($time_down,$time_up) = split(/\|/,$status);
                $node->{CURRENT}{$id}{DOWN} = $time_down;
                $node->{CURRENT}{$id}{UP} = $time_up;
        }
        return bless $node => $self;
}

sub FETCH {
        my $self = shift;
        my ($id) = shift;
        if ( exists $self->{CURRENT}{$id} ) {
                return $self->{CURRENT}{$id};
        } else {
                return "$id doesn't exist";
        }
}

sub STORE {
        my $self = shift;
        my ($id) = shift;
        my($TFile) = $self->{PATH};
        my $time_down;
        my $time_up;
        my($return) = 0;
        my(@cache);
        unless($self->{CLOBBER}) {
                carp ("No write access for $self->{PATH}");
                return;
        }

        # open File
        if(!open(FH, "<TFile")) {
                carp("Cannot open $TFile: $!");
                return;
        }
        flock($TFile,2);
        if(!exists $self->{CURRENT}{$id}) {
                while(<FH>) {
                        if( /^$id\=/ ) {
                                push (@cache, "$id=$time_down|$time_up
+\n");
                                $return = 1
                        } else {
                                push (@cache, $_);
                        }
                }
        }
        close(FH);

        if($return) {
                # Writing to File
                if (!open(FH,">$TFile")) {
                        carp("Cannot open $TFile: $!");
                        return;
                }
                flock(FH, 2);
                while (@cache) {
                print FH shift (@cache);
                }
        } else {
                if(!open(FH,">>$TFile")) {
                        carp("Cannot open $TFile: $!");
                        return;
                }
                flock(FH,2);
                print FH "$id=$time_down|$time_up\n";

        }
        close(FH);
}

[download]
I am having problem with hash of hash; it's two level deep. How do I handle storing the value of "self->{CURRENT}{$id}{DOWN} or self->{CURRENT}{$id}{UP}"? Thanks for your help.

Edit kudra, 2002-04-16 Added readmore

Replies are listed 'Best First'.
Re: Having problem with tiehash
by Juerd (Abbot) on Apr 15, 2002 at 22:14 UTC

    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?'

    [download]
    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}

    [download]


    Have fun! 

    - Yes, I reinvent wheels.
- Spam: Visit eurotraQ.

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom