]> Dogcows Code - chaz/p5-File-KDBX/blob - t/entry.t
Fix extends to die on failure
[chaz/p5-File-KDBX] / t / entry.t
1 #!/usr/bin/env perl
2
3 use warnings;
4 use strict;
5
6 use lib 't/lib';
7 use TestCommon;
8
9 use File::KDBX::Entry;
10 use File::KDBX;
11 use Test::Deep;
12 use Test::More;
13
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';
20
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';
24
25 is_deeply $entry, {username => 'foo', strings => {UserName => {value => ''}}},
26 'Entry data contains what was provided to the constructor plus vivified username';
27
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';
31
32 cmp_deeply $entry, noclass({
33 auto_type => {},
34 background_color => "",
35 binaries => {},
36 custom_data => {},
37 custom_icon_uuid => undef,
38 foreground_color => "",
39 history => [],
40 icon_id => "Password",
41 override_url => "",
42 previous_parent_group => undef,
43 quality_check => bool(1),
44 strings => {
45 Notes => {
46 value => "",
47 },
48 Password => {
49 protect => bool(1),
50 value => "",
51 },
52 Title => {
53 value => "",
54 },
55 URL => {
56 value => "",
57 },
58 UserName => {
59 value => "bar",
60 },
61 },
62 tags => "",
63 times => {
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'),
68 expires => bool(0),
69 usage_count => 0,
70 location_changed => isa('Time::Piece'),
71 },
72 uuid => re('^(?s:.){16}$'),
73 }), 'Entry data contains UserName string and the rest default attributes';
74 };
75
76 subtest 'Accessors' => sub {
77 my $entry = File::KDBX::Entry->new;
78
79 $entry->creation_time('2022-02-02 12:34:56');
80 cmp_ok $entry->creation_time, '==', 1643805296, 'Creation time coerced into a Time::Piece (epoch)';
81 is $entry->creation_time->datetime, '2022-02-02T12:34:56', 'Creation time coerced into a Time::Piece';
82 };
83
84 subtest 'Custom icons' => sub {
85 plan tests => 10;
86 my $gif = pack('H*', '4749463839610100010000ff002c00000000010001000002003b');
87
88 my $entry = File::KDBX::Entry->new(my $kdbx = File::KDBX->new, icon_id => 42);
89 is $entry->custom_icon_uuid, undef, 'UUID is undef if no custom icon is set';
90 is $entry->custom_icon, undef, 'Icon is undef if no custom icon is set';
91 is $entry->icon_id, 'KCMMemory', 'Default icon is set to something';
92
93 is $entry->custom_icon($gif), $gif, 'Setting a custom icon returns icon';
94 is $entry->custom_icon, $gif, 'Henceforth the icon is set';
95 is $entry->icon_id, 'Password', 'Default icon got changed to first icon';
96 my $uuid = $entry->custom_icon_uuid;
97 isnt $uuid, undef, 'UUID is now set';
98
99 my $found = $entry->kdbx->custom_icon_data($uuid);
100 is $entry->custom_icon, $found, 'Custom icon on entry matches the database';
101
102 is $entry->custom_icon(undef), undef, 'Unsetting a custom icon returns undefined';
103 $found = $entry->kdbx->custom_icon_data($uuid);
104 is $found, $gif, 'Custom icon still exists in the database';
105 };
106
107 subtest 'History' => sub {
108 my $kdbx = File::KDBX->new;
109 my $entry = $kdbx->add_entry(label => 'Foo');
110 is scalar @{$entry->history}, 0, 'New entry starts with no history';
111 is $entry->current_entry, $entry, 'Current new entry is itself';
112 ok $entry->is_current, 'New entry is current';
113
114 my $txn = $entry->begin_work;
115 $entry->notes('Hello!');
116 $txn->commit;
117 is scalar @{$entry->history}, 1, 'Committing creates a historical entry';
118 ok $entry->is_current, 'New entry is still current';
119 ok $entry->history->[0]->is_historical, 'Historical entry is not current';
120 is $entry->notes, 'Hello!', 'New entry is modified after commit';
121 is $entry->history->[0]->notes, '', 'Historical entry is saved without modification';
122 };
123
124 subtest 'Update UUID' => sub {
125 my $kdbx = File::KDBX->new;
126
127 my $entry1 = $kdbx->add_entry(label => 'Foo');
128 my $entry2 = $kdbx->add_entry(label => 'Bar');
129
130 $entry2->url(sprintf('{REF:T@I:%s} {REF:T@I:%s}', $entry1->id, lc($entry1->id)));
131 is $entry2->expanded_url, 'Foo Foo', 'Field reference expands'
132 or diag explain $entry2->url;
133
134 $entry1->uuid("\1" x 16);
135
136 is $entry2->url, '{REF:T@I:01010101010101010101010101010101} {REF:T@I:01010101010101010101010101010101}',
137 'Replace field references when an entry UUID is changed';
138 is $entry2->expanded_url, 'Foo Foo', 'Field reference expands after UUID is changed'
139 or diag explain $entry2->url;
140 };
141
142 done_testing;
This page took 0.051227 seconds and 4 git commands to generate.