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 Data::Hive;
use Data::Hive::Store::Hash::Nested;

use Data::Hive::Test;

use Test::More 0.88;

Data::Hive::Test->test_new_hive(
  'basic hash store',
  { store => Data::Hive::Store::Hash::Nested->new },
);

for my $class (qw(
  Hash::Nested
  +Data::Hive::Store::Hash::Nested
  =Data::Hive::Store::Hash::Nested
)) {
  my $hive = Data::Hive->NEW({ store_class => $class });

  isa_ok($hive->STORE, 'Data::Hive::Store::Hash::Nested', "store from $class");
}

my $hive = Data::Hive->NEW({
  store_class => 'Hash::Nested',
});

my $tmp;

isa_ok($hive,      'Data::Hive', 'top-level hive');

isa_ok($hive->foo, 'Data::Hive', '"foo" subhive');

$hive->foo->SET(1);

is_deeply(
  $hive->STORE->hash_store,
  { foo => { '' => 1 } },
  'changes made to store',
);

$hive->bar->baz->GET;

is_deeply(
  $hive->STORE->hash_store,
  { foo => { '' => 1 } },
  'did not autovivify'
);

$hive->baz->quux->SET(2);

is_deeply(
  $hive->STORE->hash_store,
  {
    foo => { '' => 1 },
    baz => { quux => { '' => 2 } },
  },
  'deep set',
);

is(
  $hive->foo->GET,
  1,
  "get the 1 from ->foo",
);

is(
  $hive->foo->bar->GET,
  undef,
  "find nothing at ->foo->bar",
);

$hive->foo->bar->SET(3);

is(
  $hive->foo->bar->GET,
  3,
  "wrote and retrieved 3 from ->foo->bar",
);

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

$hive->baz->quux->frotz->SET(4);

is_deeply(
  $hive->STORE->hash_store,
  {
    foo => { '' => 1, bar => { '' => 3 } },
    baz => { quux => { '' => 2, frotz => { '' => 4 } } },
  },
  "deep delete"
);

my $quux = $hive->baz->quux;
is($quux->GET, 2, "get from saved leaf");
is($quux->DELETE, 2, "delete returned old value");
is($quux->GET, undef, "after deletion, hive has no value");

is_deeply(
  $hive->STORE->hash_store,
  {
    foo => { '' => 1, bar => { '' => 3 } },
    baz => { quux => { frotz => { '' => 4 } } },
  },
  "deep delete"
);

my $frotz = $hive->baz->quux->frotz;
is($frotz->GET, 4, "get from saved leaf");
is($frotz->DELETE, 4, "delete returned old value");
is($frotz->GET, undef, "after deletion, hive has no value");

is_deeply(
  $hive->STORE->hash_store,
  {
    foo => { '' => 1, bar => { '' => 3 } },
  },
  "deep delete: after a hive had no keys, it is deleted, too"
);

{
  my $hive  = Data::Hive->NEW({
    store_class => 'Hash::Nested',
  });

  $hive->HIVE('and/or')->SET(1);
  $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",
  );
}

subtest 'start with existing old-style hash' => sub {
  my $hive  = Data::Hive->NEW({
    store_class => 'Hash::Nested',
    store_args  => [ {
      to_get    => { bar => 10 },
      to_exists => { bar => 10 },
      to_delete => { bar => { baz => 10, quux => 20 } },
      to_skip   => { bar => { baz => 10, quux => 20 } },
      to_keys   => { bar => { baz => 10, quux => 20 } },
    } ],
  });

  is($hive->to_get->bar->GET, 10, 'we can GET from old-style hash stores');

  is_deeply(
    $hive->STORE->hash_store->{to_get},
    { bar => { '' => 10 } },
    "...and we auto-upgrade them in place",
  );

  ok($hive->to_exists->bar->EXISTS, 'we can EXISTS old-style hash stores');

  is_deeply(
    $hive->STORE->hash_store->{to_exists},
    { bar => { '' => 10 } },
    "...and we auto-upgrade them in place",
  );

  is(
    $hive->to_delete->bar->baz->DELETE,
    10,
    'we can DELETE from old-style hash stores'
  );

  ok(
    ! $hive->to_delete->bar->baz->EXISTS,
    '...and the DELETE is effective',
  );

  is_deeply(
    $hive->STORE->hash_store->{to_delete},
    { bar => { quux => 20 } },
    "...and we auto-upgrade them in place",
  );

  is(
    $hive->to_skip->bar->baz->missing->whatever->DELETE,
    undef,
    "we can (fake) delete from a element past old-style non-ref",
  );

  is_deeply(
    $hive->STORE->hash_store->{to_skip}{bar}{baz},
    { '' => 10 },
    "...and we auto-upgrade them in place",
  );

  is_deeply(
    [ sort $hive->to_keys->bar->KEYS ],
    [ qw(baz quux) ],
    "we can get KEYS where the keys hold old-style scalar",
  );

  is_deeply(
    [ sort $hive->to_keys->bar->baz->KEYS ],
    [ ],
    "we can get KEYS (empty) of a non-ref leaf",
  );

  is_deeply(
    $hive->STORE->hash_store->{to_keys}{bar}{baz},
    { '' => 10 },
    "...and we auto-upgrade them in place",
  );
};

done_testing;