X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=t%2Flib%2FTestCommon.pm;fp=t%2Flib%2FTestCommon.pm;h=31114605bd077424c86577e4b9e87b00cbcbf590;hb=f63182fc62b25269b1c38588dca2b3535ed1a1a2;hp=0000000000000000000000000000000000000000;hpb=e2deca75a6040911441e0d7c4430aeae9be69e40;p=chaz%2Fp5-File-KDBX

diff --git a/t/lib/TestCommon.pm b/t/lib/TestCommon.pm
new file mode 100644
index 0000000..3111460
--- /dev/null
+++ b/t/lib/TestCommon.pm
@@ -0,0 +1,102 @@
+package TestCommon;
+
+use warnings;
+use strict;
+
+use Data::Dumper;
+use File::KDBX::Constants qw(:magic :kdf);
+use File::KDBX::Util qw(can_fork dumper);
+use File::Spec::Functions qw(catfile);
+use FindBin qw($Bin);
+use Test::Fatal;
+use Test::Deep;
+
+BEGIN {
+    $Data::Dumper::Deepcopy = 1;
+    $Data::Dumper::Deparse = 1;
+    $Data::Dumper::Indent = 1;
+    $Data::Dumper::Quotekeys = 0;
+    $Data::Dumper::Sortkeys = 1;
+    $Data::Dumper::Terse = 1;
+    $Data::Dumper::Trailingcomma = 1;
+    $Data::Dumper::Useqq = 1;
+}
+
+sub import {
+    my $self = shift;
+    my @args = @_;
+
+    my $caller = caller;
+
+    require Test::Warnings;
+    my @warnings_flags;
+    push @warnings_flags, ':no_end_test' if !$ENV{AUTHOR_TESTING} || grep { $_ eq ':no_warnings_test' } @args;
+    Test::Warnings->import(@warnings_flags);
+
+    # Just export a random assortment of things useful for testing.
+    no strict 'refs';
+    *{"${caller}::dumper"}      = \&File::KDBX::Util::dumper;
+    *{"${caller}::catfile"}     = \&File::Spec::Functions::catfile;
+
+    *{"${caller}::exception"}   = \&Test::Fatal::exception;
+    *{"${caller}::warning"}     = \&Test::Warnings::warning;
+    *{"${caller}::warnings"}    = \&Test::Warnings::warnings;
+
+    *{"${caller}::dump_test_deep_template"}  = \&dump_test_deep_template;
+    *{"${caller}::ok_magic"}    = \&ok_magic;
+    *{"${caller}::fast_kdf"}    = \&fast_kdf;
+    *{"${caller}::can_fork"}    = \&can_fork;
+    *{"${caller}::testfile"}    = \&testfile;
+}
+
+sub testfile {
+    return catfile($Bin, 'files', @_);
+}
+
+sub dump_test_deep_template {
+    my $struct = shift;
+
+    my $str = Dumper $struct;
+    # booleans: bless( do{\(my $o = 1)}, 'boolean' )
+    $str =~ s/bless\( do\{\\\(my \$o = ([01])\)\}, 'boolean' \)/bool($1)/gs;
+    # objects
+    $str =~ s/bless\(.+?'([^']+)' \)/obj_isa('$1')/gs;
+    # convert two to four space indentation
+    $str =~ s/^( +)/' ' x (length($1) * 2)/gme;
+
+    open(my $fh, '>>', 'TEST-DEEP-TEMPLATES.pl') or die "open failed: $!";
+    print $fh $str, "\n";
+}
+
+sub ok_magic {
+    my $kdbx = shift;
+    my $vers = shift;
+    my $note = shift;
+
+    my $magic = [$kdbx->sig1, $kdbx->sig2, $kdbx->version];
+    cmp_deeply $magic, [
+        KDBX_SIG1,
+        KDBX_SIG2_2,
+        $vers,
+    ], $note // 'KDBX magic numbers are correct';
+}
+
+sub fast_kdf {
+    my $uuid = shift // KDF_UUID_AES;
+    my $params = {
+        KDF_PARAM_UUID() => $uuid,
+    };
+    if ($uuid eq KDF_UUID_AES || $uuid eq KDF_UUID_AES_CHALLENGE_RESPONSE) {
+        $params->{+KDF_PARAM_AES_ROUNDS} = 17;
+        $params->{+KDF_PARAM_AES_SEED} = "\1" x 32;
+    }
+    else { # Argon2
+        $params->{+KDF_PARAM_ARGON2_SALT} = "\1" x 32;
+        $params->{+KDF_PARAM_ARGON2_PARALLELISM} = 1;
+        $params->{+KDF_PARAM_ARGON2_MEMORY} = 1 << 13;
+        $params->{+KDF_PARAM_ARGON2_ITERATIONS} = 2;
+        $params->{+KDF_PARAM_ARGON2_VERSION} = 0x13;
+    }
+    return $params;
+}
+1;