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';
89 subtest
'Custom icons' => sub {
91 my $gif = pack('H*', '4749463839610100010000ff002c00000000010001000002003b');
93 my $entry = File
::KDBX
::Entry-
>new(my $kdbx = File
::KDBX-
>new, icon_id
=> 42);
94 is $entry->custom_icon_uuid, undef, 'UUID is undef if no custom icon is set';
95 is $entry->custom_icon, undef, 'Icon is undef if no custom icon is set';
96 is $entry->icon_id, 'KCMMemory', 'Default icon is set to something';
98 is $entry->custom_icon($gif), $gif, 'Setting a custom icon returns icon';
99 is $entry->custom_icon, $gif, 'Henceforth the icon is set';
100 is $entry->icon_id, 'Password', 'Default icon got changed to first icon';
101 my $uuid = $entry->custom_icon_uuid;
102 isnt
$uuid, undef, 'UUID is now set';
104 my $found = $entry->kdbx->custom_icon_data($uuid);
105 is $entry->custom_icon, $found, 'Custom icon on entry matches the database';
107 is $entry->custom_icon(undef), undef, 'Unsetting a custom icon returns undefined';
108 $found = $entry->kdbx->custom_icon_data($uuid);
109 is $found, $gif, 'Custom icon still exists in the database';
112 subtest
'History' => sub {
113 my $kdbx = File
::KDBX-
>new;
114 my $entry = $kdbx->add_entry(label
=> 'Foo');
115 is scalar @{$entry->history}, 0, 'New entry starts with no history';
116 is $entry->current_entry, $entry, 'Current new entry is itself';
117 ok
$entry->is_current, 'New entry is current';
119 my $txn = $entry->begin_work;
120 $entry->notes('Hello!');
122 is scalar @{$entry->history}, 1, 'Committing creates a historical entry';
123 ok
$entry->is_current, 'New entry is still current';
124 ok
$entry->history->[0]->is_historical, 'Historical entry is not current';
125 is $entry->notes, 'Hello!', 'New entry is modified after commit';
126 is $entry->history->[0]->notes, '', 'Historical entry is saved without modification';
129 subtest
'Update UUID' => sub {
130 my $kdbx = File
::KDBX-
>new;
132 my $entry1 = $kdbx->add_entry(label
=> 'Foo');
133 my $entry2 = $kdbx->add_entry(label
=> 'Bar');
135 $entry2->url(sprintf('{REF:T@I:%s} {REF:T@I:%s}', $entry1->id, lc($entry1->id)));
136 is $entry2->expand_url, 'Foo Foo', 'Field reference expands'
137 or diag explain
$entry2->url;
139 $entry1->uuid("\1" x
16);
141 is $entry2->url, '{REF:T@I:01010101010101010101010101010101} {REF:T@I:01010101010101010101010101010101}',
142 'Replace field references when an entry UUID is changed';
143 is $entry2->expand_url, 'Foo Foo', 'Field reference expands after UUID is changed'
144 or diag explain
$entry2->url;
147 subtest
'Auto-type' => sub {
148 my $kdbx = File
::KDBX-
>new;
150 my $entry = $kdbx->add_entry(title
=> 'Meh');
151 $entry->add_auto_type_association({
152 window
=> 'Boring Store',
153 keystroke_sequence
=> 'yeesh',
155 $entry->add_auto_type_association({
156 window
=> 'Friendly Bank',
157 keystroke_sequence
=> 'blah',
160 my $window_title = 'Friendly';
161 my $entries = $kdbx->entries(auto_type
=> 1)
163 my ($ata) = grep { $_->{window
} =~ /\Q$window_title\E/i } @{$_->auto_type_associations};
164 return [$_, $ata->{keystroke_sequence
} || $_->auto_type_default_sequence] if $ata;
166 cmp_ok
$entries->count, '==', 1, 'Find auto-type window association';
168 (undef, my $keys) = @{$entries->next};
169 is $keys, 'blah', 'Select the correct association';