Simplify attribute generation

diff --git a/lib/File/KDBX/Constants.pm b/lib/File/KDBX/Constants.pm
index 6eea0ef01cfb2f80bc877cc3a4ba5aa329bb3fac..6f88b252cb35092be24d1b59d1dc744776336f34 100644 (file)
--- 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 124a267b4f71627e4d4507b96641bb52db2d5d01..237e05665351f125348936baec6ffe16ff5534ae 100644 (file)
--- 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 7eeaaee500b25aa41f8d3932238313fd76f753e9..a45467c58d56b30b728ecc897218052e94bfcf80 100644 (file)
--- 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 c3d77ae69b2f08e156eeeb11ed29f330ee76fc53..c4730fc6ed3964a250ad9a6c790645ec06d09502 100644 (file)
--- 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