]>
Dogcows Code - chaz/p5-File-KDBX/blob - t/object.t
10 use File
::KDBX
::Util
qw(:uuid);
15 subtest
'Cloning' => sub {
16 my $kdbx = File
::KDBX-
>new;
17 my $entry = File
::KDBX
::Entry-
>new;
19 my $copy = $entry->clone;
20 like exception
{ $copy->kdbx }, qr/disassociated/, 'Disassociated entry copy is also disassociated';
21 cmp_deeply
$copy, $entry, 'Disassociated entry and its clone are identical';
24 $copy = $entry->clone;
25 is $entry->kdbx, $copy->kdbx, 'Associated entry copy is also associated';
26 cmp_deeply
$copy, $entry, 'Associated entry and its clone are identical';
28 my $txn = $entry->begin_work;
30 $entry->username('bar');
31 $entry->password('baz');
34 $copy = $entry->clone;
35 is @{$copy->history}, 1, 'Copy has a historical entry';
36 cmp_deeply
$copy, $entry, 'Entry with history and its clone are identical';
38 $copy = $entry->clone(history
=> 0);
39 is @{$copy->history}, 0, 'Copy excluding history has no history';
41 $copy = $entry->clone(new_uuid
=> 1);
42 isnt
$copy->uuid, $entry->uuid, 'Entry copy with new UUID has a different UUID';
44 $copy = $entry->clone(reference_username
=> 1);
45 my $ref = sprintf('{REF:U@I:%s}', format_uuid
($entry->uuid));
46 is $copy->username, $ref, 'Copy has username reference';
47 is $copy->expanded_username, $ref, 'Entry copy does not expand username because entry is not in database';
49 my $group = $kdbx->add_group(label
=> 'Passwords');
50 $group->add_entry($entry);
51 is $copy->expanded_username, $entry->username,
52 'Entry in database and its copy with username ref have same expanded username';
54 $copy = $entry->clone;
55 is @{$kdbx->all_entries}, 1, 'Still only one entry after cloning';
57 $copy = $entry->clone(parent
=> 1);
58 is @{$kdbx->all_entries}, 2, 'New copy added to database if clone with parent option';
59 my ($e1, $e2) = @{$kdbx->all_entries};
60 isnt
$e1, $e2, 'Entry and its copy in the database are different objects';
61 is $e1->title, $e2->title, 'Entry copy has the same title as the original entry';
63 $copy = $entry->clone(parent
=> 1, relabel
=> 1);
64 is @{$kdbx->all_entries}, 3, 'New copy added to database if clone with parent option';
65 is $kdbx->all_entries->[2], $copy, 'New copy and new entry in the database match';
66 is $kdbx->all_entries->[2]->title, "foo - Copy", 'New copy has a modified title';
68 $copy = $group->clone;
69 cmp_deeply
$copy, $group, 'Group and its clone are identical';
70 is @{$copy->entries}, 3, 'Group copy has as many entries as the original';
71 is @{$copy->entries->[0]->history}, 1, 'Entry in group copy has history';
73 $copy = $group->clone(history
=> 0);
74 is @{$copy->entries}, 3, 'Group copy without history has as many entries as the original';
75 is @{$copy->entries->[0]->history}, 0, 'Entry in group copy has no history';
77 $copy = $group->clone(entries
=> 0);
78 is @{$copy->entries}, 0, 'Group copy without entries has no entries';
79 is $copy->name, 'Passwords', 'Group copy label is the same as the original';
81 $copy = $group->clone(relabel
=> 1);
82 is $copy->name, 'Passwords - Copy', 'Group copy relabeled from the original title';
83 is @{$kdbx->all_entries}, 3, 'No new entries were added to the database';
85 $copy = $group->clone(relabel
=> 1, parent
=> 1);
86 is @{$kdbx->all_entries}, 6, 'Copy a group within parent doubles the number of entries in the database';
87 isnt
$group->entries->[0]->uuid, $copy->entries->[0]->uuid,
88 'First entry in group and its copy are different';
This page took 0.041304 seconds and 4 git commands to generate.