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 subtest 'Recycle bin' => sub {
  58     my $kdbx = File::KDBX->new;
  59     my $entry = $kdbx->add_entry(label => 'Meh');
  60
  61     my $bin = $kdbx->groups->grep(name => 'Recycle Bin')->next;
  62     ok !$bin, 'New database has no recycle bin';
  63
  64     is $kdbx->recycle_bin_enabled, 1, 'Recycle bin is enabled';
  65     $kdbx->recycle_bin_enabled(0);
  66
  67     $entry->recycle_or_remove;
  68     cmp_ok $entry->is_recycled, '==', 0, 'Entry is not recycle if recycle bin is disabled';
  69
  70     $bin = $kdbx->groups->grep(name => 'Recycle Bin')->next;
  71     ok !$bin, 'Recycle bin not autovivified if recycle bin is disabled';
  72     is $kdbx->entries->size, 0, 'Database is empty after removing entry';
  73
  74     $kdbx->recycle_bin_enabled(1);
  75
  76     $entry = $kdbx->add_entry(label => 'Another one');
  77     $entry->recycle_or_remove;
  78     cmp_ok $entry->is_recycled, '==', 1, 'Entry is recycled';
  79
  80     $bin = $kdbx->groups->grep(name => 'Recycle Bin')->next;
  81     ok $bin, 'Recycle bin group autovivifies';
  82     cmp_ok $bin->icon_id, '==', 43, 'Recycle bin has the trash icon';
  83     cmp_ok $bin->enable_auto_type, '==', 0, 'Recycle bin has auto type disabled';
  84     cmp_ok $bin->enable_searching, '==', 0, 'Recycle bin has searching disabled';
  85
  86     is $kdbx->entries->size, 1, 'Database is not empty';
  87     is $kdbx->entries(searching => 1)->size, 0, 'Database has no entries if searching';
  88     cmp_ok $bin->entries_deeply->size, '==', 1, 'Recycle bin has an entry';
  89
  90     $entry->recycle_or_remove;
  91     is $kdbx->entries->size, 0, 'Remove entry if it is already in the recycle bin';
  92 };
  93
  94 done_testing;