Add iterator

[chaz/p5-File-KDBX] / t / object.t

diff --git a/t/object.t b/t/object.t
index 749066d8a7d5c3b53d23833609abf78eb0876adb..b176c7793a0b90d0cff9bd694c691a59df1a7a85 100644 (file)
--- a/t/object.t
+++ b/t/object.t
@@ -32,7 +32,7 @@ subtest 'Cloning' => sub {
     $txn->commit;
 
     $copy = $entry->clone;
-    is @{$copy->history}, 1, 'Copy has a historical entry';
+    is @{$copy->history}, 1, 'Copy has a historical entry' or dumper $copy->history;
     cmp_deeply $copy, $entry, 'Entry with history and its clone are identical';
 
     $copy = $entry->clone(history => 0);
@@ -52,18 +52,19 @@ subtest 'Cloning' => sub {
         'Entry in database and its copy with username ref have same expanded username';
 
     $copy = $entry->clone;
-    is @{$kdbx->all_entries}, 1, 'Still only one entry after cloning';
+    is $kdbx->entries->size, 1, 'Still only one entry after cloning';
 
     $copy = $entry->clone(parent => 1);
-    is @{$kdbx->all_entries}, 2, 'New copy added to database if clone with parent option';
-    my ($e1, $e2) = @{$kdbx->all_entries};
+    is $kdbx->entries->size, 2, 'New copy added to database if clone with parent option';
+    my ($e1, $e2) = $kdbx->entries->each;
     isnt $e1, $e2, 'Entry and its copy in the database are different objects';
     is $e1->title, $e2->title, 'Entry copy has the same title as the original entry';
 
     $copy = $entry->clone(parent => 1, relabel => 1);
-    is @{$kdbx->all_entries}, 3, 'New copy added to database if clone with parent option';
-    is $kdbx->all_entries->[2], $copy, 'New copy and new entry in the database match';
-    is $kdbx->all_entries->[2]->title, "foo - Copy", 'New copy has a modified title';
+    is $kdbx->entries->size, 3, 'New copy added to database if clone with parent option';
+    my $e3 = $kdbx->entries->skip(2)->next;
+    is $e3, $copy, 'New copy and new entry in the database match';
+    is $e3->title, 'foo - Copy', 'New copy has a modified title';
 
     $copy = $group->clone;
     cmp_deeply $copy, $group, 'Group and its clone are identical';
@@ -80,12 +81,99 @@ subtest 'Cloning' => sub {
 
     $copy = $group->clone(relabel => 1);
     is $copy->name, 'Passwords - Copy', 'Group copy relabeled from the original title';
-    is @{$kdbx->all_entries}, 3, 'No new entries were added to the database';
+    is $kdbx->entries->size, 3, 'No new entries were added to the database';
 
     $copy = $group->clone(relabel => 1, parent => 1);
-    is @{$kdbx->all_entries}, 6, 'Copy a group within parent doubles the number of entries in the database';
+    is $kdbx->entries->size, 6, 'Copy a group within parent doubles the number of entries in the database';
     isnt $group->entries->[0]->uuid, $copy->entries->[0]->uuid,
         'First entry in group and its copy are different';
 };
 
+subtest 'Transactions' => sub {
+    my $kdbx = File::KDBX->new;
+
+    my $root    = $kdbx->root;
+    my $entry   = $kdbx->add_entry(
+        label => 'One',
+        last_modification_time => Time::Piece->strptime('2022-04-20', '%Y-%m-%d'),
+        username => 'Fred',
+    );
+
+    my $txn = $root->begin_work;
+    $root->label('Toor');
+    $root->notes('');
+    $txn->commit;
+    is $root->label, 'Toor', 'Retain change to root label after commit';
+
+    $root->begin_work;
+    $root->label('Root');
+    $entry->label('Zap');
+    $root->rollback;
+    is $root->label, 'Toor', 'Undo change to root label after rollback';
+    is $entry->label, 'Zap', 'Retain change to entry after rollback';
+
+    $txn = $root->begin_work(entries => 1);
+    $root->label('Root');
+    $entry->label('Zippy');
+    undef $txn; # implicit rollback
+    is $root->label, 'Toor', 'Undo change to root label after implicit rollback';
+    is $entry->label, 'Zap', 'Undo change to entry after rollback with deep transaction';
+
+    $txn = $entry->begin_work;
+    my $mtime = $entry->last_modification_time;
+    my $username = $entry->string('UserName');
+    $username->{meh} = 'hi';
+    $entry->username('jinx');
+    $txn->rollback;
+    is $entry->string('UserName'), $username, 'Rollback keeps original references';
+    is $entry->last_modification_time, $mtime, 'No last modification time change after rollback';
+
+    $txn = $entry->begin_work;
+    $entry->username('jinx');
+    $txn->commit;
+    isnt $entry->last_modification_time, $mtime, 'Last modification time changes after commit';
+
+    {
+        my $txn1 = $root->begin_work;
+        $root->label('alien');
+        {
+            my $txn2 = $root->begin_work;
+            $root->label('truth');
+            $txn2->commit;
+        }
+    }
+    is $root->label, 'Toor', 'Changes thrown away after rolling back outer transaction';
+
+    {
+        my $txn1 = $root->begin_work;
+        $root->label('alien');
+        {
+            my $txn2 = $root->begin_work;
+            $root->label('truth');
+        }
+        $txn1->commit;
+    }
+    is $root->label, 'alien', 'Keep committed change after rolling back inner transaction';
+
+    {
+        my $txn1 = $root->begin_work;
+        $root->label('alien');
+        {
+            my $txn2 = $root->begin_work;
+            $root->label('truth');
+            $txn2->commit;
+        }
+        $txn1->commit;
+    }
+    is $root->label, 'truth', 'Keep committed change from inner transaction';
+
+    $txn = $root->begin_work;
+    $root->label('Lalala');
+    my $dump = $kdbx->dump_string('a');
+    $txn->commit;
+    is $root->label, 'Lalala', 'Keep committed label change after dump';
+    my $load = File::KDBX->load_string($dump, 'a');
+    is $load->root->label, 'truth', 'Object dumped before committing matches the pre-transaction state';
+};
+
 done_testing;