Add function for creating class attributes

[chaz/p5-File-KDBX] / lib / File / KDBX / KDF / AES.pm

diff --git a/lib/File/KDBX/KDF/AES.pm b/lib/File/KDBX/KDF/AES.pm
index 8ee1340a40538ac2a5aec68f7f7f73c00fe44546..5d6177b937f613cf99a2c9699884a692244750f5 100644 (file)
--- a/lib/File/KDBX/KDF/AES.pm
+++ b/lib/File/KDBX/KDF/AES.pm
@@ -6,12 +6,12 @@ use strict;
 
 use Crypt::Cipher;
 use Crypt::Digest qw(digest_data);
-use File::KDBX::Constants qw(:kdf);
+use File::KDBX::Constants qw(:bool :kdf);
 use File::KDBX::Error;
-use File::KDBX::Util qw(:load can_fork);
+use File::KDBX::Util qw(:class :load can_fork);
 use namespace::clean;
 
-use parent 'File::KDBX::KDF';
+extends 'File::KDBX::KDF';
 
 our $VERSION = '999.999'; # VERSION
 
@@ -19,20 +19,8 @@ our $VERSION = '999.999'; # VERSION
 my $FORK_OPTIMIZATION_THRESHOLD = 100_000;
 
 BEGIN {
-    load_xs;
-
-    my $use_fork = 1;
-    $use_fork = 0 if $ENV{NO_FORK} || !can_fork;
-    *USE_FORK = $use_fork ? sub() { 1 } : sub() { 0 };
-}
-
-sub init {
-    my $self = shift;
-    my %args = @_;
-    return $self->SUPER::init(
-        KDF_PARAM_AES_ROUNDS()  => $args{+KDF_PARAM_AES_ROUNDS} // $args{rounds},
-        KDF_PARAM_AES_SEED()    => $args{+KDF_PARAM_AES_SEED}   // $args{seed},
-    );
+    my $use_fork = $ENV{NO_FORK} || !can_fork;
+    *_USE_FORK = $use_fork ? \&TRUE : \&FALSE;
 }
 
 =attr rounds
@@ -46,6 +34,15 @@ Get the number of times to run the function during transformation.
 sub rounds  { $_[0]->{+KDF_PARAM_AES_ROUNDS} || KDF_DEFAULT_AES_ROUNDS }
 sub seed    { $_[0]->{+KDF_PARAM_AES_SEED} }
 
+sub init {
+    my $self = shift;
+    my %args = @_;
+    return $self->SUPER::init(
+        KDF_PARAM_AES_ROUNDS()  => $args{+KDF_PARAM_AES_ROUNDS} // $args{rounds},
+        KDF_PARAM_AES_SEED()    => $args{+KDF_PARAM_AES_SEED}   // $args{seed},
+    );
+}
+
 sub _transform {
     my $self    = shift;
     my $key     = shift;
@@ -58,7 +55,7 @@ sub _transform {
 
     my ($key_l, $key_r) = unpack('(a16)2', $key);
 
-    goto NO_FORK if !USE_FORK || $rounds < $FORK_OPTIMIZATION_THRESHOLD;
+    goto NO_FORK if !_USE_FORK || $rounds < $FORK_OPTIMIZATION_THRESHOLD;
     {
         my $pid = open(my $read, '-|') // do { alert "fork failed: $!"; goto NO_FORK };
         if ($pid == 0) { # child
@@ -73,7 +70,8 @@ sub _transform {
         return digest_data('SHA256', $l, $r);
     }
 
-    # FIXME: This used to work but now it crashes frequently. threads are discouraged anyway
+    # FIXME: This used to work but now it crashes frequently. Threads are now discouraged anyway, but it might
+    # be nice if this was available for no-fork platforms.
     # if ($ENV{THREADS} && eval 'use threads; 1') {
     #     my $l = threads->create(\&_transform_half, $key_l, $seed, $rounds);
     #     my $r = _transform_half($key_r, $seed, $rounds);
@@ -86,10 +84,7 @@ sub _transform {
     return digest_data('SHA256', $l, $r);
 }
 
-sub _transform_half {
-    my $xs = __PACKAGE__->can('_transform_half_xs');
-    goto $xs if $xs;
-
+sub _transform_half_pp {
     my $seed    = shift;
     my $key     = shift;
     my $rounds  = shift;
@@ -104,6 +99,11 @@ sub _transform_half {
     return $result;
 }
 
+BEGIN {
+    my $use_xs = load_xs;
+    *_transform_half = $use_xs ? \&File::KDBX::XS::kdf_aes_transform_half : \&_transform_half_pp;
+}
+
 1;
 __END__