1 package File
::KDBX
::Group
;
2 # ABSTRACT: A KDBX database group
7 use Devel
::GlobalDestruction
;
8 use File
::KDBX
::Constants
qw(:icon);
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
24 sub _parent_container
{ 'groups' }
26 # has uuid => sub { generate_uuid(printable => 1) };
27 has name
=> '', coerce
=> \
&to_string
;
28 has notes
=> '', coerce
=> \
&to_string
;
29 has tags
=> '', coerce
=> \
&to_string
;
30 has icon_id
=> ICON_FOLDER
, coerce
=> \
&to_icon_constant
;
31 has custom_icon_uuid
=> undef, coerce
=> \
&to_uuid
;
32 has is_expanded
=> false
, coerce
=> \
&to_bool
;
33 has default_auto_type_sequence
=> '', coerce
=> \
&to_string
;
34 has enable_auto_type
=> undef, coerce
=> \
&to_tristate
;
35 has enable_searching
=> undef, coerce
=> \
&to_tristate
;
36 has last_top_visible_entry
=> undef, coerce
=> \
&to_uuid
;
37 # has custom_data => {};
38 has previous_parent_group
=> undef, coerce
=> \
&to_uuid
;
43 has last_modification_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
44 has creation_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
45 has last_access_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
46 has expiry_time
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
47 has expires
=> false
, store
=> 'times', coerce
=> \
&to_bool
;
48 has usage_count
=> 0, store
=> 'times', coerce
=> \
&to_number
;
49 has location_changed
=> sub { gmtime }, store
=> 'times', coerce
=> \
&to_time
;
51 my @ATTRS = qw(uuid custom_data entries groups);
52 sub _set_nonlazy_attributes
{
54 $self->$_ for @ATTRS, list_attributes
(ref $self);
59 if (@_ || !defined $self->{uuid
}) {
60 my %args = @_ % 2 == 1 ? (uuid
=> shift, @_) : @_;
61 my $old_uuid = $self->{uuid
};
62 my $uuid = $self->{uuid
} = delete $args{uuid
} // generate_uuid
;
63 $self->_signal('uuid.changed', $uuid, $old_uuid) if defined $old_uuid;
68 ##############################################################################
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 };
84 my $searching = delete $args{searching
};
85 my $auto_type = delete $args{auto_type
};
86 my $history = delete $args{history
};
88 my $groups = $self->groups_deeply(%args);
91 return File
::KDBX
::Iterator-
>new(sub {
93 while (my $group = $groups->next) {
94 next if $searching && !$group->effective_enable_searching;
95 next if $auto_type && !$group->effective_enable_auto_type;
96 @entries = @{$group->entries};
97 @entries = grep { $_->auto_type->{enabled
} } @entries if $auto_type;
98 @entries = map { ($_, @{$_->history}) } @entries if $history;
108 $entry = $group->add_entry($entry);
109 $entry = $group->add_entry(%entry_attributes);
111 Add an entry to a group
. If C
<$entry> already
has a parent group
, it will be removed from that group before
112 being added to C
<$group>.
118 my $entry = @_ % 2 == 1 ? shift : undef;
121 my $kdbx = delete $args{kdbx
} // eval { $self->kdbx };
123 $entry = $self->_wrap_entry($entry // [%args]);
125 $entry->kdbx($kdbx) if $kdbx;
127 push @{$self->{entries
} ||= []}, $entry->remove;
128 return $entry->_set_group($self)->_signal('added', $self);
133 my $uuid = is_ref
($_[0]) ? $self->_wrap_entry(shift)->uuid : shift;
134 my $objects = $self->{entries
};
135 for (my $i = 0; $i < @$objects; ++$i) {
136 my $o = $objects->[$i];
137 next if $uuid ne $o->uuid;
138 $o->_set_group(undef)->_signal('removed');
139 return splice @$objects, $i, 1;
143 ##############################################################################
147 my $groups = $self->{groups
} //= [];
148 if (@$groups && !blessed
($groups->[0])) {
149 @$groups = map { $self->_wrap_group($_, $self->kdbx) } @$groups;
151 assert
{ !any
{ !blessed
$_ } @$groups };
159 my @groups = ($args{inclusive
} // 1) ? $self : @{$self->groups};
160 my $algo = lc($args{algorithm
} || 'ids');
162 if ($algo eq 'dfs') {
164 return File
::KDBX
::Iterator-
>new(sub {
165 my $next = shift @groups or return;
166 if (!$visited{Hash
::Util
::FieldHash
::id
($next)}++) {
167 while (my @children = @{$next->groups}) {
168 unshift @groups, @children, $next;
169 $next = shift @groups;
170 $visited{Hash
::Util
::FieldHash
::id
($next)}++;
176 elsif ($algo eq 'bfs') {
177 return File
::KDBX
::Iterator-
>new(sub {
178 my $next = shift @groups or return;
179 push @groups, @{$next->groups};
183 return File
::KDBX
::Iterator-
>new(sub {
184 my $next = shift @groups or return;
185 unshift @groups, @{$next->groups};
190 sub _kpx_groups
{ shift-
>groups(@_) }
194 $new_group = $group->add_group($new_group);
195 $new_group = $group->add_group(%group_attributes);
197 Add a group to a group
. If C
<$new_group> already
has a parent group
, it will be removed from that group before
198 being added to C
<$group>.
204 my $group = @_ % 2 == 1 ? shift : undef;
207 my $kdbx = delete $args{kdbx
} // eval { $self->kdbx };
209 $group = $self->_wrap_group($group // [%args]);
211 $group->kdbx($kdbx) if $kdbx;
213 push @{$self->{groups
} ||= []}, $group->remove;
214 return $group->_set_group($self)->_signal('added', $self);
219 my $uuid = is_ref
($_[0]) ? $self->_wrap_group(shift)->uuid : shift;
220 my $objects = $self->{groups
};
221 for (my $i = 0; $i < @$objects; ++$i) {
222 my $o = $objects->[$i];
223 next if $uuid ne $o->uuid;
224 $o->_set_group(undef)->_signal('removed');
225 return splice @$objects, $i, 1;
229 ##############################################################################
235 my $searching = delete $args{searching
};
236 my $auto_type = delete $args{auto_type
};
237 my $history = delete $args{history
};
239 my $groups = $self->groups_deeply(%args);
242 return File
::KDBX
::Iterator-
>new(sub {
244 while (my $group = $groups->next) {
245 next if $searching && !$group->effective_enable_searching;
246 next if $auto_type && !$group->effective_enable_auto_type;
247 @entries = @{$group->entries};
248 @entries = grep { $_->auto_type->{enabled
} } @entries if $auto_type;
249 @entries = map { ($_, @{$_->history}) } @entries if $history;
259 $new_entry = $group->add_object($new_entry);
260 $new_group = $group->add_object($new_group);
262 Add an object
(either a L
<File
::KDBX
::Entry
> or a L
<File
::KDBX
::Group
>) to a group
. This
is the generic
263 equivalent of the object forms of L
</add_entry> and L</add_group
>.
270 if ($obj->isa('File::KDBX::Entry')) {
271 $self->add_entry($obj);
273 elsif ($obj->isa('File::KDBX::Group')) {
274 $self->add_group($obj);
278 =method remove_object
280 $group->remove_object($entry);
281 $group->remove_object($group);
283 Remove an object
(either a L
<File
::KDBX
::Entry
> or a L
<File
::KDBX
::Group
>) from a group
. This
is the generic
284 equivalent of the object forms of L
</remove_entry> and L</remove_group
>.
291 my $blessed = blessed
($object);
292 return $self->remove_group($object, @_) if $blessed && $object->isa('File::KDBX::Group');
293 return $self->remove_entry($object, @_) if $blessed && $object->isa('File::KDBX::Entry');
294 return $self->remove_group($object, @_) || $self->remove_entry($object, @_);
297 ##############################################################################
301 $bool = $group->is_root;
303 Determine
if a group
is the root group of its associated database
.
309 my $kdbx = eval { $self->kdbx } or return;
310 return Hash
::Util
::FieldHash
::id
($kdbx->root) == Hash
::Util
::FieldHash
::id
($self);
315 $string = $group->path;
317 Get a string representation of a group
's lineage. This is used as the substitution value for the
318 C<{GROUP_PATH}> placeholder. See L<File::KDBX::Entry/Placeholders>.
320 For a root group, the path is simply the name of the group. For deeper groups, the path is a period-separated
321 sequence of group names between the root group and C<$group>, including C<$group> but I<not> the root group.
322 In other words, paths of deeper groups leave the root group name out.
325 -> Root # path is "Root"
326 -> Foo # path is "Foo"
327 -> Bar # path is "Foo.Bar"
329 Yeah, it doesn't make much sense to me
, either
, but this matches the behavior of KeePass
.
335 return $self->name if $self->is_root;
336 my $lineage = $self->lineage or return;
337 my @parts = (@$lineage, $self);
339 return join('.', map { $_->name } @parts);
344 $size = $group->size;
346 Get the size
(in bytes
) of a group
, including the size of all subroups
and entries
, if any
.
352 return sum0
map { $_->size } @{$self->groups}, @{$self->entries};
357 $depth = $group->depth;
359 Get the depth of a group within a database
. The root group
is at depth
0, its direct children are at depth
1,
360 etc
. A group
not in a database tree structure returns a depth of
-1.
364 sub depth
{ $_[0]->is_root ? 0 : (scalar @{$_[0]->lineage || []} || -1) }
366 sub label
{ shift-
>name(@_) }
371 return $self->SUPER::_signal
("group.$type", @_);
377 $self->last_modification_time($time);
378 $self->last_access_time($time);
381 sub effective_default_auto_type_sequence
{
383 my $sequence = $self->default_auto_type_sequence;
384 return $sequence if defined $sequence;
386 my $parent = $self->parent or return '{USERNAME}{TAB}{PASSWORD}{ENTER}';
387 return $parent->effective_default_auto_type_sequence;
390 sub effective_enable_auto_type
{
392 my $enabled = $self->enable_auto_type;
393 return $enabled if defined $enabled;
395 my $parent = $self->parent or return true
;
396 return $parent->effective_enable_auto_type;
399 sub effective_enable_searching
{
401 my $enabled = $self->enable_searching;
402 return $enabled if defined $enabled;
404 my $parent = $self->parent or return true
;
405 return $parent->effective_enable_searching;
423 =attr custom_icon_uuid
427 =attr default_auto_type_sequence
429 =attr enable_auto_type
431 =attr enable_searching
433 =attr last_top_visible_entry
437 =attr previous_parent_group
443 =attr last_modification_time
447 =attr last_access_time
455 =attr location_changed
457 Get or set various group fields.