Dogcows Code - chaz/p5-File-KDBX/blob - 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 'Custom icons' => sub {
  77     plan tests => 10;
  78     my $gif = pack('H*', '4749463839610100010000ff002c00000000010001000002003b');
  79
  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';
  84
  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';
  90
  91     my $found = $entry->kdbx->custom_icon_data($uuid);
  92     is $entry->custom_icon, $found, 'Custom icon on entry matches the database';
  93
  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';
  97 };
  98
  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';
 105
 106     my $txn = $entry->begin_work;
 107     $entry->notes('Hello!');
 108     $txn->commit;
 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';
 114 };
 115
 116 subtest 'Update UUID' => sub {
 117     my $kdbx = File::KDBX->new;
 118
 119     my $entry1 = $kdbx->add_entry(label => 'Foo');
 120     my $entry2 = $kdbx->add_entry(label => 'Bar');
 121
 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;
 125
 126     $entry1->uuid("\1" x 16);
 127
 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;
 132 };
 133
 134 done_testing;