Dogcows Code - chaz/p5-File-KDBX/blob - t/database.t

   1 #!/usr/bin/env perl
   2
   3 use utf8;
   4 use warnings;
   5 use strict;
   6
   7 use FindBin qw($Bin);
   8 use lib "$Bin/lib";
   9 use TestCommon;
  10
  11 use File::KDBX;
  12 use Test::Deep;
  13 use Test::More;
  14
  15 subtest 'Create a new database' => sub {
  16     my $kdbx = File::KDBX->new;
  17
  18     $kdbx->add_group(name => 'Meh');
  19     ok $kdbx->_has_implicit_root, 'Database starts off with implicit root';
  20
  21     my $entry = $kdbx->add_entry({
  22         username    => 'hello',
  23         password    => {value => 'This is a secret!!!!!', protect => 1},
  24     });
  25
  26     ok !$kdbx->_has_implicit_root, 'Adding an entry to the root group makes it explicit';
  27
  28     $entry->remove;
  29     ok $kdbx->_has_implicit_root, 'Removing group makes the root group implicit again';
  30 };
  31
  32 subtest 'Clone' => sub {
  33     my $kdbx = File::KDBX->new;
  34     $kdbx->add_group(name => 'Passwords')->add_entry(title => 'My Entry');
  35
  36     my $copy = $kdbx->clone;
  37     cmp_deeply $copy, $kdbx, 'Clone keeps the same structure and data' or dumper $copy;
  38
  39     isnt $kdbx, $copy, 'Clone is a different object';
  40     isnt $kdbx->root, $copy->root,
  41         'Clone root group is a different object';
  42     isnt $kdbx->root->groups->[0], $copy->root->groups->[0],
  43         'Clone group is a different object';
  44     isnt $kdbx->root->groups->[0]->entries->[0], $copy->root->groups->[0]->entries->[0],
  45         'Clone entry is a different object';
  46
  47     my @objects = $copy->objects->each;
  48     subtest 'Cloned objects refer to the cloned database' => sub {
  49         plan tests => scalar @_;
  50         for my $object (@objects) {
  51             my $object_kdbx = eval { $object->kdbx };
  52             is $object_kdbx, $copy, 'Object: ' . $object->label;
  53         }
  54     }, @objects;
  55 };
  56
  57 done_testing;