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