File Coverage

blib/lib/Data/Hive/Store/Hash.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	6	8	75.0
condition	1	3	33.3
subroutine	12	12	100.0
pod	9	9	100.0
total	65	69	94.2

use strict;
use warnings;
package Data::Hive::Store::Hash 1.015;
# ABSTRACT: store a hive in a flat hashref

use parent 'Data::Hive::Store';

#pod =head1 DESCRIPTION
#pod
#pod This is a simple store, primarily for testing, that will store hives in a flat
#pod hashref.  Paths are packed into strings and used as keys.  The structure does
#pod not recurse -- for that, see L.
#pod
#pod So, we could do this:
#pod
#pod   my $href = {};
#pod
#pod   my $hive = Data::Hive->NEW({
#pod     store_class => 'Hash',
#pod     store_args  => [ $href ],
#pod   });
#pod
#pod   $hive->foo->SET(1);
#pod   $hive->foo->bar->baz->SET(2);
#pod
#pod We would end up with C<$href> containing something like:
#pod
#pod   {
#pod     foo => 1,
#pod     'foo.bar.baz' => 2
#pod   }
#pod
#pod =method new
#pod
#pod   my $store = Data::Hive::Store::Hash->new(\%hash, \%arg);
#pod
#pod The only argument expected for C is a hashref, which is the hashref in
#pod which hive entries are stored.
#pod
#pod If no hashref is provided, a new, empty hashref will be used.
#pod
#pod The extra arguments may include:
#pod
#pod =for :list
#pod = path_packer
#pod A L-like object used to convert between paths
#pod (arrayrefs) and hash keys.
#pod
#pod =cut

sub new {
  my ($class, $href, $arg) = @_;
  $href = {} unless $href;
  $arg  = {} unless $arg;

  my $guts = {
    store       => $href,
    path_packer => $arg->{path_packer} || do {
      require Data::Hive::PathPacker::Strict;
      Data::Hive::PathPacker::Strict->new;
    },
  };

  return bless $guts => $class;
}

#pod =method hash_store
#pod
#pod This method returns the hashref in which things are being used.  You should not
#pod alter its contents!
#pod
#pod =cut

sub hash_store  { $_[0]->{store} }
sub path_packer { $_[0]->{path_packer} }

sub get {
  my ($self, $path) = @_;
  return $self->hash_store->{ $self->name($path) };
}

sub set {
  my ($self, $path, $value) = @_;
  $self->hash_store->{ $self->name($path) } = $value;
}

sub name {
  my ($self, $path) = @_;
  $self->path_packer->pack_path($path);
}

sub exists {
  my ($self, $path) = @_;
  exists $self->hash_store->{ $self->name($path) };
}

sub delete {
  my ($self, $path) = @_;

  delete $self->hash_store->{ $self->name($path) };
}

sub keys {
  my ($self, $path) = @_;

  my @names  = keys %{ $self->hash_store };

  my %is_key;

  PATH: for my $name (@names) {
    my $this_path = $self->path_packer->unpack_path($name);

    next unless @$this_path > @$path;

    for my $i (0 .. $#$path) {
      next PATH unless $this_path->[$i] eq $path->[$i];
    }

    $is_key{ $this_path->[ $#$path + 1 ] } = 1;
  }

  return keys %is_key;
}

1;

__END__