The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use strict;
use warnings;

use Test::More;

use Data::Hive;
use Data::Hive::Store::Param;
use Data::Hive::PathPacker::Flexible;

use Data::Hive::Test;

{
  package Infostore;
  sub new { bless {} => $_[0] }

  sub info {
    my ($self, $key, $val) = @_;
    return keys %$self if @_ == 1;
    $self->{$key} = $val if @_ > 2;
    return $self->{$key};
  }

  sub delete {
    my ($self, $key) = @_;
    return delete $self->{$key};
  }
}

Data::Hive::Test->test_new_hive(
  "basic Param backed hive",
  {
    store_class => 'Param',
    store_args  => [ Infostore->new, { method  => 'info' } ],
  },
);

my $infostore = Infostore->new;

my $hive = Data::Hive->NEW({
  store_class => 'Param',
  store_args  => [ $infostore, {
    method      => 'info',
    path_packer => Data::Hive::PathPacker::Flexible->new({ separator => '/' }),
  } ],
});

$infostore->info(foo       => 1);
$infostore->info('bar/baz' => 2);

is $hive->bar->baz->GET, 2, 'GET';
$hive->foo->SET(3);
is_deeply $infostore, { foo => 3, 'bar/baz' => 2 }, 'SET';

is $hive->bar->baz->NAME, 'bar/baz', 'NAME';

ok ! $hive->not->EXISTS, "non-existent key doesn't EXISTS";
ok   $hive->foo->EXISTS, "existing key does EXISTS";

$hive->HIVE("and/or")->SET(17);

is_deeply $infostore, { foo => 3, 'bar/baz' => 2, 'and%2for' => 17 },
  'SET (with escape)';

is $hive->HIVE("and/or")->GET, 17, 'GET (with escape)';

is $hive->bar->baz->DELETE, 2, "delete returns old value";
is_deeply $infostore, { foo => 3, 'and%2for' => 17 }, "delete removed item";

$hive->foo->bar->SET(4);
$hive->foo->bar->baz->SET(5);
$hive->foo->quux->baz->SET(6);

is_deeply(
  [ sort $hive->KEYS ],
  [ qw(and/or foo) ],
  "get the top level KEYS",
);

is_deeply(
  [ sort $hive->foo->KEYS ],
  [ qw(bar quux) ],
  "get the KEYS under foo",
);

is_deeply(
  [ sort $hive->foo->bar->KEYS ],
  [ qw(baz) ],
  "get the KEYS under foo/bar",
);

done_testing;