1 package File
::KDBX
::Group
;
2 # ABSTRACT: A KDBX database group
7 use Devel
::GlobalDestruction
;
8 use File
::KDBX
::Constants
qw(:bool :icon :iteration);
10 use File
::KDBX
::Iterator
;
11 use File
::KDBX
::Util
qw(:assert :class :coercion generate_uuid);
12 use Hash
::Util
::FieldHash
;
13 use List
::Util
qw(any sum0);
14 use Ref
::Util
qw(is_coderef is_ref);
15 use Scalar
::Util
qw(blessed);
20 extends
'File::KDBX::Object';
22 our $VERSION = '0.901'; # VERSION
25 # has uuid => sub { generate_uuid(printable => 1) };
26 has name
=> '', coerce
=> \
&to_string
;
27 has notes
=> '', coerce
=> \
&to_string
;
28 has tags
=> '', coerce
=> \
&to_string
;
29 has icon_id
=> ICON_FOLDER
, coerce
=> \
&to_icon_constant
;
30 has custom_icon_uuid
=> undef, coerce
=> \
&to_uuid
;
31 has is_expanded
=> false
, coerce
=> \
&to_bool
;
32 has default_auto_type_sequence
=> '', coerce
=> \
&to_string
;
33 has enable_auto_type
=> undef, coerce
=> \
&to_tristate
;
34 has enable_searching
=> undef, coerce
=> \
&to_tristate
;
35 has last_top_visible_entry
=> undef, coerce
=> \
&to_uuid
;
36 # has custom_data => {};
37 has previous_parent_group
=> undef, coerce
=> \
&to_uuid
;
42 has last_modification_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
43 has creation_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
44 has last_access_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
45 has expiry_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
46 has expires
=> false
, store
=> 'times', coerce
=> \
&to_bool
;
47 has usage_count
=> 0, store
=> 'times', coerce
=> \
&to_number
;
48 has location_changed
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
50 my @ATTRS = qw(uuid custom_data entries groups);
51 sub _set_nonlazy_attributes
{
53 $self->$_ for @ATTRS, list_attributes
(ref $self);
58 if (@_ || !defined $self->{uuid
}) {
59 my %args = @_ % 2 == 1 ? (uuid
=> shift, @_) : @_;
60 my $old_uuid = $self->{uuid
};
61 my $uuid = $self->{uuid
} = delete $args{uuid
} // generate_uuid
;
62 $self->_signal('uuid.changed', $uuid, $old_uuid) if defined $old_uuid;
67 ##############################################################################
72 my $entries = $self->{entries
} //= [];
73 if (@$entries && !blessed
($entries->[0])) {
74 @$entries = map { $self->_wrap_entry($_, $self->kdbx) } @$entries;
76 assert
{ !any
{ !blessed
$_ } @$entries };
85 my $searching = delete $args{searching
};
86 my $auto_type = delete $args{auto_type
};
87 my $history = delete $args{history
};
89 my $groups = $self->groups_deeply(%args);
92 return File
::KDBX
::Iterator-
>new(sub {
94 while (my $group = $groups->next) {
95 next if $searching && !$group->effective_enable_searching;
96 next if $auto_type && !$group->effective_enable_auto_type;
97 @entries = @{$group->entries};
98 @entries = grep { $_->auto_type->{enabled
} } @entries if $auto_type;
99 @entries = map { ($_, @{$_->history}) } @entries if $history;
110 my $entry = @_ % 2 == 1 ? shift : undef;
113 my $kdbx = delete $args{kdbx
} // eval { $self->kdbx };
115 $entry = $self->_wrap_entry($entry // [%args]);
117 $entry->kdbx($kdbx) if $kdbx;
119 push @{$self->{entries
} ||= []}, $entry->remove;
120 return $entry->_set_group($self)->_signal('added', $self);
126 my $uuid = is_ref
($_[0]) ? $self->_wrap_entry(shift)->uuid : shift;
128 my $objects = $self->{entries
};
129 for (my $i = 0; $i < @$objects; ++$i) {
130 my $object = $objects->[$i];
131 next if $uuid ne $object->uuid;
132 $object->_set_group(undef);
133 $object->_signal('removed') if $args{signal
} // 1;
134 return splice @$objects, $i, 1;
138 ##############################################################################
143 my $groups = $self->{groups
} //= [];
144 if (@$groups && !blessed
($groups->[0])) {
145 @$groups = map { $self->_wrap_group($_, $self->kdbx) } @$groups;
147 assert
{ !any
{ !blessed
$_ } @$groups };
156 my @groups = ($args{inclusive
} // 1) ? $self : @{$self->groups};
157 my $algo = lc($args{algorithm
} || 'ids');
159 if ($algo eq ITERATION_DFS
) {
161 return File
::KDBX
::Iterator-
>new(sub {
162 my $next = shift @groups or return;
163 if (!$visited{Hash
::Util
::FieldHash
::id
($next)}++) {
164 while (my @children = @{$next->groups}) {
165 unshift @groups, @children, $next;
166 $next = shift @groups;
167 $visited{Hash
::Util
::FieldHash
::id
($next)}++;
173 elsif ($algo eq ITERATION_BFS
) {
174 return File
::KDBX
::Iterator-
>new(sub {
175 my $next = shift @groups or return;
176 push @groups, @{$next->groups};
180 return File
::KDBX
::Iterator-
>new(sub {
181 my $next = shift @groups or return;
182 unshift @groups, @{$next->groups};
187 sub _kpx_groups
{ shift-
>groups(@_) }
192 my $group = @_ % 2 == 1 ? shift : undef;
195 my $kdbx = delete $args{kdbx
} // eval { $self->kdbx };
197 $group = $self->_wrap_group($group // [%args]);
199 $group->kdbx($kdbx) if $kdbx;
201 push @{$self->{groups
} ||= []}, $group->remove;
202 return $group->_set_group($self)->_signal('added', $self);
208 my $uuid = is_ref
($_[0]) ? $self->_wrap_group(shift)->uuid : shift;
210 my $objects = $self->{groups
};
211 for (my $i = 0; $i < @$objects; ++$i) {
212 my $object = $objects->[$i];
213 next if $uuid ne $object->uuid;
214 $object->_set_group(undef);
215 $object->_signal('removed') if $args{signal
} // 1;
216 return splice @$objects, $i, 1;
220 ##############################################################################
227 my $searching = delete $args{searching
};
228 my $auto_type = delete $args{auto_type
};
229 my $history = delete $args{history
};
231 my $groups = $self->groups_deeply(%args);
234 return File
::KDBX
::Iterator-
>new(sub {
236 while (my $group = $groups->next) {
237 next if $searching && !$group->effective_enable_searching;
238 next if $auto_type && !$group->effective_enable_auto_type;
239 @entries = @{$group->entries};
240 @entries = grep { $_->auto_type->{enabled
} } @entries if $auto_type;
241 @entries = map { ($_, @{$_->history}) } @entries if $history;
253 if ($obj->isa('File::KDBX::Entry')) {
254 $self->add_entry($obj);
256 elsif ($obj->isa('File::KDBX::Group')) {
257 $self->add_group($obj);
265 my $blessed = blessed
($object);
266 return $self->remove_group($object, @_) if $blessed && $object->isa('File::KDBX::Group');
267 return $self->remove_entry($object, @_) if $blessed && $object->isa('File::KDBX::Entry');
268 return $self->remove_group($object, @_) || $self->remove_entry($object, @_);
271 ##############################################################################
274 sub effective_default_auto_type_sequence
{
276 my $sequence = $self->default_auto_type_sequence;
277 return $sequence if defined $sequence;
279 my $parent = $self->group or return '{USERNAME}{TAB}{PASSWORD}{ENTER}';
280 return $parent->effective_default_auto_type_sequence;
284 sub effective_enable_auto_type
{
286 my $enabled = $self->enable_auto_type;
287 return $enabled if defined $enabled;
289 my $parent = $self->group or return true
;
290 return $parent->effective_enable_auto_type;
294 sub effective_enable_searching
{
296 my $enabled = $self->enable_searching;
297 return $enabled if defined $enabled;
299 my $parent = $self->group or return true
;
300 return $parent->effective_enable_searching;
303 ##############################################################################
308 return @{$self->groups} == 0 && @{$self->entries} == 0;
314 my $kdbx = eval { $self->kdbx } or return FALSE
;
315 return Hash
::Util
::FieldHash
::id
($kdbx->root) == Hash
::Util
::FieldHash
::id
($self);
321 my $kdbx = eval { $self->kdbx } or return FALSE
;
322 my $group = $kdbx->recycle_bin;
323 return $group && Hash
::Util
::FieldHash
::id
($group) == Hash
::Util
::FieldHash
::id
($self);
327 sub is_entry_templates
{
329 my $kdbx = eval { $self->kdbx } or return FALSE
;
330 my $group = $kdbx->entry_templates;
331 return $group && Hash
::Util
::FieldHash
::id
($group) == Hash
::Util
::FieldHash
::id
($self);
335 sub is_last_selected
{
337 my $kdbx = eval { $self->kdbx } or return FALSE
;
338 my $group = $kdbx->last_selected;
339 return $group && Hash
::Util
::FieldHash
::id
($group) == Hash
::Util
::FieldHash
::id
($self);
343 sub is_last_top_visible
{
345 my $kdbx = eval { $self->kdbx } or return FALSE
;
346 my $group = $kdbx->last_top_visible;
347 return $group && Hash
::Util
::FieldHash
::id
($group) == Hash
::Util
::FieldHash
::id
($self);
353 return $self->name if $self->is_root;
354 my $lineage = $self->lineage or return;
355 my @parts = (@$lineage, $self);
357 return join('.', map { $_->name } @parts);
363 return sum0
map { $_->size } @{$self->groups}, @{$self->entries};
367 sub depth
{ $_[0]->is_root ? 0 : (scalar @{$_[0]->lineage || []} || -1) }
372 return $self->SUPER::_signal
("group.$type", @_);
378 $self->last_modification_time($time);
379 $self->last_access_time($time);
382 sub label
{ shift-
>name(@_) }
384 ### Name of the parent attribute expected to contain the object
385 sub _parent_container
{ 'groups' }
397 File::KDBX::Group - A KDBX database group
405 A group in a KDBX database is a type of object that can contain entries and other groups.
407 There is also some metadata associated with a group. Each group in a database is identified uniquely by
408 a UUID. An entry can also have an icon associated with it, and there are various timestamps. Take a look at
409 the attributes to see what's available.
415 The human-readable name of the group.
419 Free form text string associated with the group.
423 Whether or not subgroups are visible when listed for user selection.
425 =head2 default_auto_type_sequence
427 The default auto-type keystroke sequence, inheritable by entries and subgroups.
429 =head2 enable_auto_type
431 Whether or not the entry is eligible to be matched for auto-typing, inheritable by entries and subgroups.
433 =head2 enable_searching
435 Whether or not entries within the group can show up in search results, inheritable by subgroups.
437 =head2 last_top_visible_entry
439 The UUID of the entry visible at the top of the list.
443 Array of entries contained within the group.
447 Array of subgroups contained within the group.
453 \@entries = $group->entries;
455 Get an array of direct child entries within a group.
457 =head2 entries_deeply
459 \&iterator = $kdbx->entries_deeply(%options);
461 Get an L<File::KDBX::Iterator> over I<entries> within a group. Supports the same options as L</groups>,
468 C<auto_type> - Only include entries with auto-type enabled (default: false, include all)
472 C<searching> - Only include entries within groups with searching enabled (default: false, include all)
476 C<history> - Also include historical entries (default: false, include only current entries)
482 $entry = $group->add_entry($entry);
483 $entry = $group->add_entry(%entry_attributes);
485 Add an entry to a group. If C<$entry> already has a parent group, it will be removed from that group before
486 being added to C<$group>.
490 $entry = $group->remove_entry($entry);
491 $entry = $group->remove_entry($entry_uuid);
493 Remove an entry from a group's array of entries. Returns the entry removed or C<undef> if nothing removed.
497 \@groups = $group->groups;
499 Get an array of direct subgroups within a group.
503 \&iterator = $group->groups_deeply(%options);
505 Get an L<File::KDBX::Iterator> over I<groups> within a groups, deeply. Options:
511 C<inclusive> - Include C<$group> itself in the results (default: true)
515 C<algorithm> - Search algorithm, one of C<ids>, C<bfs> or C<dfs> (default: C<ids>)
521 $new_group = $group->add_group($new_group);
522 $new_group = $group->add_group(%group_attributes);
524 Add a group to a group. If C<$new_group> already has a parent group, it will be removed from that group before
525 being added to C<$group>.
529 $removed_group = $group->remove_group($group);
530 $removed_group = $group->remove_group($group_uuid);
532 Remove a group from a group's array of subgroups. Returns the group removed or C<undef> if nothing removed.
534 =head2 objects_deeply
536 \&iterator = $groups->objects_deeply(%options);
538 Get an L<File::KDBX::Iterator> over I<objects> within a group, deeply. Groups and entries are considered
539 objects, so this is essentially a combination of L</groups> and L</entries>. This won't often be useful, but
540 it can be convenient for maintenance tasks. This method takes the same options as L</groups> and L</entries>.
544 $new_entry = $group->add_object($new_entry);
545 $new_group = $group->add_object($new_group);
547 Add an object (either a L<File::KDBX::Entry> or a L<File::KDBX::Group>) to a group. This is the generic
548 equivalent of the object forms of L</add_entry> and L</add_group>.
552 $group->remove_object($entry);
553 $group->remove_object($group);
555 Remove an object (either a L<File::KDBX::Entry> or a L<File::KDBX::Group>) from a group. This is the generic
556 equivalent of the object forms of L</remove_entry> and L</remove_group>.
558 =head2 effective_default_auto_type_sequence
560 $text = $group->effective_default_auto_type_sequence;
562 Get the value of L</default_auto_type_sequence>, if set, or get the inherited effective default auto-type
563 sequence of the parent.
565 =head2 effective_enable_auto_type
567 $text = $group->effective_enable_auto_type;
569 Get the value of L</enable_auto_type>, if set, or get the inherited effective auto-type enabled value of the
572 =head2 effective_enable_searching
574 $text = $group->effective_enable_searching;
576 Get the value of L</enable_searching>, if set, or get the inherited effective searching enabled value of the
581 $bool = $group->is_empty;
583 Get whether or not the group is empty (has no subgroups or entries).
587 $bool = $group->is_root;
589 Determine if a group is the root group of its connected database.
591 =head2 is_recycle_bin
593 $bool = $group->is_recycle_bin;
595 Get whether or not a group is the recycle bin of its connected database.
597 =head2 is_entry_templates
599 $bool = $group->is_entry_templates;
601 Get whether or not a group is the group containing entry template in its connected database.
603 =head2 is_last_selected
605 $bool = $group->is_last_selected;
607 Get whether or not a group is the prior selected group of its connected database.
609 =head2 is_last_top_visible
611 $bool = $group->is_last_top_visible;
613 Get whether or not a group is the latest top visible group of its connected database.
617 $string = $group->path;
619 Get a string representation of a group's lineage. This is used as the substitution value for the
620 C<{GROUP_PATH}> placeholder. See L<File::KDBX::Entry/Placeholders>.
622 For a root group, the path is simply the name of the group. For deeper groups, the path is a period-separated
623 sequence of group names between the root group and C<$group>, including C<$group> but I<not> the root group.
624 In other words, paths of deeper groups leave the root group name out.
627 -> Root # path is "Root"
628 -> Foo # path is "Foo"
629 -> Bar # path is "Foo.Bar"
631 Yeah, it doesn't make much sense to me, either, but this matches the behavior of KeePass.
635 $size = $group->size;
637 Get the size (in bytes) of a group, including the size of all subroups and entries, if any.
641 $depth = $group->depth;
643 Get the depth of a group within a database. The root group is at depth 0, its direct children are at depth 1,
644 etc. A group not in a database tree structure returns a depth of -1.
646 =for Pod::Coverage times
650 Please report any bugs or feature requests on the bugtracker website
651 L<https://github.com/chazmcgarvey/File-KDBX/issues>
653 When submitting a bug or request, please include a test-file or a
654 patch to an existing test-file that illustrates the bug or desired
659 Charles McGarvey <ccm@cpan.org>
661 =head1 COPYRIGHT AND LICENSE
663 This software is copyright (c) 2022 by Charles McGarvey.
665 This is free software; you can redistribute it and/or modify it under
666 the same terms as the Perl 5 programming language system itself.