]>
Dogcows Code - chaz/p5-File-KDBX/blob - t/entry.t
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/disassociated from a KDBX database/, 'Dies if disassociated';
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
({
34 background_color
=> "",
37 custom_icon_uuid
=> undef,
38 foreground_color
=> "",
40 icon_id
=> "Password",
42 previous_parent_group
=> undef,
43 quality_check
=> bool
(1),
64 last_modification_time
=> isa
('Time::Piece'),
65 creation_time
=> isa
('Time::Piece'),
66 last_access_time
=> isa
('Time::Piece'),
67 expiry_time
=> isa
('Time::Piece'),
70 location_changed
=> isa
('Time::Piece'),
72 uuid
=> re
('^(?s:.){16}$'),
73 }), 'Entry data contains UserName string and the rest default attributes';
76 subtest
'Custom icons' => sub {
78 my $gif = pack('H*', '4749463839610100010000ff002c00000000010001000002003b');
80 my $entry = File
::KDBX
::Entry-
>new(my $kdbx = File
::KDBX-
>new, icon_id
=> 42);
81 is $entry->custom_icon_uuid, undef, 'UUID is undef if no custom icon is set';
82 is $entry->custom_icon, undef, 'Icon is undef if no custom icon is set';
83 is $entry->icon_id, 'KCMMemory', 'Default icon is set to something';
85 is $entry->custom_icon($gif), $gif, 'Setting a custom icon returns icon';
86 is $entry->custom_icon, $gif, 'Henceforth the icon is set';
87 is $entry->icon_id, 'Password', 'Default icon got changed to first icon';
88 my $uuid = $entry->custom_icon_uuid;
89 isnt
$uuid, undef, 'UUID is now set';
91 my $found = $entry->kdbx->custom_icon_data($uuid);
92 is $entry->custom_icon, $found, 'Custom icon on entry matches the database';
94 is $entry->custom_icon(undef), undef, 'Unsetting a custom icon returns undefined';
95 $found = $entry->kdbx->custom_icon_data($uuid);
96 is $found, $gif, 'Custom icon still exists in the database';
99 subtest
'History' => sub {
100 my $kdbx = File
::KDBX-
>new;
101 my $entry = $kdbx->add_entry(label
=> 'Foo');
102 is scalar @{$entry->history}, 0, 'New entry starts with no history';
103 is $entry->current_entry, $entry, 'Current new entry is itself';
104 ok
$entry->is_current, 'New entry is current';
106 my $txn = $entry->begin_work;
107 $entry->notes('Hello!');
109 is scalar @{$entry->history}, 1, 'Committing creates a historical entry';
110 ok
$entry->is_current, 'New entry is still current';
111 ok
$entry->history->[0]->is_historical, 'Historical entry is not current';
112 is $entry->notes, 'Hello!', 'New entry is modified after commit';
113 is $entry->history->[0]->notes, '', 'Historical entry is saved without modification';
116 subtest
'Update UUID' => sub {
117 my $kdbx = File
::KDBX-
>new;
119 my $entry1 = $kdbx->add_entry(label
=> 'Foo');
120 my $entry2 = $kdbx->add_entry(label
=> 'Bar');
122 $entry2->url(sprintf('{REF:T@I:%s} {REF:T@I:%s}', $entry1->id, lc($entry1->id)));
123 is $entry2->expanded_url, 'Foo Foo', 'Field reference expands'
124 or diag explain
$entry2->url;
126 $entry1->uuid("\1" x
16);
128 is $entry2->url, '{REF:T@I:01010101010101010101010101010101} {REF:T@I:01010101010101010101010101010101}',
129 'Replace field references when an entry UUID is changed';
130 is $entry2->expanded_url, 'Foo Foo', 'Field reference expands after UUID is changed'
131 or diag explain
$entry2->url;
This page took 0.049637 seconds and 4 git commands to generate.