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 5b12e9dd1ea525135e29611a258537b33d4193a7..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)],
     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)],
     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;
 }
 
     return $thing;
 }
 

+=func DEBUG
+
+Constant number indicating the level of debuggingness.
+

 =func dumper
 
     $str = dumper $thing;
 =func dumper
 
     $str = dumper $thing;


@@ -442,11 +446,13 @@ sub has {
 
     my $store = $args{store};
     ($store, $name) = split(/\./, $name, 2) if $name =~ /\./;
 
     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}
 
     my $default_code = is_coderef $default ? q{scalar $default->($_[0])}
                         : defined $default ? q{$default}


@@ -460,6 +466,7 @@ sub has {
                                   : qq{$member = \$_[1] if \$#_;};
     }
 
                                   : qq{$member = \$_[1] if \$#_;};
     }
 

+    push @{$ATTRIBUTES{$package} //= []}, $name;

     $line -= 4;
     my $code = <<END;
 # line $line "$file"
     $line -= 4;
     my $code = <<END;
 # line $line "$file"


@@ -678,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.
 
 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', \@_) }
 
 
 =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);
 =func read_all
 
     $size = read_all($fh, my $buffer, $size);


@@ -739,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.
 
 
 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;
 =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) {
 
     my @match;
     for my $item (@$list) {


@@ -890,7 +905,8 @@ sub to_number { $_[0] // return; 0+$_[0] }
 sub to_string { $_[0] // return; "$_[0]" }
 sub to_time   {
     $_[0] // return;
 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];
 }
     return Time::Piece->strptime($_[0], '%Y-%m-%d %H:%M:%S') if !blessed $_[0];
     return $_[0];
 }