]> Dogcows Code - chaz/p5-File-KDBX/blob - t/database.t
94e1ea86966d035a14401cf9143f3a0825cbd453
[chaz/p5-File-KDBX] / 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 File::Temp qw(tempfile);
13 use Test::Deep;
14 use Test::More;
15 use Time::Piece;
16
17 subtest 'Create a new database' => sub {
18 my $kdbx = File::KDBX->new;
19
20 $kdbx->add_group(name => 'Meh');
21 ok $kdbx->_has_implicit_root, 'Database starts off with implicit root';
22
23 my $entry = $kdbx->add_entry({
24 username => 'hello',
25 password => {value => 'This is a secret!!!!!', protect => 1},
26 });
27
28 ok !$kdbx->_has_implicit_root, 'Adding an entry to the root group makes it explicit';
29
30 $entry->remove;
31 ok $kdbx->_has_implicit_root, 'Removing group makes the root group implicit again';
32 };
33
34 subtest 'Clone' => sub {
35 my $kdbx = File::KDBX->new;
36 $kdbx->add_group(name => 'Passwords')->add_entry(title => 'My Entry');
37
38 my $copy = $kdbx->clone;
39 cmp_deeply $copy, $kdbx, 'Clone keeps the same structure and data' or dumper $copy;
40
41 isnt $kdbx, $copy, 'Clone is a different object';
42 isnt $kdbx->root, $copy->root,
43 'Clone root group is a different object';
44 isnt $kdbx->root->groups->[0], $copy->root->groups->[0],
45 'Clone group is a different object';
46 isnt $kdbx->root->groups->[0]->entries->[0], $copy->root->groups->[0]->entries->[0],
47 'Clone entry is a different object';
48
49 my @objects = $copy->objects->each;
50 subtest 'Cloned objects refer to the cloned database' => sub {
51 plan tests => scalar @_;
52 for my $object (@objects) {
53 my $object_kdbx = eval { $object->kdbx };
54 is $object_kdbx, $copy, 'Object: ' . $object->label;
55 }
56 }, @objects;
57 };
58
59 subtest 'Iteration algorithm' => sub {
60 # Database
61 # - Root
62 # - Group1
63 # - EntryA
64 # - Group2
65 # - EntryB
66 # - Group3
67 # - EntryC
68 my $kdbx = File::KDBX->new;
69 my $group1 = $kdbx->add_group(label => 'Group1');
70 my $group2 = $group1->add_group(label => 'Group2');
71 my $group3 = $kdbx->add_group(label => 'Group3');
72 my $entry1 = $group1->add_entry(label => 'EntryA');
73 my $entry2 = $group2->add_entry(label => 'EntryB');
74 my $entry3 = $group3->add_entry(label => 'EntryC');
75
76 cmp_deeply $kdbx->groups->map(sub { $_->label })->to_array,
77 [qw(Root Group1 Group2 Group3)], 'Default group order';
78 cmp_deeply $kdbx->entries->map(sub { $_->label })->to_array,
79 [qw(EntryA EntryB EntryC)], 'Default entry order';
80 cmp_deeply $kdbx->objects->map(sub { $_->label })->to_array,
81 [qw(Root Group1 EntryA Group2 EntryB Group3 EntryC)], 'Default object order';
82
83 cmp_deeply $kdbx->groups(algorithm => 'ids')->map(sub { $_->label })->to_array,
84 [qw(Root Group1 Group2 Group3)], 'IDS group order';
85 cmp_deeply $kdbx->entries(algorithm => 'ids')->map(sub { $_->label })->to_array,
86 [qw(EntryA EntryB EntryC)], 'IDS entry order';
87 cmp_deeply $kdbx->objects(algorithm => 'ids')->map(sub { $_->label })->to_array,
88 [qw(Root Group1 EntryA Group2 EntryB Group3 EntryC)], 'IDS object order';
89
90 cmp_deeply $kdbx->groups(algorithm => 'dfs')->map(sub { $_->label })->to_array,
91 [qw(Group2 Group1 Group3 Root)], 'DFS group order';
92 cmp_deeply $kdbx->entries(algorithm => 'dfs')->map(sub { $_->label })->to_array,
93 [qw(EntryB EntryA EntryC)], 'DFS entry order';
94 cmp_deeply $kdbx->objects(algorithm => 'dfs')->map(sub { $_->label })->to_array,
95 [qw(Group2 EntryB Group1 EntryA Group3 EntryC Root)], 'DFS object order';
96
97 cmp_deeply $kdbx->groups(algorithm => 'bfs')->map(sub { $_->label })->to_array,
98 [qw(Root Group1 Group3 Group2)], 'BFS group order';
99 cmp_deeply $kdbx->entries(algorithm => 'bfs')->map(sub { $_->label })->to_array,
100 [qw(EntryA EntryC EntryB)], 'BFS entry order';
101 cmp_deeply $kdbx->objects(algorithm => 'bfs')->map(sub { $_->label })->to_array,
102 [qw(Root Group1 EntryA Group3 EntryC Group2 EntryB)], 'BFS object order';
103 };
104
105 subtest 'Recycle bin' => sub {
106 my $kdbx = File::KDBX->new;
107 my $entry = $kdbx->add_entry(label => 'Meh');
108
109 my $bin = $kdbx->groups->grep(name => 'Recycle Bin')->next;
110 ok !$bin, 'New database has no recycle bin';
111
112 is $kdbx->recycle_bin_enabled, 1, 'Recycle bin is enabled';
113 $kdbx->recycle_bin_enabled(0);
114
115 $entry->recycle_or_remove;
116 cmp_ok $entry->is_recycled, '==', 0, 'Entry is not recycle if recycle bin is disabled';
117
118 $bin = $kdbx->groups->grep(name => 'Recycle Bin')->next;
119 ok !$bin, 'Recycle bin not autovivified if recycle bin is disabled';
120 is $kdbx->entries->size, 0, 'Database is empty after removing entry';
121
122 $kdbx->recycle_bin_enabled(1);
123
124 $entry = $kdbx->add_entry(label => 'Another one');
125 $entry->recycle_or_remove;
126 cmp_ok $entry->is_recycled, '==', 1, 'Entry is recycled';
127
128 $bin = $kdbx->groups->grep(name => 'Recycle Bin')->next;
129 ok $bin, 'Recycle bin group autovivifies';
130 cmp_ok $bin->icon_id, '==', 43, 'Recycle bin has the trash icon';
131 cmp_ok $bin->enable_auto_type, '==', 0, 'Recycle bin has auto type disabled';
132 cmp_ok $bin->enable_searching, '==', 0, 'Recycle bin has searching disabled';
133
134 is $kdbx->entries->size, 1, 'Database is not empty';
135 is $kdbx->entries(searching => 1)->size, 0, 'Database has no entries if searching';
136 cmp_ok $bin->all_entries->size, '==', 1, 'Recycle bin has an entry';
137
138 $entry->recycle_or_remove;
139 is $kdbx->entries->size, 0, 'Remove entry if it is already in the recycle bin';
140 };
141
142 subtest 'Maintenance' => sub {
143 my $kdbx = File::KDBX->new;
144 $kdbx->add_group;
145 $kdbx->add_group->add_group;
146 my $entry = $kdbx->add_group->add_entry;
147
148 cmp_ok $kdbx->remove_empty_groups, '==', 3, 'Remove two empty groups';
149 cmp_ok $kdbx->groups->count, '==', 2, 'Two groups remain';
150
151 $entry->begin_work;
152 $entry->commit;
153 cmp_ok $kdbx->prune_history(max_age => 5), '==', 0, 'Do not remove new historical entries';
154
155 $entry->begin_work;
156 $entry->commit;
157 $entry->history->[0]->last_modification_time(scalar gmtime - 86400 * 10);
158 cmp_ok $kdbx->prune_history(max_age => 5), '==', 1, 'Remove a historical entry';
159 cmp_ok scalar @{$entry->history}, '==', 1, 'One historical entry remains';
160
161 cmp_ok $kdbx->remove_unused_icons, '==', 0, 'No icons to remove';
162 $kdbx->add_custom_icon('fake image 1');
163 $kdbx->add_custom_icon('fake image 2');
164 $entry->custom_icon('fake image 3');
165 cmp_ok $kdbx->remove_unused_icons, '==', 2, 'Remove unused icons';
166 cmp_ok scalar @{$kdbx->custom_icons}, '==', 1, 'Only one icon remains';
167
168 my $icon_uuid = $kdbx->add_custom_icon('fake image');
169 $entry->custom_icon('fake image');
170 cmp_ok $kdbx->remove_duplicate_icons, '==', 1, 'Remove duplicate icons';
171 is $entry->custom_icon_uuid, $icon_uuid, 'Uses of removed icon change';
172 };
173
174 subtest 'Dumping to filesystem' => sub {
175 my $kdbx = File::KDBX->new;
176 $kdbx->add_entry(title => 'Foo', password => 'whatever');
177
178 my ($fh, $filepath) = tempfile('kdbx-XXXXXX', TMPDIR => 1, UNLINK => 1);
179 close($fh);
180
181 $kdbx->dump($filepath, 'a');
182
183 my $kdbx2 = File::KDBX->load($filepath, 'a');
184 my $entry = $kdbx2->entries->map(sub { $_->title.'/'.$_->expand_password })->next;
185 is $entry, 'Foo/whatever', 'Dump and load an entry';
186
187 $kdbx->dump($filepath, key => 'a', atomic => 0);
188
189 $kdbx2 = File::KDBX->load($filepath, 'a');
190 $entry = $kdbx2->entries->map(sub { $_->title.'/'.$_->expand_password })->next;
191 is $entry, 'Foo/whatever', 'Dump and load an entry (non-atomic)';
192 };
193
194 done_testing;
This page took 0.058418 seconds and 3 git commands to generate.