Add iterator

[chaz/p5-File-KDBX] / lib / File / KDBX / Util.pm

diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm
index c3d77ae69b2f08e156eeeb11ed29f330ee76fc53..b1795a71c111d1144995dc7e82d7769f47e018fa 100644 (file)
--- a/lib/File/KDBX/Util.pm
+++ b/lib/File/KDBX/Util.pm
@@ -35,7 +35,7 @@ our %EXPORT_TAGS = (
     load        => [qw(load_optional load_xs try_load_optional)],
     search      => [qw(query search search_limited simple_expression_query)],
     text        => [qw(snakify trim)],
-    uuid        => [qw(format_uuid generate_uuid is_uuid uuid)],
+    uuid        => [qw(format_uuid generate_uuid is_uuid uuid UUID_NULL)],
     uri         => [qw(split_url uri_escape_utf8 uri_unescape_utf8)],
 );
 
@@ -376,7 +376,8 @@ Set up the current module to inheret from another module.
 sub extends {
     my $parent  = shift;
     my $caller  = caller;
-    load $parent;
+    # load $parent;
+    eval qq[require $parent];
     no strict 'refs'; ## no critic (ProhibitNoStrict)
     @{"${caller}::ISA"} = $parent;
 }
@@ -398,59 +399,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 $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 @_ = (\@_[1..\$#_]); $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
@@ -774,6 +759,7 @@ sub search_limited {
 =func simple_expression_query
 
     $query = simple_expression_query($expression, @fields);
+    $query = simple_expression_query($expression, $operator, @fields);
 
 Generate a query, like L</query>, to be used with L</search> but built from a "simple expression" as
 L<described here|https://keepass.info/help/base/search.html#mode_se>.
@@ -992,6 +978,14 @@ sub uuid {
 
 }
 
+=func UUID_NULL
+
+Get the null UUID (i.e. string of 16 null bytes).
+
+=cut
+
+sub UUID_NULL() { "\0" x 16 }
+
 ### --------------------------------------------------------------------------
 
 # Determine if an array looks like keypairs from a hash.