14 subtest
'Construction' => sub {
15 my $entry = File
::KDBX
::Entry-
>new(my $data = {username
=> 'foo'});
16 is $entry, $data, 'Provided data structure becomes the object';
17 isa_ok
$data, 'File::KDBX::Entry', 'Data structure is blessed';
18 is $entry->{username
}, 'foo', 'username is in the object still';
19 is $entry->username, '', 'username is not the UserName string';
21 like exception
{ $entry->kdbx }, qr/disconnected/, 'Dies if disconnected';
22 $entry->kdbx(my $kdbx = File
::KDBX-
>new);
23 is $entry->kdbx, $kdbx, 'Set a database after instantiation';
25 is_deeply
$entry, {username
=> 'foo', strings
=> {UserName
=> {value
=> ''}}},
26 'Entry data contains what was provided to the constructor plus vivified username';
28 $entry = File
::KDBX
::Entry-
>new(username
=> 'bar');
29 is $entry->{username
}, undef, 'username is not set on the data';
30 is $entry->username, 'bar', 'username is set correctly as the UserName string';
32 cmp_deeply
$entry, noclass
({
35 data_transfer_obfuscation
=> 0,
36 default_sequence
=> "{USERNAME}{TAB}{PASSWORD}{ENTER}",
39 background_color
=> "",
42 custom_icon_uuid
=> undef,
43 foreground_color
=> "",
45 icon_id
=> "Password",
47 previous_parent_group
=> undef,
48 quality_check
=> bool
(1),
69 last_modification_time
=> isa
('Time::Piece'),
70 creation_time
=> isa
('Time::Piece'),
71 last_access_time
=> isa
('Time::Piece'),
72 expiry_time
=> isa
('Time::Piece'),
75 location_changed
=> isa
('Time::Piece'),
77 uuid
=> re
('^(?s:.){16}$'),
78 }), 'Entry data contains UserName string and the rest default attributes';
81 subtest
'Accessors' => sub {
82 my $entry = File
::KDBX
::Entry-
>new;
84 $entry->creation_time('2022-02-02 12:34:56');
85 cmp_ok
$entry->creation_time->epoch, '==', 1643805296, 'Creation time coerced into a Time::Piece (epoch)';
86 is $entry->creation_time->datetime, '2022-02-02T12:34:56', 'Creation time coerced into a Time::Piece';
88 $entry->username('foo');
89 cmp_deeply
$entry->strings->{UserName
}, {
91 }, 'Username setter works';
93 $entry->password('bar');
94 cmp_deeply
$entry->strings->{Password
}, {
97 }, 'Password setter works';
100 subtest
'Custom icons' => sub {
102 my $gif = pack('H*', '4749463839610100010000ff002c00000000010001000002003b');
104 my $entry = File
::KDBX
::Entry-
>new(my $kdbx = File
::KDBX-
>new, icon_id
=> 42);
105 is $entry->custom_icon_uuid, undef, 'UUID is undef if no custom icon is set';
106 is $entry->custom_icon, undef, 'Icon is undef if no custom icon is set';
107 is $entry->icon_id, 'KCMMemory', 'Default icon is set to something';
109 is $entry->custom_icon($gif), $gif, 'Setting a custom icon returns icon';
110 is $entry->custom_icon, $gif, 'Henceforth the icon is set';
111 is $entry->icon_id, 'Password', 'Default icon got changed to first icon';
112 my $uuid = $entry->custom_icon_uuid;
113 isnt
$uuid, undef, 'UUID is now set';
115 my $found = $entry->kdbx->custom_icon_data($uuid);
116 is $entry->custom_icon, $found, 'Custom icon on entry matches the database';
118 is $entry->custom_icon(undef), undef, 'Unsetting a custom icon returns undefined';
119 $found = $entry->kdbx->custom_icon_data($uuid);
120 is $found, $gif, 'Custom icon still exists in the database';
123 subtest
'History' => sub {
124 my $kdbx = File
::KDBX-
>new;
125 my $entry = $kdbx->add_entry(label
=> 'Foo');
126 is scalar @{$entry->history}, 0, 'New entry starts with no history';
127 is $entry->current_entry, $entry, 'Current new entry is itself';
128 ok
$entry->is_current, 'New entry is current';
130 my $txn = $entry->begin_work;
131 $entry->notes('Hello!');
133 is scalar @{$entry->history}, 1, 'Committing creates a historical entry';
134 ok
$entry->is_current, 'New entry is still current';
135 ok
$entry->history->[0]->is_historical, 'Historical entry is not current';
136 is $entry->notes, 'Hello!', 'New entry is modified after commit';
137 is $entry->history->[0]->notes, '', 'Historical entry is saved without modification';
140 subtest
'Update UUID' => sub {
141 my $kdbx = File
::KDBX-
>new;
143 my $entry1 = $kdbx->add_entry(label
=> 'Foo');
144 my $entry2 = $kdbx->add_entry(label
=> 'Bar');
146 $entry2->url(sprintf('{REF:T@I:%s} {REF:T@I:%s}', $entry1->id, lc($entry1->id)));
147 is $entry2->expand_url, 'Foo Foo', 'Field reference expands'
148 or diag explain
$entry2->url;
150 $entry1->uuid("\1" x
16);
152 is $entry2->url, '{REF:T@I:01010101010101010101010101010101} {REF:T@I:01010101010101010101010101010101}',
153 'Replace field references when an entry UUID is changed';
154 is $entry2->expand_url, 'Foo Foo', 'Field reference expands after UUID is changed'
155 or diag explain
$entry2->url;
158 subtest
'Auto-type' => sub {
159 my $kdbx = File
::KDBX-
>new;
161 my $entry = $kdbx->add_entry(title
=> 'Meh');
162 $entry->add_auto_type_association({
163 window
=> 'Boring Store',
164 keystroke_sequence
=> 'yeesh',
166 $entry->add_auto_type_association({
167 window
=> 'Friendly Bank',
168 keystroke_sequence
=> 'blah',
171 my $window_title = 'Friendly';
172 my $entries = $kdbx->entries(auto_type
=> 1)
174 my ($ata) = grep { $_->{window
} =~ /\Q$window_title\E/i } @{$_->auto_type_associations};
175 return [$_, $ata->{keystroke_sequence
} || $_->auto_type_default_sequence] if $ata;
177 cmp_ok
$entries->count, '==', 1, 'Find auto-type window association';
179 (undef, my $keys) = @{$entries->next};
180 is $keys, 'blah', 'Select the correct association';
183 subtest
'Memory protection' => sub {
184 my $kdbx = File
::KDBX-
>new;
186 is exception
{ $kdbx->lock }, undef, 'Can lock empty database';
187 $kdbx->unlock; # should be no-op since nothing was locked
189 my $entry = $kdbx->root->add_entry(
191 username
=> 'mreynolds',
192 password
=> 's3cr3t',
194 $entry->string(Custom
=> 'foo', protect
=> 1);
195 $entry->binary(Binary
=> 'bar', protect
=> 1);
196 $entry->binary(UnprotectedBinary
=> 'baz');
198 is exception
{ $kdbx->lock }, undef, 'Can lock new database';
199 is $entry->username, 'mreynolds', 'UserName does not get locked';
200 is $entry->password, undef, 'Password is lockable';
201 is $entry->string_value('Custom'), undef, 'Custom is lockable';
202 is $entry->binary_value('Binary'), undef, 'Binary is lockable';
203 is $entry->binary_value('UnprotectedBinary'), 'baz', 'Unprotected binary does not get locked';
206 is $entry->password, 's3cr3t', 'Password is unlockable';
207 is $entry->string_value('Custom'), 'foo', 'Custom is unlockable';
208 is $entry->binary_value('Binary'), 'bar', 'Binary is unlockable';