File Coverage

blib/lib/Data/StackedHash.pm

Criterion	Covered	Total	%
statement	91	107	85.0
branch	16	20	80.0
condition	3	5	60.0
subroutine	15	17	88.2
pod	6	6	100.0
total	131	155	84.5

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

#
# Copyright (C) 2003 Riccardo Murri, . 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, I, 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, I, I 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, and
remove the topmost hash by the method I.

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};
    @{$self->{STACK}}[0]->{$key} = $value;
};

sub CLEAR {
    my $self = shift;
    @{$self->{STACK}}[0] = {};
    # rebuild the KEYS hash...
    %{$self->{KEYS}} = ();
    my $hash;
    my $key;
    foreach $hash (@{$self->{STACK}}) {
	foreach $key (keys %{$hash}) {
	    $self->{KEYS}->{$key} = 1;
	};
    };
};

=pod

=head2 METHODS

=head3 push()

The I method puts a new hash on top of the stack: you can
either pass to it a reference to the hash to put on top, or call
I with no arguments, in which case an empty hash is pushed
onto the stack.

    use Data::StackedHash;
    tie %h, Data::StackedHash;

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

    # put an empty hash on top of the stack
    tied(%h)->push;

=cut

sub push {
    my $self = shift;
    unshift @{$self->{STACK}}, $_[0] || {};
    if ($_[0]) {
	my $key;
	foreach $key (keys %{$_[0]}) {
	    $self->{KEYS}->{$key}++;
	};
    };
};

=pod

=head3 pop()

The I method removes the hash on top of the stack and returns a
reference to it; all key/value pairs defined only in that hash are
lost.

=cut

sub pop {
    my $self = shift;
    my $hash = shift @{$self->{STACK}};
    my $key;
    foreach $key (keys %$hash) {
	$self->{KEYS}->{$key}--;
    }
    return $hash;
};

=pod

=head3 delete(), delete_all()

A call to the built-in I will remove only the first-found key,
and return the associated value, or C<< undef >> if no such key was
found.

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

    # put one more hash on top of the stack
    tied(%h)->push();
    $h{'a'}=2;
    print "$h{a}\n"; # 2

    # delete the topmost occurrence of the 'a' key
    delete $h{'a'};
    print "$h{a}\n"; # 1

The I method deletes the specified key from all hashes in
the stack; it returns the array of values found in the stack, or the
empty array if no value was associated with the given key.  Values
from the topmost stack are first in the returned array.

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

    # put one more hash on top of the stack
    tied(%h)->push();
    $h{'a'}=2;
    print "$h{a}\n"; # 2

    # delete all occurrences of the 'a' key
    tied(%h)->delete_all('a');
    print "$h{a}\n"; # undef

=cut

sub DELETE {
    my $self = shift;
    my $key = shift;

    return undef unless exists $self->{KEYS}->{$key};

    $self->{KEYS}->{$key}--;
    delete $self->{KEYS}->{$key} if $self->{KEYS}->{$key} == 0;
    my $hash;
    foreach $hash (@{$self->{STACK}}) {
	next unless exists $hash->{$key};
	# From perltie(3): ``If you want to emulate the
	#       normal behavior of delete(), you should return what-
	#       ever FETCH would have returned for this key.''
	return delete $hash->{$key};
    }
    return undef;
};

sub delete_all {
    my $self = shift;
    my $key = shift;
    my $hash;
    my @value = ();
    foreach $hash (@{$self->{STACK}}) {
	CORE::push @value, $hash->{$key} if exists $hash->{$key};
	  delete $hash->{$key};
      }
    delete $self->{KEYS}->{$key};
    # From perltie(3): ``If you want to emulate the
    #       normal behavior of delete(), you should return what-
    #       ever FETCH would have returned for this key.''
    return @value;
};

=pod

=head3 fetch_all(key)

Returns all values associated with the given key; values from topmost
hash are first in the returned array.

=cut

sub FETCH {
    my $self = shift;
    my $key = shift;
    my $hash;
    foreach $hash (@{$self->{STACK}}) {
	return $hash->{$key} if exists $hash->{$key};
    };
    # PERL hashes return the "undefined empty string" if
    # one requests a non-existing key...
    return undef;
};

sub fetch_all {
    my $self = shift;
    my $key = shift;
    my $hash;
    my @values;
    foreach $hash (@{$self->{STACK}}) {
	CORE::push @values, $hash->{$key} if exists $hash->{$key};
      };
    return @values;
};

=pod

=head3 keys(), values(), each()

The built-in functions I, I and I operate on the
union of all key/value pairs defined in any hash of the stack.

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

    # put one more hash on top of the stack
    tied(%h)->push();
    $h{'b'}=2;

    # print all defined keys
    print keys %h; # ab

=cut

sub EXISTS {
    my $self = shift;
    my $key = shift;
    return exists ($self->{KEYS}->{$key}) ? 1 : 0;
};

sub FIRSTKEY {
    my $self = shift;
    # reset the 'each' internal iterator
    keys %{$self->{KEYS}};
    return each %{$self->{KEYS}};
};

sub NEXTKEY {
	my $self = shift;
	return each %{$self->{KEYS}};
}

=pod

=head3 height()

The I method returns the current height of the stack of hashes.

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

    # put one more hash on top of the stack
    tied(%h)->push();

    print tied(%h)->height; # prints 2

=cut

sub height {
	my $self = shift;
	return $#{$self->{STACK}};
}

=pod

=head3 count(key)

Given a key, the I method returns the number of hashes in which
that key is associated to a value.

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

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

    print tied(%h)->count('a'); # prints 1

=cut

sub count {
	my $self = shift;
	my $key = shift;
	return $self->{KEYS}->{$key};
}

1; # so the require or use succeeds

__END__