view release on metacpan or  search on metacpan

lib/Data/StackedHash.pm  view on Meta::CPAN

package Data::StackedHash;
our $VERSION = '0.99';

#
# Copyright (C) 2003 Riccardo Murri, <riccardomurri@yahoo.it>. All
# rights reserved.

# This package is free software and is provided "as is" without express
# or implied warranty.  It may be used, redistributed and/or modified
# under the same terms as Perl itself.
#

=pod

=head1 NAME

Data::StackedHash - Stack of PERL Hashes

=head1 SYNOPSIS

  use Data::StackedHash;

  tie %h, Data::StackedHash;

  $h{'a'}=1;
  $h{'b'}=2;
  tied(%h)->push; # put a new hash on the stack
  $h{'a'}=3;      # override value of key 'a'
    ...
  tied(%h)->pop;  # remove top hash from the stack,
                  # $h{'a'} == 1 again


=head1 DESCRIPTION

The Data::StackedHash module implements a stack of hashes; the whole
stack acts collectively and transparently as a single PERL hash, that
is, you can perform the usual operations (fetching/storing values,
I<keys>, I<delete>, etc.)  on it.  All the PERL buitlins which operate
on hashes are supported.

Assigning a value to a key, as in C<< $h{'a'}=1 >>, puts the key/value
pair into the hash at the top of the stack. Reading a key off the
stack of hashes searches the whole stack, from the topmost hash to the
bottom one, until it finds a hash which holds some value associated to
the given key; returns C<< undef >> if no match was found.

The built-in functions I<keys>, I<values>, I<each> act on the whole
collection of all key/value defined in any hash of the stack.

You can add a hash on top of the stack by the method I<push>, and
remove the topmost hash by the method I<pop>.

Clearing a stack of hashes only clears the topmost one: that is,

    use Data::StackedHash;
    tie %h, Data::StackedHash, {'a'=>1};

    # put some hash on top of the stack
    tied(%h)->push({'a'=>2}); 

    print $h{'a'}; # prints 2

    %h = {}; # clear topmost hash

    print $h{'a'}; # prints 1

=cut

use 5.006;
use strict;
use warnings;

sub TIEHASH {
    my $proto = shift;
    my $initial = shift;
    my $class = ref($proto) || $proto;
    my $self = {};
    $self->{KEYS} = {};
    if ($initial) {
	$self->{STACK} = [$initial];
	my $key;
	foreach $key (keys %$initial) {
	    $self->{KEYS}->{$key}++;
	}
    } else {
	$self->{STACK} = [{}];
    }
    bless($self, $class);
    return $self;
};

sub STORE {
    my $self = shift;
    my $key = shift;
    my $value = shift;
    $self->{KEYS}->{$key}++ unless exists @{$self->{STACK}}[0]->{$key};