Adjust dependencies

diff --git a/dist.ini b/dist.ini
index 8eceb082ba9797db7ca47229464df3fa6e980473..ba85d8c4e3f16e7da8cb2b0bc0175d1f39aa8456 100644 (file)
--- a/dist.ini
+++ b/dist.ini
@@ -7,8 +7,6 @@ license             = Perl_5
 [@Author::CCM]
 
 [Prereqs / RuntimeRecommends]
 [@Author::CCM]
 
 [Prereqs / RuntimeRecommends]

-; B::COW might speed up the memory erase feature, maybe
-B::COW              = 0

 File::Spec          = 0
 
 [Prereqs / TestSuggests]
 File::Spec          = 0
 
 [Prereqs / TestSuggests]


@@ -49,6 +47,11 @@ to_relationship     = none
 module              = File::KeePass
 module              = File::KeePass::KDBX
 
 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
 
 [Prereqs::Soften]
 modules_from_features   = 1
 

diff --git a/lib/File/KDBX/Dumper/V3.pm b/lib/File/KDBX/Dumper/V3.pm
index 635931fa5c58baea93a18fc0b4cb90261b417a59..ceb9f297f7e67d968944e2006f05318499f9aaf2 100644 (file)
--- 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::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;
 
 use IO::Handle;
 use namespace::clean;
 


@@ -160,7 +160,7 @@ sub _write_body {
 
     my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS};
     if ($compress == COMPRESSION_GZIP) {
 
     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,
         $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 81002128139c714b10b5b626ef09d32bf818b511..642f689b8dd104b8cf35d1346f186d983c2f2d5e 100644 (file)
--- 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::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);
 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) {
 
     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,
         $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 fbc6bbd35d7b911db42c705a4e1bf1808da059e7..7f44942caaee88e9a16acd9e72e6399bcb6422be 100644 (file)
--- 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:
 
 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);
     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 77ad479635abea9c3ea2ea56764f6161619bfb56..687215a00caff562637ffd507e23c4e752ca084b 100644 (file)
--- 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::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';
 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) {
 
     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;
         $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 fa8d21d867e220a321efe81c06bff1b30d1b4278..2180d28df8d37c9b11ed301cc83becc47fe856ea 100644 (file)
--- 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 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;
 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) {
 
     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;
         $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 c970683694fcef37ff0086c2c5a7acc5d54f3efa..87d87d6c2022d13e0ed61620c6bf56881fbdb3af 100644 (file)
--- 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();
 =func assert_64bit
 
     assert_64bit();


@@ -243,7 +284,17 @@ Overwrite the memory used by one or more string.
 
 =cut
 
 
 =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
 
 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 $_;
     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($_);
             # }
             # if (__PACKAGE__->can('erase_xs')) {
             #     erase_xs($_);
             # }


@@ -269,10 +318,8 @@ sub erase {
         }
         elsif (is_scalarref($_)) {
             next if !defined $$_ || readonly $$_;
         }
         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($$_);
             # }
             # if (__PACKAGE__->can('erase_xs')) {
             #     erase_xs($$_);
             # }


@@ -468,34 +515,6 @@ sub load_optional {
     return wantarray ? @_ : $_[0];
 }
 
     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, ...);
 =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.
 ### --------------------------------------------------------------------------
 
 # 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 e5f0fc693567c4437d85d5d321a75239e46a9bd8..9ebdb39e28897ef63c94ac9c2c882324813d9e9f 100644 (file)
--- a/t/kdf-aes-pp.t
+++ b/t/kdf-aes-pp.t
@@ -3,10 +3,11 @@
 use warnings;
 use strict;
 
 use warnings;
 use strict;
 

+BEGIN { $ENV{PERL_FILE_KDBX_XS} = 0 }
+

 use lib 't/lib';
 use TestCommon;
 
 use lib 't/lib';
 use TestCommon;
 

-BEGIN { $ENV{PERL_FILE_KDBX_XS} = 0 }

 use File::KDBX::KDF;
 
 use File::KDBX::Constants qw(:kdf);
 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);
 
 
 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",
 
 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 31114605bd077424c86577e4b9e87b00cbcbf590..e499251a896679b00f7428228aaa806f228e976a 100644 (file)
--- 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 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;
 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;
     # 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}::exception"}   = \&Test::Fatal::exception;
     *{"${caller}::warning"}     = \&Test::Warnings::warning;


@@ -50,7 +49,7 @@ sub import {
 }
 
 sub testfile {
 }
 
 sub testfile {

-    return catfile($Bin, 'files', @_);
+    return File::Spec->catfile($Bin, 'files', @_);

 }
 
 sub dump_test_deep_template {
 }
 
 sub dump_test_deep_template {