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.903'; # 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->all_groups(%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->all_groups(%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.
411 A B<File::KDBX::Group> is a subclass of L<File::KDBX::Object>. View its documentation to see other attributes
412 and methods available on groups.
418 The human-readable name of the group.
422 Free form text string associated with the group.
426 Whether or not subgroups are visible when listed for user selection.
428 =head2 default_auto_type_sequence
430 The default auto-type keystroke sequence, inheritable by entries and subgroups.
432 =head2 enable_auto_type
434 Whether or not the entry is eligible to be matched for auto-typing, inheritable by entries and subgroups.
436 =head2 enable_searching
438 Whether or not entries within the group can show up in search results, inheritable by subgroups.
440 =head2 last_top_visible_entry
442 The UUID of the entry visible at the top of the list.
446 Array of entries contained within the group.
450 Array of subgroups contained within the group.
456 \@entries = $group->entries;
458 Get an array of direct child entries within a group.
462 \&iterator = $kdbx->all_entries(%options);
464 Get an L<File::KDBX::Iterator> over I<entries> within a group. Supports the same options as L</groups>,
471 C<auto_type> - Only include entries with auto-type enabled (default: false, include all)
475 C<searching> - Only include entries within groups with searching enabled (default: false, include all)
479 C<history> - Also include historical entries (default: false, include only current entries)
485 $entry = $group->add_entry($entry);
486 $entry = $group->add_entry(%entry_attributes);
488 Add an entry to a group. If C<$entry> already has a parent group, it will be removed from that group before
489 being added to C<$group>.
493 $entry = $group->remove_entry($entry);
494 $entry = $group->remove_entry($entry_uuid);
496 Remove an entry from a group's array of entries. Returns the entry removed or C<undef> if nothing removed.
500 \@groups = $group->groups;
502 Get an array of direct subgroups within a group.
506 \&iterator = $group->all_groups(%options);
508 Get an L<File::KDBX::Iterator> over I<groups> within a groups, deeply. Options:
514 C<inclusive> - Include C<$group> itself in the results (default: true)
518 C<algorithm> - Search algorithm, one of C<ids>, C<bfs> or C<dfs> (default: C<ids>)
524 $new_group = $group->add_group($new_group);
525 $new_group = $group->add_group(%group_attributes);
527 Add a group to a group. If C<$new_group> already has a parent group, it will be removed from that group before
528 being added to C<$group>.
532 $removed_group = $group->remove_group($group);
533 $removed_group = $group->remove_group($group_uuid);
535 Remove a group from a group's array of subgroups. Returns the group removed or C<undef> if nothing removed.
539 \&iterator = $groups->all_objects(%options);
541 Get an L<File::KDBX::Iterator> over I<objects> within a group, deeply. Groups and entries are considered
542 objects, so this is essentially a combination of L</groups> and L</entries>. This won't often be useful, but
543 it can be convenient for maintenance tasks. This method takes the same options as L</groups> and L</entries>.
547 $new_entry = $group->add_object($new_entry);
548 $new_group = $group->add_object($new_group);
550 Add an object (either a L<File::KDBX::Entry> or a L<File::KDBX::Group>) to a group. This is the generic
551 equivalent of the object forms of L</add_entry> and L</add_group>.
555 $group->remove_object($entry);
556 $group->remove_object($group);
558 Remove an object (either a L<File::KDBX::Entry> or a L<File::KDBX::Group>) from a group. This is the generic
559 equivalent of the object forms of L</remove_entry> and L</remove_group>.
561 =head2 effective_default_auto_type_sequence
563 $text = $group->effective_default_auto_type_sequence;
565 Get the value of L</default_auto_type_sequence>, if set, or get the inherited effective default auto-type
566 sequence of the parent.
568 =head2 effective_enable_auto_type
570 $text = $group->effective_enable_auto_type;
572 Get the value of L</enable_auto_type>, if set, or get the inherited effective auto-type enabled value of the
575 =head2 effective_enable_searching
577 $text = $group->effective_enable_searching;
579 Get the value of L</enable_searching>, if set, or get the inherited effective searching enabled value of the
584 $bool = $group->is_empty;
586 Get whether or not the group is empty (has no subgroups or entries).
590 $bool = $group->is_root;
592 Determine if a group is the root group of its connected database.
594 =head2 is_recycle_bin
596 $bool = $group->is_recycle_bin;
598 Get whether or not a group is the recycle bin of its connected database.
600 =head2 is_entry_templates
602 $bool = $group->is_entry_templates;
604 Get whether or not a group is the group containing entry template in its connected database.
606 =head2 is_last_selected
608 $bool = $group->is_last_selected;
610 Get whether or not a group is the prior selected group of its connected database.
612 =head2 is_last_top_visible
614 $bool = $group->is_last_top_visible;
616 Get whether or not a group is the latest top visible group of its connected database.
620 $string = $group->path;
622 Get a string representation of a group's lineage. This is used as the substitution value for the
623 C<{GROUP_PATH}> placeholder. See L<File::KDBX::Entry/Placeholders>.
625 For a root group, the path is simply the name of the group. For deeper groups, the path is a period-separated
626 sequence of group names between the root group and C<$group>, including C<$group> but I<not> the root group.
627 In other words, paths of deeper groups leave the root group name out.
630 -> Root # path is "Root"
631 -> Foo # path is "Foo"
632 -> Bar # path is "Foo.Bar"
634 Yeah, it doesn't make much sense to me, either, but this matches the behavior of KeePass.
638 $size = $group->size;
640 Get the size (in bytes) of a group, including the size of all subroups and entries, if any.
644 $depth = $group->depth;
646 Get the depth of a group within a database. The root group is at depth 0, its direct children are at depth 1,
647 etc. A group not in a database tree structure returns a depth of -1.
649 =for Pod::Coverage times
653 Please report any bugs or feature requests on the bugtracker website
654 L<https://github.com/chazmcgarvey/File-KDBX/issues>
656 When submitting a bug or request, please include a test-file or a
657 patch to an existing test-file that illustrates the bug or desired
662 Charles McGarvey <ccm@cpan.org>
664 =head1 COPYRIGHT AND LICENSE
666 This software is copyright (c) 2022 by Charles McGarvey.
668 This is free software; you can redistribute it and/or modify it under
669 the same terms as the Perl 5 programming language system itself.