9 use File
::KDBX
::Util
qw(:all);
12 can_ok
('File::KDBX::Util', qw{
28 simple_expression_query
37 subtest
'Emptiness' => sub {
40 ok empty
(@empty), 'Empty array should be empty';
41 ok
!nonempty
(@empty), 'Empty array should be !nonempty';
42 ok
!empty
(@nonempty), 'Array should be !empty';
43 ok nonempty
(@nonempty), 'Array should be nonempty';
46 my %nonempty = (a
=> 'b');
47 ok empty
(%empty), 'Empty hash should be empty';
48 ok
!nonempty
(%empty), 'Empty hash should be !nonempty';
49 ok
!empty
(%nonempty), 'Hash should be !empty';
50 ok nonempty
(%nonempty), 'Hash should be nonempty';
56 my $nref1 = \
$nonempty;
60 [0, $empty, 'Empty string'],
62 [0, \
undef, 'Reference to undef'],
63 [0, {}, 'Empty hashref'],
64 [0, [], 'Empty arrayref'],
65 [0, $eref1, 'Reference to empty string'],
66 [0, $eref2, 'Reference to reference to empty string'],
67 [0, \\\\\\\'', 'Deep reference to empty string
'],
68 [1, $nonempty, 'String
'],
72 [1, {a => 'b
'}, 'Hashref
'],
74 [1, $nref1, 'Reference to string
'],
75 [1, $nref2, 'Reference to reference to string
'],
76 [1, \\\\\\\'z', 'Deep reference to string'],
78 my ($expected, $thing, $note) = @$test;
80 ok
!empty
($thing), "$note should be !empty";
81 ok nonempty
($thing), "$note should be nonempty";
84 ok empty
($thing), "$note should be empty";
85 ok
!nonempty
($thing), "$note should be !nonempty";
90 subtest
'UUIDs' => sub {
91 my $uuid = "\x01\x23\x45\x67\x89\xab\xcd\xef\x01\x23\x45\x67\x89\xab\xcd\xef";
92 my $uuid1 = uuid
('01234567-89AB-CDEF-0123-456789ABCDEF');
93 my $uuid2 = uuid
('0123456789ABCDEF0123456789ABCDEF');
94 my $uuid3 = uuid
('012-3-4-56-789AB-CDEF---012-34567-89ABC-DEF');
96 is $uuid1, $uuid, 'Formatted UUID is packed';
97 is $uuid2, $uuid, 'Formatted UUID does not need dashes';
98 is $uuid2, $uuid, 'Formatted UUID can have weird dashes';
100 is format_uuid
($uuid), '0123456789ABCDEF0123456789ABCDEF', 'UUID unpacks to hex string';
101 is format_uuid
($uuid, '-'), '01234567-89AB-CDEF-0123-456789ABCDEF', 'Formatted UUID can be delimited';
103 my %uuid_set = ($uuid => 'whatever');
105 my $new_uuid = generate_uuid
(\
%uuid_set);
106 isnt
$new_uuid, $uuid, 'Generated UUID is not in set';
108 $new_uuid = generate_uuid
(sub { !$uuid_set{$_} });
109 isnt
$new_uuid, $uuid, 'Generated UUID passes a test function';
111 like generate_uuid
(print => 1), qr/^[A-Za-z0-9]+$/, 'Printable UUID is printable (1)';
112 like generate_uuid
(printable
=> 1), qr/^[A-Za-z0-9]+$/, 'Printable UUID is printable (2)';
115 subtest
'Snakification' => sub {
116 is snakify
('FooBar'), 'foo_bar', 'Basic snakification';
117 is snakify
('MyUUIDSet'), 'my_uuid_set', 'Acronym snakification';
118 is snakify
('Numbers123'), 'numbers_123', 'Snake case with numbers';
119 is snakify
('456Baz'), '456_baz', 'Prefixed numbers';
122 subtest
'Padding' => sub {
125 is pad_pkcs7
('foo', 2), "foo\x01", 'Pad one byte to fill the second block';
126 is pad_pkcs7
('foo', 4), "foo\x01", 'Pad one byte to fill one block';
127 is pad_pkcs7
('foo', 8), "foo\x05\x05\x05\x05\x05", 'Pad to fill one block';
128 is pad_pkcs7
('moof', 4), "moof\x04\x04\x04\x04", 'Add a whole block of padding';
129 is pad_pkcs7
('', 3), "\x03\x03\x03", 'Pad an empty string';
130 like exception
{ pad_pkcs7
(undef, 8) }, qr/must provide a string/i, 'String must be defined';
131 like exception
{ pad_pkcs7
('bar') }, qr/must provide block size/i, 'Size must defined';
132 like exception
{ pad_pkcs7
('bar', 0) }, qr/must provide block size/i, 'Size must be non-zero';