X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FGroup.pm;h=bbd3fc2b4a42519fae77598bc248ac1c1d6251a5;hb=8ccefe1cedea9b0886a44ad096aa5710528eaac7;hp=e801a8d01b4f736eed14c53ae6ec5fc5a0dd7955;hpb=c98fc7d0294e641cf8844306808333bdec4fea2f;p=chaz%2Fp5-File-KDBX diff --git a/lib/File/KDBX/Group.pm b/lib/File/KDBX/Group.pm index e801a8d..bbd3fc2 100644 --- a/lib/File/KDBX/Group.pm +++ b/lib/File/KDBX/Group.pm @@ -5,11 +5,12 @@ use warnings; use strict; use Devel::GlobalDestruction; -use File::KDBX::Constants qw(:icon); +use File::KDBX::Constants qw(:bool :icon); use File::KDBX::Error; -use File::KDBX::Util qw(:class :coercion 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; @@ -69,15 +70,37 @@ sub uuid { 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; } -sub all_entries { +sub entries_deeply { 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->groups_deeply(%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 @@ -108,11 +131,13 @@ sub add_entry { 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; - $o->_set_group(undef)->_signal('removed'); + 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; } } @@ -122,49 +147,46 @@ sub remove_entry { 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 - - \@groups = $group->all_groups(%options); - -Get all groups within a group, deeply, in a flat array. Supported options: - -=cut - -sub all_groups { +sub groups_deeply { my $self = shift; + my %args = @_; - my @groups; - for my $subgroup (@{$self->groups}) { - push @groups, @{$subgroup->all_groups}; + my @groups = ($args{inclusive} // 1) ? $self : @{$self->groups}; + my $algo = lc($args{algorithm} || 'ids'); + + if ($algo eq '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; + }); } - - return \@groups; -} - -=method find_groups - - @groups = $kdbx->find_groups($query, %options); - -Find all groups deeply that match to a query. Options are the same as for L. - -See L for a description of what C<$query> can be. - -=cut - -sub find_groups { - my $self = shift; - my $query = shift or throw 'Must provide a query'; - my %args = @_; - my %all_groups = ( # FIXME - base => $args{base}, - inclusive => $args{inclusive}, - ); - return @{search($self->all_groups(%all_groups), is_arrayref($query) ? @$query : $query)}; + elsif ($algo eq '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(@_) } @@ -197,17 +219,45 @@ sub add_group { 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)->_signal('removed'); + 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; } } ############################################################################## +sub objects_deeply { + 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->groups_deeply(%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); @@ -254,16 +304,76 @@ sub remove_object { $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 of its connected database. + +=cut + +sub 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 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 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; @@ -337,7 +447,7 @@ sub effective_default_auto_type_sequence { my $sequence = $self->default_auto_type_sequence; return $sequence if defined $sequence; - my $parent = $self->parent or return '{USERNAME}{TAB}{PASSWORD}{ENTER}'; + my $parent = $self->group or return '{USERNAME}{TAB}{PASSWORD}{ENTER}'; return $parent->effective_default_auto_type_sequence; } @@ -346,7 +456,7 @@ sub effective_enable_auto_type { my $enabled = $self->enable_auto_type; return $enabled if defined $enabled; - my $parent = $self->parent or return true; + my $parent = $self->group or return true; return $parent->effective_enable_auto_type; } @@ -355,7 +465,7 @@ sub effective_enable_searching { my $enabled = $self->enable_searching; return $enabled if defined $enabled; - my $parent = $self->parent or return true; + my $parent = $self->group or return true; return $parent->effective_enable_searching; }