From: Charles McGarvey <ccm@cpan.org>
Date: Mon, 25 Apr 2022 03:02:58 +0000 (-0600)
Subject: Simplify attribute generation
X-Git-Tag: v0.800~15
X-Git-Url: https://git.brokenzipper.com/gitweb?a=commitdiff_plain;h=0f9150d48f698cf468d3d814e52ee9f15572809b;p=chaz%2Fp5-File-KDBX

Simplify attribute generation
---

diff --git a/lib/File/KDBX/Constants.pm b/lib/File/KDBX/Constants.pm
index 6eea0ef..6f88b25 100644
--- a/lib/File/KDBX/Constants.pm
+++ b/lib/File/KDBX/Constants.pm
@@ -291,13 +291,13 @@ for my $header (
 ) {
     $HEADER{$header} = $HEADER{0+$header} = $header;
 }
-sub to_header_constant { $HEADER{$_[0]} }
+sub to_header_constant { $HEADER{$_[0] // ''} }
 
 my %COMPRESSION;
 for my $compression (COMPRESSION_NONE, COMPRESSION_GZIP) {
     $COMPRESSION{$compression} = $COMPRESSION{0+$compression} = $compression;
 }
-sub to_compression_constant { $COMPRESSION{$_[0]} }
+sub to_compression_constant { $COMPRESSION{$_[0] // ''} }
 
 my %INNER_HEADER;
 for my $inner_header (
@@ -306,7 +306,7 @@ for my $inner_header (
 ) {
     $INNER_HEADER{$inner_header} = $INNER_HEADER{0+$inner_header} = $inner_header;
 }
-sub to_inner_header_constant { $INNER_HEADER{$_[0]} }
+sub to_inner_header_constant { $INNER_HEADER{$_[0] // ''} }
 
 my %ICON;
 for my $icon (
diff --git a/lib/File/KDBX/Dumper/Raw.pm b/lib/File/KDBX/Dumper/Raw.pm
index 124a267..237e056 100644
--- a/lib/File/KDBX/Dumper/Raw.pm
+++ b/lib/File/KDBX/Dumper/Raw.pm
@@ -5,6 +5,7 @@ use warnings;
 use strict;
 
 use File::KDBX::Util qw(:class);
+use namespace::clean;
 
 extends 'File::KDBX::Dumper';
 
diff --git a/lib/File/KDBX/Loader/Raw.pm b/lib/File/KDBX/Loader/Raw.pm
index 7eeaaee..a45467c 100644
--- a/lib/File/KDBX/Loader/Raw.pm
+++ b/lib/File/KDBX/Loader/Raw.pm
@@ -5,6 +5,7 @@ use warnings;
 use strict;
 
 use File::KDBX::Util qw(:class);
+use namespace::clean;
 
 extends 'File::KDBX::Loader';
 
diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm
index c3d77ae..c4730fc 100644
--- a/lib/File/KDBX/Util.pm
+++ b/lib/File/KDBX/Util.pm
@@ -398,59 +398,43 @@ sub has {
     my $name = shift;
     my %args = @_ % 2 == 1 ? (default => shift, @_) : @_;
 
+    my ($package, $file, $line) = caller;
+
     my $d = $args{default};
     my $default = is_arrayref($d) ? sub { [%$d] } : is_hashref($d) ? sub { +{%$d} } : $d;
     my $coerce  = $args{coerce};
     my $is      = $args{is} || 'rw';
 
-    my $has_default = is_coderef $default;
-    my $has_coerce  = is_coderef $coerce;
-
     my $store = $args{store};
     ($store, $name) = split(/\./, $name, 2) if $name =~ /\./;
-
-    my $caller = caller;
-    push @{$ATTRIBUTES{$caller} //= []}, $name;
-
-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    if ($store) {
-        *{"${caller}::${name}"} = $is eq 'ro' && $has_default ? sub {
-            $_[0]->$store->{$name} //= scalar $default->($_[0]);
-        } : $is eq 'ro' ? sub {
-            $_[0]->$store->{$name} //= $default;
-        } : $has_default && $has_coerce ? sub {
-            $#_ ? $_[0]->$store->{$name} = scalar $coerce->($_[1])
-                : $_[0]->$store->{$name} //= scalar $default->($_[0]);
-        } : $has_default ? sub {
-            $#_ ? $_[0]->$store->{$name} = $_[1]
-                : $_[0]->$store->{$name} //= scalar $default->($_[0]);
-        } : $has_coerce ? sub {
-            $#_ ? $_[0]->$store->{$name} = scalar $coerce->($_[1])
-                : $_[0]->$store->{$name} //= $default;
-        } : sub {
-            $#_ ? $_[0]->$store->{$name} = $_[1]
-                : $_[0]->$store->{$name} //= $default;
-        };
-    }
-    else {
-        *{"${caller}::${name}"} = $is eq 'ro' && $has_default ? sub {
-            $_[0]->{$name} //= scalar $default->($_[0]);
-        } : $is eq 'ro' ? sub {
-            $_[0]->{$name} //= $default;
-        } : $has_default && $has_coerce ? sub {
-            $#_ ? $_[0]->{$name} = scalar $coerce->($_[1])
-                : $_[0]->{$name} //= scalar $default->($_[0]);
-        } : $has_default ? sub {
-            $#_ ? $_[0]->{$name} = $_[1]
-                : $_[0]->{$name} //= scalar $default->($_[0]);
-        } : $has_coerce ? sub {
-            $#_ ? $_[0]->{$name} = scalar $coerce->($_[1])
-                : $_[0]->{$name} //= $default;
-        } : sub {
-            $#_ ? $_[0]->{$name} = $_[1]
-                : ($_[0]->{$name} //= $default);
-        };
+    push @{$ATTRIBUTES{$package} //= []}, $name;
+
+    my $store_code = '';
+    $store_code = qq{->$store} if $store;
+    my $member = qq{\$_[0]$store_code\->{'$name'}};
+
+    my $default_code = is_coderef $default ? q{scalar $default->($_[0])}
+                        : defined $default ? q{$default}
+                                           : q{undef};
+    my $get = qq{$member //= $default_code;};
+
+    my $set = '';
+    if ($is eq 'rw') {
+        $set = is_coderef $coerce ? qq{$member = scalar \$coerce->(\$_[1]) if \$#_;}
+                : defined $coerce ? qq{$member = do { local $_; shift; $coerce } if \$#_;}
+                                  : qq{$member = \$_[1] if \$#_;};
     }
+
+    $line -= 4;
+    my $code = <<END;
+# line $line "$file"
+sub ${package}::${name} {
+    return $default_code if !Scalar::Util::blessed(\$_[0]);
+    $set
+    $get
+}
+END
+    eval $code; ## no critic (ProhibitStringyEval)
 }
 
 =func format_uuid