From: Charles McGarvey <ccm@cpan.org>
Date: Tue, 19 Apr 2022 19:49:49 +0000 (-0600)
Subject: Adjust dependencies
X-Git-Tag: v0.800~23
X-Git-Url: https://git.dogcows.com/gitweb?a=commitdiff_plain;h=eb5adf956fc6b9285b43ce6965eea728573e7864;p=chaz%2Fp5-File-KDBX

Adjust dependencies
---

diff --git a/dist.ini b/dist.ini
index 8eceb08..ba85d8c 100644
--- a/dist.ini
+++ b/dist.ini
@@ -7,8 +7,6 @@ license             = Perl_5
 [@Author::CCM]
 
 [Prereqs / RuntimeRecommends]
-; B::COW might speed up the memory erase feature, maybe
-B::COW              = 0
 File::Spec          = 0
 
 [Prereqs / TestSuggests]
@@ -49,6 +47,11 @@ to_relationship     = none
 module              = File::KeePass
 module              = File::KeePass::KDBX
 
+[Prereqs::Soften / ProgressiveEnhancement]
+to_relationship     = none
+; File::KDBX::XS, which is recommended, provides the same functionality as B::COW
+module              = B::COW
+
 [Prereqs::Soften]
 modules_from_features   = 1
 
diff --git a/lib/File/KDBX/Dumper/V3.pm b/lib/File/KDBX/Dumper/V3.pm
index 635931f..ceb9f29 100644
--- a/lib/File/KDBX/Dumper/V3.pm
+++ b/lib/File/KDBX/Dumper/V3.pm
@@ -10,7 +10,7 @@ use File::KDBX::Constants qw(:header :compression);
 use File::KDBX::Error;
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HashBlock;
-use File::KDBX::Util qw(:empty assert_64bit erase_scoped);
+use File::KDBX::Util qw(:empty :load assert_64bit erase_scoped);
 use IO::Handle;
 use namespace::clean;
 
@@ -160,7 +160,7 @@ sub _write_body {
 
     my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS};
     if ($compress == COMPRESSION_GZIP) {
-        require IO::Compress::Gzip;
+        load_optional('IO::Compress::Gzip');
         $fh = IO::Compress::Gzip->new($fh,
             -Level => IO::Compress::Gzip::Z_BEST_COMPRESSION(),
             -TextFlag => 1,
diff --git a/lib/File/KDBX/Dumper/V4.pm b/lib/File/KDBX/Dumper/V4.pm
index 8100212..642f689 100644
--- a/lib/File/KDBX/Dumper/V4.pm
+++ b/lib/File/KDBX/Dumper/V4.pm
@@ -11,7 +11,7 @@ use File::KDBX::Constants qw(:header :inner_header :compression :kdf :variant_ma
 use File::KDBX::Error;
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HmacBlock;
-use File::KDBX::Util qw(:empty assert_64bit erase_scoped);
+use File::KDBX::Util qw(:empty :load assert_64bit erase_scoped);
 use IO::Handle;
 use Scalar::Util qw(looks_like_number);
 use boolean qw(:all);
@@ -243,7 +243,7 @@ sub _write_body {
 
     my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS};
     if ($compress == COMPRESSION_GZIP) {
-        require IO::Compress::Gzip;
+        load_optional('IO::Compress::Gzip');
         $fh = IO::Compress::Gzip->new($fh,
             -Level => IO::Compress::Gzip::Z_BEST_COMPRESSION(),
             -TextFlag => 1,
diff --git a/lib/File/KDBX/Error.pm b/lib/File/KDBX/Error.pm
index fbc6bbd..7f44942 100644
--- a/lib/File/KDBX/Error.pm
+++ b/lib/File/KDBX/Error.pm
@@ -70,7 +70,7 @@ passed will be forwarded to L</new> to create a new error object.
 This can be convenient for error handling when you're not sure what the exception is but you want to treat it
 as a B<File::KDBX::Error>. Example:
 
-    eval { .... };
+    eval { ... };
     if (my $error = error(@_)) {
         if ($error->type eq 'key.missing') {
             handle_missing_key($error);
diff --git a/lib/File/KDBX/Loader/V3.pm b/lib/File/KDBX/Loader/V3.pm
index 77ad479..687215a 100644
--- a/lib/File/KDBX/Loader/V3.pm
+++ b/lib/File/KDBX/Loader/V3.pm
@@ -22,7 +22,7 @@ use File::KDBX::Constants qw(:header :compression :kdf);
 use File::KDBX::Error;
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HashBlock;
-use File::KDBX::Util qw(:io assert_64bit erase_scoped);
+use File::KDBX::Util qw(:io :load assert_64bit erase_scoped);
 use namespace::clean;
 
 use parent 'File::KDBX::Loader';
@@ -142,7 +142,7 @@ sub _read_body {
 
     my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS};
     if ($compress == COMPRESSION_GZIP) {
-        require IO::Uncompress::Gunzip;
+        load_optional('IO::Uncompress::Gunzip');
         $fh = IO::Uncompress::Gunzip->new($fh)
             or throw "Failed to initialize compression library: $IO::Uncompress::Gunzip::GunzipError",
                 error => $IO::Uncompress::Gunzip::GunzipError;
diff --git a/lib/File/KDBX/Loader/V4.pm b/lib/File/KDBX/Loader/V4.pm
index fa8d21d..2180d28 100644
--- a/lib/File/KDBX/Loader/V4.pm
+++ b/lib/File/KDBX/Loader/V4.pm
@@ -22,7 +22,7 @@ use Crypt::Mac::HMAC qw(hmac);
 use Encode qw(decode);
 use File::KDBX::Constants qw(:header :inner_header :variant_map :compression);
 use File::KDBX::Error;
-use File::KDBX::Util qw(:io assert_64bit erase_scoped);
+use File::KDBX::Util qw(:io :load assert_64bit erase_scoped);
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HmacBlock;
 use boolean;
@@ -198,7 +198,7 @@ sub _read_body {
 
     my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS};
     if ($compress == COMPRESSION_GZIP) {
-        require IO::Uncompress::Gunzip;
+        load_optional('IO::Uncompress::Gunzip');
         $fh = IO::Uncompress::Gunzip->new($fh)
             or throw "Failed to initialize compression library: $IO::Uncompress::Gunzip::GunzipError",
                 error => $IO::Uncompress::Gunzip::GunzipError;
diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm
index c970683..87d87d6 100644
--- a/lib/File/KDBX/Util.pm
+++ b/lib/File/KDBX/Util.pm
@@ -82,6 +82,47 @@ my %OP_NEG = (
     '!~'    =>  '=~',
 );
 
+=func FALSE
+
+=func TRUE
+
+Constants appropriate for use as return values in functions claiming to return true or false.
+
+=cut
+
+sub FALSE() { !1 }
+sub TRUE()  {  1 }
+
+=func load_xs
+
+    $bool = load_xs();
+    $bool = load_xs($version);
+
+Attempt to load L<File::KDBX::XS>. Return truthy if C<XS> is loaded. If C<$version> is given, it will check
+that at least the given version is loaded.
+
+=cut
+
+sub load_xs {
+    my $version = shift;
+
+    goto IS_LOADED if File::KDBX->can('_XS_LOADED');
+
+    my $try_xs = 1;
+    $try_xs = 0 if $ENV{PERL_ONLY} || (exists $ENV{PERL_FILE_KDBX_XS} && !$ENV{PERL_FILE_KDBX_XS});
+
+    my $use_xs = 0;
+    $use_xs = eval { require File::KDBX::XS; 1 } if $try_xs;
+
+    *File::KDBX::_XS_LOADED = *File::KDBX::_XS_LOADED = $use_xs ? \&TRUE : \&FALSE;
+
+    IS_LOADED:
+    {
+        local $@;
+        return $version ? !!eval { File::KDBX::XS->VERSION($version); 1 } : File::KDBX::_XS_LOADED();
+    }
+}
+
 =func assert_64bit
 
     assert_64bit();
@@ -243,7 +284,17 @@ Overwrite the memory used by one or more string.
 
 =cut
 
-# use File::KDBX::XS;
+BEGIN {
+    if (load_xs) {
+        # loaded CowREFCNT
+    }
+    elsif (eval { require B::COW; 1 }) {
+        *CowREFCNT = \*B::COW::cowrefcnt;
+    }
+    else {
+        *CowREFCNT = sub { undef };
+    }
+}
 
 sub erase {
     # Only bother zeroing out memory if we have the last SvPV COW reference, otherwise we'll end up just
@@ -252,10 +303,8 @@ sub erase {
     for (@_) {
         if (!is_ref($_)) {
             next if !defined $_ || readonly $_;
-            if (_USE_COWREFCNT()) {
-                my $cowrefcnt = B::COW::cowrefcnt($_);
-                goto FREE_NONREF if defined $cowrefcnt && 1 < $cowrefcnt;
-            }
+            my $cowrefcnt = CowREFCNT($_);
+            goto FREE_NONREF if defined $cowrefcnt && 1 < $cowrefcnt;
             # if (__PACKAGE__->can('erase_xs')) {
             #     erase_xs($_);
             # }
@@ -269,10 +318,8 @@ sub erase {
         }
         elsif (is_scalarref($_)) {
             next if !defined $$_ || readonly $$_;
-            if (_USE_COWREFCNT()) {
-                my $cowrefcnt = B::COW::cowrefcnt($$_);
-                goto FREE_REF if defined $cowrefcnt && 1 < $cowrefcnt;
-            }
+            my $cowrefcnt = CowREFCNT($$_);
+            goto FREE_REF if defined $cowrefcnt && 1 < $cowrefcnt;
             # if (__PACKAGE__->can('erase_xs')) {
             #     erase_xs($$_);
             # }
@@ -468,34 +515,6 @@ sub load_optional {
     return wantarray ? @_ : $_[0];
 }
 
-=func load_xs
-
-    $bool = load_xs();
-    $bool = load_xs($version);
-
-Attempt to load L<File::KDBX::XS>. Return truthy if C<XS> is loaded. If C<$version> is given, it will check
-that at least the given version is loaded.
-
-=cut
-
-sub load_xs {
-    my $version = shift;
-
-    require File::KDBX;
-
-    my $has_xs = File::KDBX->can('XS_LOADED');
-    return $has_xs->() && ($version ? eval { File::KDBX::XS->VERSION($version); 1 } : 1) if $has_xs;
-
-    my $try_xs = 1;
-    $try_xs = 0 if $ENV{PERL_ONLY} || (exists $ENV{PERL_FILE_KDBX_XS} && !$ENV{PERL_FILE_KDBX_XS});
-
-    my $use_xs = 0;
-    $use_xs = try_load_optional('File::KDBX::XS') if $try_xs;
-
-    *File::KDBX::XS_LOADED = *File::KDBX::XS_LOADED = $use_xs ? sub() { 1 } : sub() { 0 };
-    return $version ? eval { File::KDBX::XS->VERSION($version); 1 } : 1;
-}
-
 =func memoize
 
     \&memoized_code = memoize(\&code, ...);
@@ -820,22 +839,6 @@ sub uuid {
 
 }
 
-=func FALSE
-
-=func TRUE
-
-Constants appropriate for use as return values in functions claiming to return true or false.
-
-=cut
-
-sub FALSE() { !1 }
-sub TRUE()  {  1 }
-
-BEGIN {
-    my $use_cowrefcnt = eval { require B::COW; 1 };
-    *_USE_COWREFCNT = $use_cowrefcnt ? sub() { 1 } : sub() { 0 };
-}
-
 ### --------------------------------------------------------------------------
 
 # Determine if an array looks like keypairs from a hash.
diff --git a/t/kdf-aes-pp.t b/t/kdf-aes-pp.t
index e5f0fc6..9ebdb39 100644
--- a/t/kdf-aes-pp.t
+++ b/t/kdf-aes-pp.t
@@ -3,10 +3,11 @@
 use warnings;
 use strict;
 
+BEGIN { $ENV{PERL_FILE_KDBX_XS} = 0 }
+
 use lib 't/lib';
 use TestCommon;
 
-BEGIN { $ENV{PERL_FILE_KDBX_XS} = 0 }
 use File::KDBX::KDF;
 
 use File::KDBX::Constants qw(:kdf);
@@ -14,7 +15,7 @@ use Test::More;
 
 my $kdf = File::KDBX::KDF->new(uuid => KDF_UUID_AES, seed => "\1" x 32, rounds => 10);
 
-is File::KDBX::XS_LOADED(), 0, 'XS can be avoided';
+ok !File::KDBX::_XS_LOADED(), 'XS can be avoided';
 
 my $r = $kdf->transform("\2" x 32);
 is $r, "\342\234cp\375\\p\253]\213\f\246\345\230\266\260\r\222j\332Z\204:\322 p\224mhm\360\222",
diff --git a/t/lib/TestCommon.pm b/t/lib/TestCommon.pm
index 3111460..e499251 100644
--- a/t/lib/TestCommon.pm
+++ b/t/lib/TestCommon.pm
@@ -6,7 +6,7 @@ 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 File::Spec;
 use FindBin qw($Bin);
 use Test::Fatal;
 use Test::Deep;
@@ -36,7 +36,6 @@ sub import {
     # 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;
@@ -50,7 +49,7 @@ sub import {
 }
 
 sub testfile {
-    return catfile($Bin, 'files', @_);
+    return File::Spec->catfile($Bin, 'files', @_);
 }
 
 sub dump_test_deep_template {