Remove min_version and clean up a lot of pod

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

diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm
index a09d2863d9177d69f902140f2159c0083bf50bc0..5645b4c4a4fa83e994427335ac850a92730ef8cc 100644 (file)
--- a/lib/File/KDBX/Util.pm
+++ b/lib/File/KDBX/Util.pm
@@ -33,7 +33,7 @@ our %EXPORT_TAGS = (
     gzip        => [qw(gzip gunzip)],
     io          => [qw(is_readable is_writable read_all)],
     load        => [qw(load_optional load_xs try_load_optional)],
-    search      => [qw(query search simple_expression_query)],
+    search      => [qw(query query_any search simple_expression_query)],
     text        => [qw(snakify trim)],
     uuid        => [qw(format_uuid generate_uuid is_uuid uuid UUID_NULL)],
     uri         => [qw(split_url uri_escape_utf8 uri_unescape_utf8)],
@@ -231,6 +231,10 @@ sub clone_nomagic {
     return $thing;
 }
 
+=func DEBUG
+
+Constant number indicating the level of debuggingness.
+
 =func dumper
 
     $str = dumper $thing;
@@ -411,8 +415,7 @@ Set up the current module to inheret from another module.
 sub extends {
     my $parent  = shift;
     my $caller  = caller;
-    # load $parent;
-    eval qq[require $parent];
+    load $parent;
     no strict 'refs'; ## no critic (ProhibitNoStrict)
     @{"${caller}::ISA"} = $parent;
 }
@@ -443,11 +446,13 @@ sub has {
 
     my $store = $args{store};
     ($store, $name) = split(/\./, $name, 2) if $name =~ /\./;
-    push @{$ATTRIBUTES{$package} //= []}, $name;
 
-    my $store_code = '';
-    $store_code = qq{->$store} if $store;
-    my $member = qq{\$_[0]$store_code\->{'$name'}};
+    my @path = split(/\./, $args{path} || '');
+    my $last = pop @path;
+    my $path = $last ? join('', map { qq{->$_} } @path) . qq{->{'$last'}}
+                     : $store ? qq{->$store\->{'$name'}} : qq{->{'$name'}};
+    my $member = qq{\$_[0]$path};
+
 
     my $default_code = is_coderef $default ? q{scalar $default->($_[0])}
                         : defined $default ? q{$default}
@@ -461,6 +466,7 @@ sub has {
                                   : qq{$member = \$_[1] if \$#_;};
     }
 
+    push @{$ATTRIBUTES{$package} //= []}, $name;
     $line -= 4;
     my $code = <<END;
 # line $line "$file"
@@ -679,12 +685,32 @@ The logic can be specified in a manner similar to L<SQL::Abstract/"WHERE CLAUSES
 for this function, but this code is distinct, supporting an overlapping but not identical feature set and
 having its own bugs.
 
-See L<File::KDBX/QUERY> for examples.
+See L<File::KDBX/"Declarative Syntax"> for examples.
 
 =cut
 
 sub query { _query(undef, '-or', \@_) }
 
+=func query_any
+
+Get either a L</query> or L</simple_expression_query>, depending on the arguments.
+
+=cut
+
+sub query_any {
+    my $code = shift;
+
+    if (is_coderef($code) || overload::Method($code, '&{}')) {
+        return $code;
+    }
+    elsif (is_scalarref($code)) {
+        return simple_expression_query($$code, @_);
+    }
+    else {
+        return query($code, @_);
+    }
+}
+
 =func read_all
 
     $size = read_all($fh, my $buffer, $size);
@@ -740,23 +766,11 @@ sub recurse_limit {
 
 Execute a linear search over an array of records using a L</query>. A "record" is usually a hash.
 
-This is the search engine described with many examples at L<File::KDBX/QUERY>.
-
 =cut
 
 sub search {
     my $list    = shift;
-    my $query   = shift;
-
-    if (is_coderef($query) && !@_) {
-        # already a query
-    }
-    elsif (is_scalarref($query)) {
-        $query = simple_expression_query($$query, @_);
-    }
-    else {
-        $query = query($query, @_);
-    }
+    my $query   = query_any(@_);
 
     my @match;
     for my $item (@$list) {
@@ -891,7 +905,8 @@ sub to_number { $_[0] // return; 0+$_[0] }
 sub to_string { $_[0] // return; "$_[0]" }
 sub to_time   {
     $_[0] // return;
-    return gmtime($_[0]) if looks_like_number($_[0]);
+    return scalar gmtime($_[0]) if looks_like_number($_[0]);
+    return scalar gmtime if $_[0] eq 'now';
     return Time::Piece->strptime($_[0], '%Y-%m-%d %H:%M:%S') if !blessed $_[0];
     return $_[0];
 }