=method add_group
- $kdbx->add_group($group, %options);
+ $kdbx->add_group($group);
$kdbx->add_group(%group_attributes, %options);
Add a group to a database. This is equivalent to identifying a parent group and calling
'OPERA' => sub { load_optional('IPC::Cmd'); IPC::Cmd::can_run('opera') },
'SAFARI' => sub { load_optional('IPC::Cmd'); IPC::Cmd::can_run('safari') },
'APPDIR' => sub { load_optional('FindBin'); $FindBin::Bin },
- 'GROUP' => sub { my $p = $_[0]->parent; $p ? $p->name : undef },
+ 'GROUP' => sub { my $p = $_[0]->group; $p ? $p->name : undef },
'GROUP_PATH' => sub { $_[0]->path },
- 'GROUP_NOTES' => sub { my $p = $_[0]->parent; $p ? $p->notes : undef },
+ 'GROUP_NOTES' => sub { my $p = $_[0]->group; $p ? $p->notes : undef },
# 'GROUP_SEL'
# 'GROUP_SEL_PATH'
# 'GROUP_SEL_NOTES'
my $entries = $kdbx->entries(auto_type => 1)
->filter(sub {
- my $ata = $_->auto_type_associations->grep(sub { $_->{window} =~ $window_title })->next;
+ my ($ata) = grep { $_->{window} =~ /\Q$window_title\E/i } @{$_->auto_type_associations};
return [$_, $ata->{keystroke_sequence}] if $ata;
})
->each(sub {
=head1 QUERY
-B<TODO> - All these examples are WRONG now.
+To find things in a KDBX database, you should use a filtered iterator. If you have an iterator, such as
+returned by L</entries>, L</groups> or even L</objects> you can filter it using L<File::KDBX::Iterator/where>.
-Several methods take a I<query> as an argument (e.g. L</find_entries>). A query is just a subroutine that you
-can either write yourself or have generated for you based on either a simple expression or a declarative
-structure. It's easier to have your query generated, so I'll cover that first.
+ my $filtered_results = $kdbx->entries->where($query);
+
+A C<$query> is just a subroutine that you can either write yourself or have generated for you from either
+a L</"Simple Expression"> or L</"Declarative Syntax">. It's easier to have your query generated, so I'll cover
+that first.
=head2 Simple Expression
So a simple expression is something like what you might type into a search engine. You can generate a simple
expression query using L<File::KDBX::Util/simple_expression_query> or by passing the simple expression as
-a B<string reference> to search methods like L</find_entries>.
+a B<scalar reference> to C<where>.
To search for all entries in a database with the word "canyon" appearing anywhere in the title:
- my @entries = $kdbx->find_entries([ \'canyon', qw(title) ]);
+ my $entries = $kdbx->entries->where(\'canyon', qw[title]);
-Notice the first argument is a B<stringref>. This diambiguates a simple expression from other types of queries
+Notice the first argument is a B<scalarref>. This diambiguates a simple expression from other types of queries
covered below.
As mentioned, a simple expression can have multiple terms. This simple expression query matches any entry that
has the words "red" B<and> "canyon" anywhere in the title:
- my @entries = $kdbx->find_entries([ \'red canyon', qw(title) ]);
+ my $entries = $kdbx->entries->where(\'red canyon', qw[title]);
Each term in the simple expression must be found for an entry to match.
To search for entries with "red" in the title but B<not> "canyon", just prepend "canyon" with a minus sign:
- my @entries = $kdbx->find_entries([ \'red -canyon', qw(title) ]);
+ my $entries = $kdbx->entries->where(\'red -canyon', qw[title]);
To search over multiple fields simultaneously, just list them. To search for entries with "grocery" in the
title or notes but not "Foodland":
- my @entries = $kdbx->find_entries([ \'grocery -Foodland', qw(title notes) ]);
+ my $entries = $kdbx->entries->where(\'grocery -Foodland', qw[title notes]);
The default operator is a case-insensitive regexp match, which is fine for searching text loosely. You can use
just about any binary comparison operator that perl supports. To specify an operator, list it after the simple
expression. For example, to search for any entry that has been used at least five times:
- my @entries = $kdbx->find_entries([ \5, '>=', qw(usage_count) ]);
+ my $entries = $kdbx->entries->where(\5, '>=', qw[usage_count]);
It helps to read it right-to-left, like "usage_count is >= 5".
-If you find the disambiguating structures to be confusing, you can also the L</find_entries_simple> method as
-a more intuitive alternative. The following example is equivalent to the previous:
+If you find the disambiguating structures to be distracting or confusing, you can also the
+L<File::KDBX::Util/simple_expression_query> function as a more intuitive alternative. The following example is
+equivalent to the previous:
- my @entries = $kdbx->find_entries_simple(5, '>=', qw(usage_count));
+ my $entries = $kdbx->entries->where(simple_expression_query(5, '>=', qw[usage_count]));
-=head2 Declarative Query
+=head2 Declarative Syntax
Structuring a declarative query is similar to L<SQL::Abstract/"WHERE CLAUSES">, but you don't have to be
familiar with that module. Just learn by examples.
To search for all entries in a database titled "My Bank":
- my @entries = $kdbx->find_entries({ title => 'My Bank' });
+ my $entries = $kdbx->entries->where({ title => 'My Bank' });
-The query here is C<< { title => 'My Bank' } >>. A hashref can contain key-value pairs where the key is
-a attribute of the thing being searched for (in this case an entry) and the value is what you want the thing's
+The query here is C<< { title => 'My Bank' } >>. A hashref can contain key-value pairs where the key is an
+attribute of the thing being searched for (in this case an entry) and the value is what you want the thing's
attribute to be to consider it a match. In this case, the attribute we're using as our match criteria is
L<File::KDBX::Entry/title>, a text field. If an entry has its title attribute equal to "My Bank", it's
a match.
attributes are equal to their respective values. For example, to search for all entries with a particular URL
B<AND> username:
- my @entries = $kdbx->find_entries({
+ my $entries = $kdbx->entries->where({
url => 'https://example.com',
username => 'neo',
});
To search for entries matching I<any> criteria, just change the hashref to an arrayref. To search for entries
-with a particular URL B<OR> a particular username:
+with a particular URL B<OR> username:
- my @entries = $kdbx->find_entries([ # <-- square bracket
+ my $entries = $kdbx->entries->where([ # <-- Notice the square bracket
url => 'https://example.com',
username => 'neo',
]);
-You can user different operators to test different types of attributes. The L<File::KDBX::Entry/icon_id>
+
+
+You can use different operators to test different types of attributes. The L<File::KDBX::Entry/icon_id>
attribute is a number, so we should use a number comparison operator. To find entries using the smartphone
icon:
- my @entries = $kdbx->find_entries({
+ my $entries = $kdbx->entries->where({
icon_id => { '==', ICON_SMARTPHONE },
});
Note: L<File::KDBX::Constants/ICON_SMARTPHONE> is just a constant from L<File::KDBX::Constants>. It isn't
special to this example or to queries generally. We could have just used a literal number.
-The important thing to notice here is how we wrapped the condition in another arrayref with a single key-pair
-where the key is the name of an operator and the value is the thing to match against. The supported operators
-are:
+The important thing to notice here is how we wrapped the condition in another arrayref with a single key-value
+pair where the key is the name of an operator and the value is the thing to match against. The supported
+operators are:
=for :list
* C<eq> - String equal
* C<-false> - Boolean false
* C<-not> - Boolean false (alias for C<-false>)
* C<-defined> - Is defined
-* C<-undef> - Is not d efined
+* C<-undef> - Is not defined
* C<-empty> - Is empty
* C<-nonempty> - Is not empty
* C<-or> - Logical or
Let's see another example using an explicit operator. To find all groups except one in particular (identified
by its L<File::KDBX::Group/uuid>), we can use the C<ne> (string not equal) operator:
- my ($group, @other) = $kdbx->find_groups({
+ my $groups = $kdbx->groups->where(
uuid => {
'ne' => uuid('596f7520-6172-6520-7370-656369616c2e'),
},
- });
- if (@other) { say "Problem: there can be only one!" }
+ );
+ if (1 < $groups->count) { say "Problem: there can be only one!" }
-Note: L<File::KDBX::Util/uuid> is a little helper function to convert a UUID in its pretty form into octets.
+Note: L<File::KDBX::Util/uuid> is a little helper function to convert a UUID in its pretty form into bytes.
This helper function isn't special to this example or to queries generally. It could have been written with
a literal such as C<"\x59\x6f\x75\x20\x61...">, but that's harder to read.
Notice we searched for groups this time. Finding groups works exactly the same as it does for entries.
+Notice also that we didn't wrap the query in hashref curly-braces or arrayref square-braces. Those are
+optional. By default it will only match ALL attributes (as if there were curly-braces), but it doesn't matter
+if there is only one attribute so it's fine to rely on the implicit behavior.
+
Testing the truthiness of an attribute is a little bit different because it isn't a binary operation. To find
all entries with the password quality check disabled:
- my @entries = $kdbx->find_entries({ '!' => 'quality_check' });
+ my $entries = $kdbx->entries->where('!' => 'quality_check');
This time the string after the operator is the attribute name rather than a value to compare the attribute
against. To test that a boolean value is true, use the C<!!> operator (or C<-true> if C<!!> seems a little too
weird for your taste):
- my @entries = $kdbx->find_entries({ '!!' => 'quality_check' });
- my @entries = $kdbx->find_entries({ -true => 'quality_check' });
+ my $entries = $kdbx->entries->where('!!' => 'quality_check');
+ my $entries = $kdbx->entries->where(-true => 'quality_check');
Yes, there is also a C<-false> and a C<-not> if you prefer one of those over C<!>. C<-false> and C<-not>
(along with C<-true>) are also special in that you can use them to invert the logic of a subquery. These are
logically equivalent:
- my @entries = $kdbx->find_entries([ -not => { title => 'My Bank' } ]);
- my @entries = $kdbx->find_entries({ title => { 'ne' => 'My Bank' } });
+ my $entries = $kdbx->entries->where(-not => { title => 'My Bank' });
+ my $entries = $kdbx->entries->where(title => { 'ne' => 'My Bank' });
These special operators become more useful when combined with two more special operators: C<-and> and C<-or>.
With these, it is possible to construct more interesting queries with groups of logic. For example:
- my @entries = $kdbx->find_entries({
+ my $entries = $kdbx->entries->where({
title => { '=~', qr/bank/ },
-not => {
-or => {
});
In English, find entries where the word "bank" appears anywhere in the title but also do not have either the
-word "business" in the notes or is using the full trashcan icon.
+word "business" in the notes or are using the full trashcan icon.
=head2 Subroutine Query
Lastly, as mentioned at the top, you can ignore all this and write your own subroutine. Your subroutine will
-be called once for each thing being searched over. The single argument is the search candidate. The subroutine
-should match the candidate against whatever criteria you want and return true if it matches. The C<find_*>
-methods collect all matching things and return them.
+be called once for each object being searched over. The subroutine should match the candidate against whatever
+criteria you want and return true if it matches or false to skip. To do this, just pass your subroutine
+coderef to C<where>.
-For example, to find all entries in the database titled "My Bank":
+For example, these are all equivalent to find all entries in the database titled "My Bank":
- my @entries = $kdbx->find_entries(sub { shift->title eq 'My Bank' });
- # logically the same as this declarative structure:
- my @entries = $kdbx->find_entries({ title => 'My Bank' });
- # as well as this simple expression:
- my @entries = $kdbx->find_entries([ \'My Bank', 'eq', qw{title} ]);
+ my $entries = $kdbx->entries->where(\'"My Bank"', 'eq', qw[title]); # simple expression
+ my $entries = $kdbx->entries->where(title => 'My Bank'); # declarative syntax
+ my $entries = $kdbx->entries->where(sub { $_->title eq 'My Bank' }); # subroutine query
This is a trivial example, but of course your subroutine can be arbitrarily complex.
use Encode qw(encode);
use File::KDBX::Constants qw(:history :icon);
use File::KDBX::Error;
-use File::KDBX::Util qw(:class :coercion :function :uri generate_uuid load_optional);
+use File::KDBX::Util qw(:class :coercion :erase :function :uri generate_uuid load_optional);
use Hash::Util::FieldHash;
use List::Util qw(first sum0);
-use Ref::Util qw(is_coderef is_plain_hashref);
+use Ref::Util qw(is_coderef is_hashref is_plain_hashref);
use Scalar::Util qw(looks_like_number);
use Storable qw(dclone);
use Time::Piece;
],
}
+=attr auto_type_enabled
+
+Whether or not the entry is eligible to be matched for auto-typing.
+
+=attr auto_type_data_transfer_obfuscation
+
+TODO
+
+=attr auto_type_default_sequence
+
+The default auto-type keystroke sequence.
+
+=attr auto_type_associations
+
+An array of window title / keystroke sequence associations.
+
=attr previous_parent_group
128-bit UUID identifying a group within the database.
has usage_count => 0, store => 'times', coerce => \&to_number;
has location_changed => sub { gmtime }, store => 'times', coerce => \&to_time;
+# has 'auto_type.auto_type_enabled' => true, coerce => \&to_bool;
+has 'auto_type_data_transfer_obfuscation' => 0, path => 'auto_type.data_transfer_obfuscation',
+ coerce => \&to_number;
+has 'auto_type_default_sequence' => '{USERNAME}{TAB}{PASSWORD}{ENTER}',
+ path => 'auto_type.default_sequence', coerce => \&to_string;
+has 'auto_type_associations' => [], path => 'auto_type.associations';
+
my %ATTRS_STRINGS = (
title => 'Title',
username => 'UserName',
*{"expanded_${attr}"} = sub { shift->expanded_string_value($string_key, @_) };
}
-my @ATTRS = qw(uuid custom_data history);
+my @ATTRS = qw(uuid custom_data history auto_type_enabled);
sub _set_nonlazy_attributes {
my $self = shift;
$self->$_ for @ATTRS, keys %ATTRS_STRINGS, list_attributes(ref $self);
=method string_value
- $string = $entry->string_value;
+ $string = $entry->string_value($string_key);
-Access a string value directly. Returns C<undef> if the string is not set.
+Access a string value directly. The arguments are the same as for L</string>. Returns C<undef> if the string
+is not set or is currently memory-protected. This is just a shortcut for:
+
+ my $string = do {
+ my $s = $entry->string(...);
+ defined $s ? $s->{value} : undef;
+ };
=cut
sub expanded_string_value {
my $self = shift;
- my $str = $self->string_value(@_) // return undef;
+ my $str = $self->string_peek(@_) // return undef;
+ my $cleanup = erase_scoped $str;
return $self->_expand_string($str);
}
return join($delim, @strings);
}
+=method string_peek
+
+ $string = $entry->string_peek($string_key);
+
+Same as L</string_value> but can also retrieve the value from protected-memory if the value is currently
+protected.
+
+=cut
+
sub string_peek {
my $self = shift;
my $string = $self->string(@_);
return defined $string->{value} ? $string->{value} : $self->kdbx->peek($string);
}
-sub password_peek { $_[0]->string_peek('Password') }
+##############################################################################
+
+sub add_auto_type_association {
+ my $self = shift;
+ my $association = shift;
+ push @{$self->auto_type_associations}, $association;
+}
+
+sub expand_keystroke_sequence {
+ my $self = shift;
+ my $association = shift;
+
+ my $keys = is_hashref($association) && exists $association->{keystroke_sequence} ?
+ $association->{keystroke_sequence} : defined $association ? $association : '';
+
+ $keys = $self->auto_type_default_sequence if !$keys;
+ # TODO - Fall back to getting default sequence from parent group, which probably means we shouldn't be
+ # setting a default value in the entry..
+
+ return $self->_expand_string($keys);
+}
##############################################################################
sub searching_enabled {
my $self = shift;
- my $parent = $self->parent;
+ my $parent = $self->group;
return $parent->effective_enable_searching if $parent;
return true;
}
sub auto_type_enabled {
my $self = shift;
+ $self->auto_type->{enabled} = to_bool(shift) if @_;
+ $self->auto_type->{enabled} //= true;
return false if !$self->auto_type->{enabled};
- my $parent = $self->parent;
+ return true if !$self->is_connected;
+ my $parent = $self->group;
return $parent->effective_enable_auto_type if $parent;
return true;
}
sub current_entry {
my $self = shift;
- my $group = $self->parent;
+ my $group = $self->group;
if ($group) {
my $id = $self->uuid;
my $sequence = $self->default_auto_type_sequence;
return $sequence if defined $sequence;
- my $parent = $self->parent or return '{USERNAME}{TAB}{PASSWORD}{ENTER}';
+ my $parent = $self->group or return '{USERNAME}{TAB}{PASSWORD}{ENTER}';
return $parent->effective_default_auto_type_sequence;
}
my $enabled = $self->enable_auto_type;
return $enabled if defined $enabled;
- my $parent = $self->parent or return true;
+ my $parent = $self->group or return true;
return $parent->effective_enable_auto_type;
}
my $enabled = $self->enable_searching;
return $enabled if defined $enabled;
- my $parent = $self->parent or return true;
+ my $parent = $self->group or return true;
return $parent->effective_enable_searching;
}
$item = $iterator->next([\'simple expression', @fields]);
Get the next item or C<undef> if there are no more items. If a query is passed, get the next matching item,
-discarding any items before the matching item that do not match. Example:
+discarding any unmatching items before the matching item. Example:
my $item = $iterator->next(sub { $_->label =~ /Gym/ });
=cut
-sub _create_query {
- my $self = shift;
- 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, @_);
- }
-}
-
sub next {
my $self = shift;
my $code = shift or return $self->();
- $code = $self->_create_query($code, @_);
+ $code = query_any($code, @_);
while (defined (local $_ = $self->())) {
return $_ if $code->($_);
items. Or pass a coderef to be called once per item, in order. The item is passed as the first argument to the
given subroutine and is also available as C<$_>.
+B<NOTE:> This method drains the iterator completely, leaving it empty. See L</CAVEATS>.
+
=cut
sub each {
return $self;
}
-=method limit
-
- \&iterator = $iterator->limit($count);
-
-Get a new iterator draining from an existing iterator but providing only a limited number of items.
-
-=cut
-
-sub limit { shift->head(@_) }
-
=method grep
+=method where
+
\&iterator = $iterator->grep(\&query);
\&iterator = $iterator->grep([\'simple expression', @fields]);
=cut
+sub where { shift->grep(@_) }
+
sub grep {
my $self = shift;
- my $code = shift;
-
- $code = $self->_create_query($code, @_);
+ my $code = query_any(@_);
ref($self)->new(sub {
while (defined (local $_ = $self->())) {
});
}
-=method filter
-
- \&iterator = $iterator->filter(\&query);
- \&iterator = $iterator->filter([\'simple expression', @fields]);
-
-See L<Iterator::Simple/"ifilter $iterable, sub{ CODE }">.
-
-=cut
-
-sub filter {
- my $self = shift;
- my $code = shift;
- return $self->SUPER::filter($self->_create_query($code, @_));
-}
-
-=method sort_by
-
=method order_by
\&iterator = $iterator->sort_by($field, %options);
C<sort_by> and C<order_by> are aliases.
-B<NOTE:> This method drains the iterator completely but adds items back onto the buffer, so the iterator is
-still usable afterward. Nevertheless, you mustn't call this on an infinite iterator or it will run until
-available memory is depleted.
+B<NOTE:> This method drains the iterator completely and places the sorted items onto the buffer. See
+L</CAVEATS>.
=cut
-sub sort_by { shift->order_by(@_) }
-sub nsort_by { shift->norder_by(@_) }
-
sub order_by {
my $self = shift;
my $field = shift;
return $self;
}
-=method nsort_by
+=method sort_by
+
+Alias for L</order_by>.
+
+=cut
+
+sub sort_by { shift->order_by(@_) }
=method norder_by
\&iterator = $iterator->nsort_by(\&get_value, %options);
Get a new iterator draining from an existing iterator but providing items sorted by an object field. Sorting
-is done numerically using C<< <=> >>. The C<\&get_value> subroutine is called once for each item and should
-return a numerical value. Options:
+is done numerically using C<< <=> >>. The C<\&get_value> subroutine or C<$field> accessor is called once for
+each item and should return a numerical value. Options:
=for :list
* C<ascending> - Order ascending if true, descending otherwise (default: true)
C<nsort_by> and C<norder_by> are aliases.
-B<NOTE:> This method drains the iterator completely but adds items back onto the buffer, so the iterator is
-still usable afterward. Nevertheless, you mustn't call this on an infinite iterator or it will run until
-available memory is depleted.
+B<NOTE:> This method drains the iterator completely and places the sorted items onto the buffer. See
+L</CAVEATS>.
=cut
return $self;
}
+=method nsort_by
+
+Alias for L</norder_by>.
+
+=cut
+
+sub nsort_by { shift->norder_by(@_) }
+
+=method limit
+
+ \&iterator = $iterator->limit($count);
+
+Get a new iterator draining from an existing iterator but providing only a limited number of items.
+
+C<limit> as an alias for L<Iterator::Simple/"$iterator->head($count)">.
+
+=cut
+
+sub limit { shift->head(@_) }
+
=method to_array
\@array = $iterator->to_array;
Get the rest of the items from an iterator as an arrayref.
-B<NOTE:> This method drains the iterator completely, leaving the iterator empty. You mustn't call this on an
-infinite iterator or it will run until available memory is depleted.
+B<NOTE:> This method drains the iterator completely, leaving it empty. See L</CAVEATS>.
=cut
=method count
-=method size
-
$size = $iterator->count;
Count the rest of the items from an iterator.
-B<NOTE:> This method drains the iterator completely but adds items back onto the buffer, so the iterator is
-still usable afterward. Nevertheless, you mustn't call this on an infinite iterator or it will run until
-available memory is depleted.
+B<NOTE:> This method drains the iterator completely but restores it to its pre-drained state. See L</CAVEATS>.
=cut
-sub size {
+sub count {
my $self = shift;
my $items = $self->to_array;
return scalar @$items;
}
-sub count { shift->size }
+=method size
+
+Alias for L</count>.
+
+=cut
+
+sub size { shift->count }
+
+##############################################################################
sub TO_JSON { $_[0]->to_array }
=head1 SYNOPSIS
+ my $kdbx = File::KDBX->load('database.kdbx', 'masterpw');
+
$kdbx->entries
- ->grep(sub { $_->title =~ /bank/i })
- ->sort_by('title')
+ ->where(sub { $_->title =~ /bank/i })
+ ->order_by('title')
->limit(5)
->each(sub {
say $_->title;
=head1 DESCRIPTION
A buffered iterator compatible with and expanding upon L<Iterator::Simple>, this provides an easy way to
-navigate a L<File::KDBX> database.
+navigate a L<File::KDBX> database. The documentation for B<Iterator::Simple> documents functions and methods
+supported but this iterator that are not documented here, so consider that additional reading.
=head2 Buffer
buffer is drained before the iterator function is. Using L</unget> is equivalent to calling the iterator with
arguments, and as L</next> is equivalent to calling the iterator without arguments.
+=head1 CAVEATS
+
+Some methods attempt to drain the iterator completely before returning. For obvious reasons, this won't work
+for infinite iterators because your computer doesn't have infinite memory. This isn't a practical issue with
+B<File::KDBX> lists which are always finite -- unless you do something weird like force a child group to be
+its own ancestor -- but I'm noting it here as a potential issue if you use this iterator class for other
+things (which you probably shouldn't do).
+
=cut
=method clone
- $object_copy = $object->clone;
+ $object_copy = $object->clone(%options);
$object_copy = File::KDBX::Object->new($object);
Make a clone of an object. By default the clone is indeed an exact copy that is connected to the same database
-but not actually included in the object tree (i.e. it has no parent). Some options are allowed to get
+but not actually included in the object tree (i.e. it has no parent group). Some options are allowed to get
different effects:
=for :list
if ($args{relabel} and my $label = $self->label) {
$copy->label("$label - Copy");
}
- if ($args{parent} and my $parent = $self->parent) {
+ if ($args{parent} and my $parent = $self->group) {
$parent->add_object($copy);
}
=method group
-=method parent
-
- $group = $object->group;
- # OR equivalently
- $group = $object->parent;
-
- $object->group($new_parent);
+ $parent_group = $object->group;
+ $object->group($parent_group);
Get or set the parent group to which an object belongs or C<undef> if it belongs to no group.
return $group;
}
-sub parent { shift->group(@_) }
-
sub _set_group {
my $self = shift;
if (my $parent = shift) {
# try leaf to root
my @path;
- my $o = $self;
- while ($o = $o->parent) {
- unshift @path, $o;
- last if $base_addr == Hash::Util::FieldHash::id($o);
+ my $object = $self;
+ while ($object = $object->group) {
+ unshift @path, $object;
+ last if $base_addr == Hash::Util::FieldHash::id($object);
}
return \@path if @path && ($base_addr == Hash::Util::FieldHash::id($path[0]) || $path[0]->is_root);
sub remove {
my $self = shift;
- my $parent = $self->parent;
+ my $parent = $self->group;
$parent->remove_object($self, @_) if $parent;
$self->_set_group(undef);
return $self;
sub recycle {
my $self = shift;
- return $self->parent($self->kdbx->recycle_bin);
+ return $self->group($self->kdbx->recycle_bin);
}
=method recycle_or_remove
sub is_recycled {
my $self = shift;
eval { $self->kdbx } or return FALSE;
- return !!($self->parent && any { $_->is_recycle_bin } @{$self->lineage});
+ return !!($self->group && any { $_->is_recycle_bin } @{$self->lineage});
}
##############################################################################
* L<File::KDBX::Entry/add_historical_entry>
It is possible to copy or move objects between databases, but B<DO NOT> include the same object in more
-than one database at once or there could some strange aliasing effects (i.e. changes in one database might
+than one database at once or there could be some strange aliasing effects (i.e. changes in one database might
effect another in unexpected ways). This could lead to difficult-to-debug problems. It is similarly not safe
or valid to add the same object multiple times to the same database. For example:
$another_kdbx->add_entry($entry->clone);
# OR move an existing entry from one database to another:
- $kdbx->add_entry($entry->remove);
+ $another_kdbx->add_entry($entry->remove);
=cut
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)],
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}
: qq{$member = \$_[1] if \$#_;};
}
+ push @{$ATTRIBUTES{$package} //= []}, $name;
$line -= 4;
my $code = <<END;
# line $line "$file"
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);
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) {
is $entry->username, 'bar', 'username is set correctly as the UserName string';
cmp_deeply $entry, noclass({
- auto_type => {},
+ auto_type => {
+ associations => [],
+ data_transfer_obfuscation => 0,
+ default_sequence => "{USERNAME}{TAB}{PASSWORD}{ENTER}",
+ enabled => bool(1),
+ },
background_color => "",
binaries => {},
custom_data => {},
or diag explain $entry2->url;
};
+subtest 'Auto-type' => sub {
+ my $kdbx = File::KDBX->new;
+
+ my $entry = $kdbx->add_entry(title => 'Meh');
+ $entry->add_auto_type_association({
+ window => 'Boring Store',
+ keystroke_sequence => 'yeesh',
+ });
+ $entry->add_auto_type_association({
+ window => 'Friendly Bank',
+ keystroke_sequence => 'blah',
+ });
+
+ my $window_title = 'Friendly';
+ my $entries = $kdbx->entries(auto_type => 1)
+ ->filter(sub {
+ my ($ata) = grep { $_->{window} =~ /\Q$window_title\E/i } @{$_->auto_type_associations};
+ return [$_, $ata->{keystroke_sequence} || $_->auto_type_default_sequence] if $ata;
+ });
+ cmp_ok $entries->count, '==', 1, 'Find auto-type window association';
+
+ (undef, my $keys) = @{$entries->next};
+ is $keys, 'blah', 'Select the correct association';
+};
+
done_testing;
projects / chaz / p5-File-KDBX / commitdiff
