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 = '999.999'; # VERSION
26 128-bit UUID identifying the group within the database
.
30 The human-readable name of the group
.
34 Free form text string associated with the group
.
38 Text string with arbitrary tags which can be used to build a taxonomy
.
42 Integer representing a
default icon
. See L
<File
::KDBX
::Constants
/":icon"> for valid
values.
44 =attr custom_icon_uuid
46 128-bit UUID identifying a custom icon within the database
.
50 Whether
or not subgroups are visible
when listed
for user selection
.
52 =attr default_auto_type_sequence
54 The
default auto-type keystroke sequence
, inheritable by entries
and subgroups
.
56 =attr enable_auto_type
58 Whether
or not the entry
is eligible to be matched
for auto-typing
, inheritable by entries
and subgroups
.
60 =attr enable_searching
62 Whether
or not entries within the group can show up
in search results
, inheritable by subgroups
.
64 =attr last_top_visible_entry
66 The UUID of the entry visible at the top of the list
.
70 A set of key-value pairs used to store arbitrary data
, usually used by software to keep track of
state rather
71 than by end users
(who typically work with the strings
and binaries
).
73 =attr previous_parent_group
75 128-bit UUID identifying a group within the database
.
79 Array of entries contained within the group
.
83 Array of subgroups contained within the group
.
85 =attr last_modification_time
87 Date
and time when the entry was
last modified
.
91 Date
and time when the entry was created
.
93 =attr last_access_time
95 Date
and time when the entry was
last accessed
.
99 Date
and time when the entry expired
or will expire
.
103 Boolean value indicating whether
or not an entry
is expired
.
109 =attr location_changed
111 Date
and time when the entry was
last moved to a different parent group
.
115 # has uuid => sub { generate_uuid(printable => 1) };
116 has name
=> '', coerce
=> \
&to_string
;
117 has notes
=> '', coerce
=> \
&to_string
;
118 has tags
=> '', coerce
=> \
&to_string
;
119 has icon_id
=> ICON_FOLDER
, coerce
=> \
&to_icon_constant
;
120 has custom_icon_uuid
=> undef, coerce
=> \
&to_uuid
;
121 has is_expanded
=> false
, coerce
=> \
&to_bool
;
122 has default_auto_type_sequence
=> '', coerce
=> \
&to_string
;
123 has enable_auto_type
=> undef, coerce
=> \
&to_tristate
;
124 has enable_searching
=> undef, coerce
=> \
&to_tristate
;
125 has last_top_visible_entry
=> undef, coerce
=> \
&to_uuid
;
126 # has custom_data => {};
127 has previous_parent_group
=> undef, coerce
=> \
&to_uuid
;
132 has last_modification_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
133 has creation_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
134 has last_access_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
135 has expiry_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
136 has expires
=> false
, store
=> 'times', coerce
=> \
&to_bool
;
137 has usage_count
=> 0, store
=> 'times', coerce
=> \
&to_number
;
138 has location_changed
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
140 my @ATTRS = qw(uuid custom_data entries groups);
141 sub _set_nonlazy_attributes
{
143 $self->$_ for @ATTRS, list_attributes
(ref $self);
148 if (@_ || !defined $self->{uuid
}) {
149 my %args = @_ % 2 == 1 ? (uuid
=> shift, @_) : @_;
150 my $old_uuid = $self->{uuid
};
151 my $uuid = $self->{uuid
} = delete $args{uuid
} // generate_uuid
;
152 $self->_signal('uuid.changed', $uuid, $old_uuid) if defined $old_uuid;
157 ##############################################################################
161 \
@entries = $group->entries;
163 Get an array of direct entries within a group
.
169 my $entries = $self->{entries
} //= [];
170 if (@$entries && !blessed
($entries->[0])) {
171 @$entries = map { $self->_wrap_entry($_, $self->kdbx) } @$entries;
173 assert
{ !any
{ !blessed
$_ } @$entries };
177 =method entries_deeply
179 \
&iterator
= $kdbx->entries_deeply(%options);
181 Get an L
<File
::KDBX
::Iterator
> over I
<entries
> within a group
. Supports the same options as L
</groups
>,
185 * C<auto_type> - Only include entries with auto-type enabled (default: false, include all)
186 * C<searching> - Only include entries within groups with searching enabled (default: false, include all)
187 * C<history> - Also include historical entries (default: false, include only current entries)
195 my $searching = delete $args{searching
};
196 my $auto_type = delete $args{auto_type
};
197 my $history = delete $args{history
};
199 my $groups = $self->groups_deeply(%args);
202 return File
::KDBX
::Iterator-
>new(sub {
204 while (my $group = $groups->next) {
205 next if $searching && !$group->effective_enable_searching;
206 next if $auto_type && !$group->effective_enable_auto_type;
207 @entries = @{$group->entries};
208 @entries = grep { $_->auto_type->{enabled
} } @entries if $auto_type;
209 @entries = map { ($_, @{$_->history}) } @entries if $history;
219 $entry = $group->add_entry($entry);
220 $entry = $group->add_entry(%entry_attributes);
222 Add an entry to a group
. If C
<$entry> already
has a parent group
, it will be removed from that group before
223 being added to C
<$group>.
229 my $entry = @_ % 2 == 1 ? shift : undef;
232 my $kdbx = delete $args{kdbx
} // eval { $self->kdbx };
234 $entry = $self->_wrap_entry($entry // [%args]);
236 $entry->kdbx($kdbx) if $kdbx;
238 push @{$self->{entries
} ||= []}, $entry->remove;
239 return $entry->_set_group($self)->_signal('added', $self);
244 $entry = $group->remove_entry($entry);
245 $entry = $group->remove_entry($entry_uuid);
247 Remove an entry from a group
's array of entries. Returns the entry removed or C<undef> if nothing removed.
253 my $uuid = is_ref($_[0]) ? $self->_wrap_entry(shift)->uuid : shift;
255 my $objects = $self->{entries};
256 for (my $i = 0; $i < @$objects; ++$i) {
257 my $object = $objects->[$i];
258 next if $uuid ne $object->uuid;
259 $object->_set_group(undef);
260 $object->_signal('removed
') if $args{signal} // 1;
261 return splice @$objects, $i, 1;
265 ##############################################################################
269 \@groups = $group->groups;
271 Get an array of direct subgroups within a group.
277 my $groups = $self->{groups} //= [];
278 if (@$groups && !blessed($groups->[0])) {
279 @$groups = map { $self->_wrap_group($_, $self->kdbx) } @$groups;
281 assert { !any { !blessed $_ } @$groups };
285 =method groups_deeply
287 \&iterator = $group->groups_deeply(%options);
289 Get an L<File::KDBX::Iterator> over I<groups> within a groups, deeply. Options:
292 * C<inclusive> - Include C<$group> itself in the results (default: true)
293 * C<algorithm> - Search algorithm, one of C<ids>, C<bfs> or C<dfs> (default: C<ids>)
301 my @groups = ($args{inclusive} // 1) ? $self : @{$self->groups};
302 my $algo = lc($args{algorithm} || 'ids
');
304 if ($algo eq ITERATION_DFS) {
306 return File::KDBX::Iterator->new(sub {
307 my $next = shift @groups or return;
308 if (!$visited{Hash::Util::FieldHash::id($next)}++) {
309 while (my @children = @{$next->groups}) {
310 unshift @groups, @children, $next;
311 $next = shift @groups;
312 $visited{Hash::Util::FieldHash::id($next)}++;
318 elsif ($algo eq ITERATION_BFS) {
319 return File::KDBX::Iterator->new(sub {
320 my $next = shift @groups or return;
321 push @groups, @{$next->groups};
325 return File::KDBX::Iterator->new(sub {
326 my $next = shift @groups or return;
327 unshift @groups, @{$next->groups};
332 sub _kpx_groups { shift->groups(@_) }
336 $new_group = $group->add_group($new_group);
337 $new_group = $group->add_group(%group_attributes);
339 Add a group to a group. If C<$new_group> already has a parent group, it will be removed from that group before
340 being added to C<$group>.
346 my $group = @_ % 2 == 1 ? shift : undef;
349 my $kdbx = delete $args{kdbx} // eval { $self->kdbx };
351 $group = $self->_wrap_group($group // [%args]);
353 $group->kdbx($kdbx) if $kdbx;
355 push @{$self->{groups} ||= []}, $group->remove;
356 return $group->_set_group($self)->_signal('added
', $self);
361 $removed_group = $group->remove_group($group);
362 $removed_group = $group->remove_group($group_uuid);
364 Remove a group from a group's array of subgroups
. Returns the group removed
or C
<undef> if nothing removed
.
370 my $uuid = is_ref
($_[0]) ? $self->_wrap_group(shift)->uuid : shift;
372 my $objects = $self->{groups
};
373 for (my $i = 0; $i < @$objects; ++$i) {
374 my $object = $objects->[$i];
375 next if $uuid ne $object->uuid;
376 $object->_set_group(undef);
377 $object->_signal('removed') if $args{signal
} // 1;
378 return splice @$objects, $i, 1;
382 ##############################################################################
384 =method objects_deeply
386 \
&iterator
= $groups->objects_deeply(%options);
388 Get an L
<File
::KDBX
::Iterator
> over I
<objects
> within a group
, deeply
. Groups
and entries are considered
389 objects
, so this
is essentially a combination of L
</groups> and L</entries
>. This won
't often be useful, but
390 it can be convenient for maintenance tasks. This method takes the same options as L</groups> and L</entries>.
398 my $searching = delete $args{searching};
399 my $auto_type = delete $args{auto_type};
400 my $history = delete $args{history};
402 my $groups = $self->groups_deeply(%args);
405 return File::KDBX::Iterator->new(sub {
407 while (my $group = $groups->next) {
408 next if $searching && !$group->effective_enable_searching;
409 next if $auto_type && !$group->effective_enable_auto_type;
410 @entries = @{$group->entries};
411 @entries = grep { $_->auto_type->{enabled} } @entries if $auto_type;
412 @entries = map { ($_, @{$_->history}) } @entries if $history;
422 $new_entry = $group->add_object($new_entry);
423 $new_group = $group->add_object($new_group);
425 Add an object (either a L<File::KDBX::Entry> or a L<File::KDBX::Group>) to a group. This is the generic
426 equivalent of the object forms of L</add_entry> and L</add_group>.
433 if ($obj->isa('File
::KDBX
::Entry
')) {
434 $self->add_entry($obj);
436 elsif ($obj->isa('File
::KDBX
::Group
')) {
437 $self->add_group($obj);
441 =method remove_object
443 $group->remove_object($entry);
444 $group->remove_object($group);
446 Remove an object (either a L<File::KDBX::Entry> or a L<File::KDBX::Group>) from a group. This is the generic
447 equivalent of the object forms of L</remove_entry> and L</remove_group>.
454 my $blessed = blessed($object);
455 return $self->remove_group($object, @_) if $blessed && $object->isa('File
::KDBX
::Group
');
456 return $self->remove_entry($object, @_) if $blessed && $object->isa('File
::KDBX
::Entry
');
457 return $self->remove_group($object, @_) || $self->remove_entry($object, @_);
460 ##############################################################################
462 =method effective_default_auto_type_sequence
464 $text = $group->effective_default_auto_type_sequence;
466 Get the value of L</default_auto_type_sequence>, if set, or get the inherited effective default auto-type
467 sequence of the parent.
471 sub effective_default_auto_type_sequence {
473 my $sequence = $self->default_auto_type_sequence;
474 return $sequence if defined $sequence;
476 my $parent = $self->group or return '{USERNAME
}{TAB
}{PASSWORD
}{ENTER
}';
477 return $parent->effective_default_auto_type_sequence;
480 =method effective_enable_auto_type
482 $text = $group->effective_enable_auto_type;
484 Get the value of L</enable_auto_type>, if set, or get the inherited effective auto-type enabled value of the
489 sub effective_enable_auto_type {
491 my $enabled = $self->enable_auto_type;
492 return $enabled if defined $enabled;
494 my $parent = $self->group or return true;
495 return $parent->effective_enable_auto_type;
498 =method effective_enable_searching
500 $text = $group->effective_enable_searching;
502 Get the value of L</enable_searching>, if set, or get the inherited effective searching enabled value of the
507 sub effective_enable_searching {
509 my $enabled = $self->enable_searching;
510 return $enabled if defined $enabled;
512 my $parent = $self->group or return true;
513 return $parent->effective_enable_searching;
516 ##############################################################################
520 $bool = $group->is_empty;
522 Get whether or not the group is empty (has no subgroups or entries).
528 return @{$self->groups} == 0 && @{$self->entries} == 0;
533 $bool = $group->is_root;
535 Determine if a group is the root group of its connected database.
541 my $kdbx = eval { $self->kdbx } or return FALSE;
542 return Hash::Util::FieldHash::id($kdbx->root) == Hash::Util::FieldHash::id($self);
545 =method is_recycle_bin
547 $bool = $group->is_recycle_bin;
549 Get whether or not a group is the recycle bin of its connected database.
555 my $kdbx = eval { $self->kdbx } or return FALSE;
556 my $group = $kdbx->recycle_bin;
557 return $group && Hash::Util::FieldHash::id($group) == Hash::Util::FieldHash::id($self);
560 =method is_entry_templates
562 $bool = $group->is_entry_templates;
564 Get whether or not a group is the group containing entry template of its connected database.
568 sub is_entry_templates {
570 my $kdbx = eval { $self->kdbx } or return FALSE;
571 my $group = $kdbx->entry_templates;
572 return $group && Hash::Util::FieldHash::id($group) == Hash::Util::FieldHash::id($self);
575 =method is_last_selected
577 $bool = $group->is_last_selected;
579 Get whether or not a group is the prior selected group of its connected database.
583 sub is_last_selected {
585 my $kdbx = eval { $self->kdbx } or return FALSE;
586 my $group = $kdbx->last_selected;
587 return $group && Hash::Util::FieldHash::id($group) == Hash::Util::FieldHash::id($self);
590 =method is_last_top_visible
592 $bool = $group->is_last_top_visible;
594 Get whether or not a group is the latest top visible group of its connected database.
598 sub is_last_top_visible {
600 my $kdbx = eval { $self->kdbx } or return FALSE;
601 my $group = $kdbx->last_top_visible;
602 return $group && Hash::Util::FieldHash::id($group) == Hash::Util::FieldHash::id($self);
607 $string = $group->path;
609 Get a string representation of a group's lineage
. This
is used as the substitution value
for the
610 C
<{GROUP_PATH
}> placeholder
. See L
<File
::KDBX
::Entry
/Placeholders
>.
612 For a root group
, the path
is simply the name of the group
. For deeper groups
, the path
is a period-separated
613 sequence of group names between the root group
and C
<$group>, including C
<$group> but I
<not> the root group
.
614 In other words
, paths of deeper groups leave the root group name out
.
617 -> Root
# path is "Root"
618 -> Foo
# path is "Foo"
619 -> Bar
# path is "Foo.Bar"
621 Yeah
, it doesn
't make much sense to me, either, but this matches the behavior of KeePass.
627 return $self->name if $self->is_root;
628 my $lineage = $self->lineage or return;
629 my @parts = (@$lineage, $self);
631 return join('.', map { $_->name } @parts);
636 $size = $group->size;
638 Get the size (in bytes) of a group, including the size of all subroups and entries, if any.
644 return sum0 map { $_->size } @{$self->groups}, @{$self->entries};
649 $depth = $group->depth;
651 Get the depth of a group within a database. The root group is at depth 0, its direct children are at depth 1,
652 etc. A group not in a database tree structure returns a depth of -1.
656 sub depth { $_[0]->is_root ? 0 : (scalar @{$_[0]->lineage || []} || -1) }
661 return $self->SUPER::_signal("group.$type", @_);
667 $self->last_modification_time($time);
668 $self->last_access_time($time);
671 sub label { shift->name(@_) }
673 ### Name of the parent attribute expected to contain the object
674 sub _parent_container { 'groups
' }
679 =for Pod::Coverage times
683 A group in a KDBX database is a type of object that can contain entries and other groups.
685 There is also some metadata associated with a group. Each group in a database is identified uniquely by
686 a UUID. An entry can also have an icon associated with it, and there are various timestamps. Take a look at
687 the attributes to see what's available
.