]>
Dogcows Code - chaz/p5-File-KDBX/blob - t/placeholders.t
13 my $kdbx = File
::KDBX-
>new;
15 my $entry1 = $kdbx->add_entry(
17 username
=> 'User {TITLE}',
19 my $entry2 = $kdbx->add_entry(
21 username
=> sprintf('{REF:U@I:%s}', $entry1->id),
22 notes
=> 'notes {URL}',
25 my $entry3 = $kdbx->add_entry(
26 username
=> sprintf('{REF:U@I:%s}', $entry2->id),
27 password
=> 'lyric:%LYRIC%',
28 notes
=> '%MISSING% %% %NOT AVAR% %LYRIC%',
31 is $entry1->expand_username, 'User Foo', 'Basic placeholder expansion';
32 is $entry2->expand_username, 'User Foo', 'Reference to another entry';
33 is $entry3->expand_username, 'User Foo', 'Reference to another entry through another';
35 my $recursive_expected = 'url notes ' x
10 . 'url {NOTES}';
37 my $warning = warning
{ $recursive = $entry2->expand_url };
38 like
$warning, qr/detected deep recursion/i, 'Deep recursion causes a warning'
39 or diag
'Warnings: ', explain
$warning;
40 is $recursive, $recursive_expected, 'Recursive placeholders resolve to... something';
43 my $entry = File
::KDBX
::Entry-
>new(url
=> 'http://example.com?{EXPLODE}');
44 is $entry->expand_url, 'http://example.com?{EXPLODE}',
45 'Unhandled placeholders are not replaced';
47 local $File::KDBX
::PLACEHOLDERS
{EXPLODE
} = sub { 'boom' };
48 is $entry->expand_url, 'http://example.com?boom', 'Custom placeholders can be set';
50 $entry->url('{eXplOde}!!');
51 is $entry->expand_url, 'boom!!', 'Placeholder tags are match case-insensitively';
55 local $ENV{LYRIC
} = 'I am the very model of a modern Major-General';
56 is $entry3->expand_password, "lyric:$ENV{LYRIC}", 'Environment variable placeholders';
57 is $entry3->expand_notes, qq{%MISSING% %% %NOT AVAR% $ENV{LYRIC}},
58 'Do not replace things that look like environment variables but are not';
63 local $File::KDBX
::PLACEHOLDERS
{'COUNTER'} = $File::KDBX
::PLACEHOLDERS
{'COUNTER:'} = sub {
64 (undef, my $arg) = @_;
65 return defined $arg ? $arg : ++$counter;
67 my $entry4 = $kdbx->add_entry(
68 url
=> '{COUNTER} {USERNAME}',
69 username
=> '{COUNTER}x{COUNTER}y{COUNTER:-1}',
71 like
$entry4->expand_username, qr/^1x1y-1$/,
72 'Each unique placeholder is evaluated once';
73 like
$entry4->expand_url, qr/^2 3x3y-1$/,
74 'Each unique placeholder is evaluated once per string';
This page took 0.040457 seconds and 4 git commands to generate.