X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-File-KDBX;a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FUtil.pm;h=9c4e6f63cea884dcde6fd14e2e4a51c45fcdd51c;hp=5b12e9dd1ea525135e29611a258537b33d4193a7;hb=8ccefe1cedea9b0886a44ad096aa5710528eaac7;hpb=00078cf200c23f392322f4fdc29e4f44ddf73f41 diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm index 5b12e9d..9c4e6f6 100644 --- 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)], @@ -442,11 +442,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} @@ -460,6 +462,7 @@ sub has { : qq{$member = \$_[1] if \$#_;}; } + push @{$ATTRIBUTES{$package} //= []}, $name; $line -= 4; my $code = < for examples. sub query { _query(undef, '-or', \@_) } +=func query_any + +Get either a L or L, 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); @@ -739,23 +762,11 @@ sub recurse_limit { Execute a linear search over an array of records using a L. A "record" is usually a hash. -This is the search engine described with many examples at L. - =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) {