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, 42, '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, 0, '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 done_testing;