X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FGroup.pm;h=9ef603b891c58bc286c0b7e96126f2ae1b15b22e;hb=b334578b1eb03deabcdcc02f324e7d2323c7965e;hp=d68189fd5da0e2d74f5699aa2fb3e99aaf4dc63c;hpb=05e0bcef1c2165c556b910314312866dc4a667b7;p=chaz%2Fp5-File-KDBX diff --git a/lib/File/KDBX/Group.pm b/lib/File/KDBX/Group.pm index d68189f..9ef603b 100644 --- a/lib/File/KDBX/Group.pm +++ b/lib/File/KDBX/Group.pm @@ -5,75 +5,89 @@ use warnings; use strict; use Devel::GlobalDestruction; -use File::KDBX::Constants qw(:icon); +use File::KDBX::Constants qw(:bool :icon :iteration); use File::KDBX::Error; -use File::KDBX::Util qw(generate_uuid); +use File::KDBX::Iterator; +use File::KDBX::Util qw(:assert :class :coercion generate_uuid); use Hash::Util::FieldHash; -use List::Util qw(sum0); +use List::Util qw(any sum0); use Ref::Util qw(is_coderef is_ref); use Scalar::Util qw(blessed); use Time::Piece; use boolean; use namespace::clean; -use parent 'File::KDBX::Object'; +extends 'File::KDBX::Object'; our $VERSION = '999.999'; # VERSION -sub _parent_container { 'groups' } +=attr name -my @ATTRS = qw(uuid custom_data entries groups); -my %ATTRS = ( - # uuid => sub { generate_uuid(printable => 1) }, - name => '', - notes => '', - tags => '', - icon_id => sub { defined $_[1] ? icon($_[1]) : ICON_FOLDER }, - custom_icon_uuid => undef, - is_expanded => false, - default_auto_type_sequence => '', - enable_auto_type => undef, - enable_searching => undef, - last_top_visible_entry => undef, - # custom_data => sub { +{} }, - previous_parent_group => undef, - # entries => sub { +[] }, - # groups => sub { +[] }, -); -my %ATTRS_TIMES = ( - last_modification_time => sub { scalar gmtime }, - creation_time => sub { scalar gmtime }, - last_access_time => sub { scalar gmtime }, - expiry_time => sub { scalar gmtime }, - expires => false, - usage_count => 0, - location_changed => sub { scalar gmtime }, -); - -while (my ($attr, $setter) = each %ATTRS) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = is_coderef $setter ? sub { - my $self = shift; - $self->{$attr} = $setter->($self, shift) if @_; - $self->{$attr} //= $setter->($self); - } : sub { - my $self = shift; - $self->{$attr} = shift if @_; - $self->{$attr} //= $setter; - }; -} -while (my ($attr, $default) = each %ATTRS_TIMES) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = sub { - my $self = shift; - $self->{times}{$attr} = shift if @_; - $self->{times}{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default; - }; -} +The human-readable name of the group. + +=attr notes + +Free form text string associated with the group. + +=attr is_expanded + +Whether or not subgroups are visible when listed for user selection. + +=attr default_auto_type_sequence + +The default auto-type keystroke sequence, inheritable by entries and subgroups. + +=attr enable_auto_type + +Whether or not the entry is eligible to be matched for auto-typing, inheritable by entries and subgroups. + +=attr enable_searching + +Whether or not entries within the group can show up in search results, inheritable by subgroups. + +=attr last_top_visible_entry + +The UUID of the entry visible at the top of the list. -sub _set_default_attributes { +=attr entries + +Array of entries contained within the group. + +=attr groups + +Array of subgroups contained within the group. + +=cut + +# has uuid => sub { generate_uuid(printable => 1) }; +has name => '', coerce => \&to_string; +has notes => '', coerce => \&to_string; +has tags => '', coerce => \&to_string; +has icon_id => ICON_FOLDER, coerce => \&to_icon_constant; +has custom_icon_uuid => undef, coerce => \&to_uuid; +has is_expanded => false, coerce => \&to_bool; +has default_auto_type_sequence => '', coerce => \&to_string; +has enable_auto_type => undef, coerce => \&to_tristate; +has enable_searching => undef, coerce => \&to_tristate; +has last_top_visible_entry => undef, coerce => \&to_uuid; +# has custom_data => {}; +has previous_parent_group => undef, coerce => \&to_uuid; +# has entries => []; +# has groups => []; +has times => {}; + +has last_modification_time => sub { gmtime }, store => 'times', coerce => \&to_time; +has creation_time => sub { gmtime }, store => 'times', coerce => \&to_time; +has last_access_time => sub { gmtime }, store => 'times', coerce => \&to_time; +has expiry_time => sub { gmtime }, store => 'times', coerce => \&to_time; +has expires => false, store => 'times', coerce => \&to_bool; +has usage_count => 0, store => 'times', coerce => \&to_number; +has location_changed => sub { gmtime }, store => 'times', coerce => \&to_time; + +my @ATTRS = qw(uuid custom_data entries groups); +sub _set_nonlazy_attributes { my $self = shift; - $self->$_ for @ATTRS, keys %ATTRS, keys %ATTRS_TIMES; + $self->$_ for @ATTRS, list_attributes(ref $self); } sub uuid { @@ -89,18 +103,62 @@ sub uuid { ############################################################################## +=method entries + + \@entries = $group->entries; + +Get an array of direct child entries within a group. + +=cut + sub entries { my $self = shift; my $entries = $self->{entries} //= []; - # FIXME - Looping through entries on each access is too expensive. - @$entries = map { $self->_wrap_entry($_, $self->kdbx) } @$entries; + if (@$entries && !blessed($entries->[0])) { + @$entries = map { $self->_wrap_entry($_, $self->kdbx) } @$entries; + } + assert { !any { !blessed $_ } @$entries }; return $entries; } +=method all_entries + + \&iterator = $kdbx->all_entries(%options); + +Get an L over I within a group. Supports the same options as L, +plus some new ones: + +=for :list +* C - Only include entries with auto-type enabled (default: false, include all) +* C - Only include entries within groups with searching enabled (default: false, include all) +* C - Also include historical entries (default: false, include only current entries) + +=cut + sub all_entries { my $self = shift; - # FIXME - shouldn't have to delegate to the database to get this - return $self->kdbx->all_entries(base => $self); + my %args = @_; + + my $searching = delete $args{searching}; + my $auto_type = delete $args{auto_type}; + my $history = delete $args{history}; + + my $groups = $self->all_groups(%args); + my @entries; + + return File::KDBX::Iterator->new(sub { + if (!@entries) { + while (my $group = $groups->next) { + next if $searching && !$group->effective_enable_searching; + next if $auto_type && !$group->effective_enable_auto_type; + @entries = @{$group->entries}; + @entries = grep { $_->auto_type->{enabled} } @entries if $auto_type; + @entries = map { ($_, @{$_->history}) } @entries if $history; + last if @entries; + } + } + shift @entries; + }); } =method add_entry @@ -125,36 +183,97 @@ sub add_entry { $entry->kdbx($kdbx) if $kdbx; push @{$self->{entries} ||= []}, $entry->remove; - return $entry->_set_group($self); + return $entry->_set_group($self)->_signal('added', $self); } +=method remove_entry + + $entry = $group->remove_entry($entry); + $entry = $group->remove_entry($entry_uuid); + +Remove an entry from a group's array of entries. Returns the entry removed or C if nothing removed. + +=cut + sub remove_entry { my $self = shift; my $uuid = is_ref($_[0]) ? $self->_wrap_entry(shift)->uuid : shift; + my %args = @_; my $objects = $self->{entries}; for (my $i = 0; $i < @$objects; ++$i) { - my $o = $objects->[$i]; - next if $uuid ne $o->uuid; + my $object = $objects->[$i]; + next if $uuid ne $object->uuid; + $object->_set_group(undef); + $object->_signal('removed') if $args{signal} // 1; return splice @$objects, $i, 1; - $o->_set_group(undef); - return @$objects, $i, 1; } } ############################################################################## +=method groups + + \@groups = $group->groups; + +Get an array of direct subgroups within a group. + +=cut + sub groups { my $self = shift; my $groups = $self->{groups} //= []; - # FIXME - Looping through groups on each access is too expensive. - @$groups = map { $self->_wrap_group($_, $self->kdbx) } @$groups; + if (@$groups && !blessed($groups->[0])) { + @$groups = map { $self->_wrap_group($_, $self->kdbx) } @$groups; + } + assert { !any { !blessed $_ } @$groups }; return $groups; } +=method all_groups + + \&iterator = $group->all_groups(%options); + +Get an L over I within a groups, deeply. Options: + +=for :list +* C - Include C<$group> itself in the results (default: true) +* C - Search algorithm, one of C, C or C (default: C) + +=cut + sub all_groups { my $self = shift; - # FIXME - shouldn't have to delegate to the database to get this - return $self->kdbx->all_groups(base => $self, include_base => false); + my %args = @_; + + my @groups = ($args{inclusive} // 1) ? $self : @{$self->groups}; + my $algo = lc($args{algorithm} || 'ids'); + + if ($algo eq ITERATION_DFS) { + my %visited; + return File::KDBX::Iterator->new(sub { + my $next = shift @groups or return; + if (!$visited{Hash::Util::FieldHash::id($next)}++) { + while (my @children = @{$next->groups}) { + unshift @groups, @children, $next; + $next = shift @groups; + $visited{Hash::Util::FieldHash::id($next)}++; + } + } + $next; + }); + } + elsif ($algo eq ITERATION_BFS) { + return File::KDBX::Iterator->new(sub { + my $next = shift @groups or return; + push @groups, @{$next->groups}; + $next; + }); + } + return File::KDBX::Iterator->new(sub { + my $next = shift @groups or return; + unshift @groups, @{$next->groups}; + $next; + }); } sub _kpx_groups { shift->groups(@_) } @@ -181,23 +300,70 @@ sub add_group { $group->kdbx($kdbx) if $kdbx; push @{$self->{groups} ||= []}, $group->remove; - return $group->_set_group($self); + return $group->_set_group($self)->_signal('added', $self); } +=method remove_group + + $removed_group = $group->remove_group($group); + $removed_group = $group->remove_group($group_uuid); + +Remove a group from a group's array of subgroups. Returns the group removed or C if nothing removed. + +=cut + sub remove_group { my $self = shift; my $uuid = is_ref($_[0]) ? $self->_wrap_group(shift)->uuid : shift; + my %args = @_; my $objects = $self->{groups}; for (my $i = 0; $i < @$objects; ++$i) { - my $o = $objects->[$i]; - next if $uuid ne $o->uuid; - $o->_set_group(undef); + my $object = $objects->[$i]; + next if $uuid ne $object->uuid; + $object->_set_group(undef); + $object->_signal('removed') if $args{signal} // 1; return splice @$objects, $i, 1; } } ############################################################################## +=method all_objects + + \&iterator = $groups->all_objects(%options); + +Get an L over I within a group, deeply. Groups and entries are considered +objects, so this is essentially a combination of L and L. This won't often be useful, but +it can be convenient for maintenance tasks. This method takes the same options as L and L. + +=cut + +sub all_objects { + my $self = shift; + my %args = @_; + + my $searching = delete $args{searching}; + my $auto_type = delete $args{auto_type}; + my $history = delete $args{history}; + + my $groups = $self->all_groups(%args); + my @entries; + + return File::KDBX::Iterator->new(sub { + if (!@entries) { + while (my $group = $groups->next) { + next if $searching && !$group->effective_enable_searching; + next if $auto_type && !$group->effective_enable_auto_type; + @entries = @{$group->entries}; + @entries = grep { $_->auto_type->{enabled} } @entries if $auto_type; + @entries = map { ($_, @{$_->history}) } @entries if $history; + return $group; + } + } + shift @entries; + }); +} + =method add_object $new_entry = $group->add_object($new_entry); @@ -240,20 +406,149 @@ sub remove_object { ############################################################################## +=method effective_default_auto_type_sequence + + $text = $group->effective_default_auto_type_sequence; + +Get the value of L, if set, or get the inherited effective default auto-type +sequence of the parent. + +=cut + +sub effective_default_auto_type_sequence { + my $self = shift; + my $sequence = $self->default_auto_type_sequence; + return $sequence if defined $sequence; + + my $parent = $self->group or return '{USERNAME}{TAB}{PASSWORD}{ENTER}'; + return $parent->effective_default_auto_type_sequence; +} + +=method effective_enable_auto_type + + $text = $group->effective_enable_auto_type; + +Get the value of L, if set, or get the inherited effective auto-type enabled value of the +parent. + +=cut + +sub effective_enable_auto_type { + my $self = shift; + my $enabled = $self->enable_auto_type; + return $enabled if defined $enabled; + + my $parent = $self->group or return true; + return $parent->effective_enable_auto_type; +} + +=method effective_enable_searching + + $text = $group->effective_enable_searching; + +Get the value of L, if set, or get the inherited effective searching enabled value of the +parent. + +=cut + +sub effective_enable_searching { + my $self = shift; + my $enabled = $self->enable_searching; + return $enabled if defined $enabled; + + my $parent = $self->group or return true; + return $parent->effective_enable_searching; +} + +############################################################################## + +=method is_empty + + $bool = $group->is_empty; + +Get whether or not the group is empty (has no subgroups or entries). + +=cut + +sub is_empty { + my $self = shift; + return @{$self->groups} == 0 && @{$self->entries} == 0; +} + =method is_root $bool = $group->is_root; -Determine if a group is the root group of its associated database. +Determine if a group is the root group of its connected database. =cut sub is_root { my $self = shift; - my $kdbx = eval { $self->kdbx } or return; + my $kdbx = eval { $self->kdbx } or return FALSE; return Hash::Util::FieldHash::id($kdbx->root) == Hash::Util::FieldHash::id($self); } +=method is_recycle_bin + + $bool = $group->is_recycle_bin; + +Get whether or not a group is the recycle bin of its connected database. + +=cut + +sub is_recycle_bin { + my $self = shift; + my $kdbx = eval { $self->kdbx } or return FALSE; + my $group = $kdbx->recycle_bin; + return $group && Hash::Util::FieldHash::id($group) == Hash::Util::FieldHash::id($self); +} + +=method is_entry_templates + + $bool = $group->is_entry_templates; + +Get whether or not a group is the group containing entry template in its connected database. + +=cut + +sub is_entry_templates { + my $self = shift; + my $kdbx = eval { $self->kdbx } or return FALSE; + my $group = $kdbx->entry_templates; + return $group && Hash::Util::FieldHash::id($group) == Hash::Util::FieldHash::id($self); +} + +=method is_last_selected + + $bool = $group->is_last_selected; + +Get whether or not a group is the prior selected group of its connected database. + +=cut + +sub is_last_selected { + my $self = shift; + my $kdbx = eval { $self->kdbx } or return FALSE; + my $group = $kdbx->last_selected; + return $group && Hash::Util::FieldHash::id($group) == Hash::Util::FieldHash::id($self); +} + +=method is_last_top_visible + + $bool = $group->is_last_top_visible; + +Get whether or not a group is the latest top visible group of its connected database. + +=cut + +sub is_last_top_visible { + my $self = shift; + my $kdbx = eval { $self->kdbx } or return FALSE; + my $group = $kdbx->last_top_visible; + return $group && Hash::Util::FieldHash::id($group) == Hash::Util::FieldHash::id($self); +} + =method path $string = $group->path; @@ -307,8 +602,6 @@ etc. A group not in a database tree structure returns a depth of -1. sub depth { $_[0]->is_root ? 0 : (scalar @{$_[0]->lineage || []} || -1) } -sub label { shift->name(@_) } - sub _signal { my $self = shift; my $type = shift; @@ -322,55 +615,25 @@ sub _commit { $self->last_access_time($time); } -1; -__END__ - -=head1 DESCRIPTION - -=attr uuid - -=attr name - -=attr notes - -=attr tags - -=attr icon_id - -=attr custom_icon_uuid - -=attr is_expanded - -=attr default_auto_type_sequence - -=attr enable_auto_type - -=attr enable_searching - -=attr last_top_visible_entry - -=attr custom_data - -=attr previous_parent_group - -=attr entries - -=attr groups - -=attr last_modification_time +sub label { shift->name(@_) } -=attr creation_time +### Name of the parent attribute expected to contain the object +sub _parent_container { 'groups' } -=attr last_access_time +1; +__END__ -=attr expiry_time +=for Pod::Coverage times -=attr expires +=head1 DESCRIPTION -=attr usage_count +A group in a KDBX database is a type of object that can contain entries and other groups. -=attr location_changed +There is also some metadata associated with a group. Each group in a database is identified uniquely by +a UUID. An entry can also have an icon associated with it, and there are various timestamps. Take a look at +the attributes to see what's available. -Get or set various group fields. +A B is a subclass of L. View its documentation to see other attributes +and methods available on groups. =cut