X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FGroup.pm;h=bbd3fc2b4a42519fae77598bc248ac1c1d6251a5;hb=8ccefe1cedea9b0886a44ad096aa5710528eaac7;hp=3aa562ac7631bf0d85a169b2520fec68c0b4c6ac;hpb=1b913e5c8826cae2355b0076ec5701aa3ce63c63;p=chaz%2Fp5-File-KDBX

diff --git a/lib/File/KDBX/Group.pm b/lib/File/KDBX/Group.pm
index 3aa562a..bbd3fc2 100644
--- a/lib/File/KDBX/Group.pm
+++ b/lib/File/KDBX/Group.pm
@@ -5,70 +5,53 @@ 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(generate_uuid);
-use List::Util qw(sum0);
-use Ref::Util qw(is_ref);
-use Scalar::Util qw(blessed refaddr);
+use File::KDBX::Iterator;
+use File::KDBX::Util qw(:assert :class :coercion generate_uuid);
+use Hash::Util::FieldHash;
+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' }
 
-my @ATTRS = qw(uuid custom_data entries groups);
-my %ATTRS = (
-    # uuid                        => sub { generate_uuid(printable => 1) },
-    name                        => '',
-    notes                       => '',
-    tags                        => '',
-    icon_id                     => 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 { gmtime },
-    creation_time           => sub { gmtime },
-    last_access_time        => sub { gmtime },
-    expiry_time             => sub { gmtime },
-    expires                 => false,
-    usage_count             => 0,
-    location_changed        => sub { gmtime },
-);
-
-while (my ($attr, $default) = each %ATTRS) {
-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    *{$attr} = sub {
-        my $self = shift;
-        $self->{$attr} = shift if @_;
-        $self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
-    };
-}
-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;
-    };
-}
+# 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;
 
-sub _set_default_attributes {
+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 {
@@ -77,9 +60,7 @@ sub uuid {
         my %args = @_ % 2 == 1 ? (uuid => shift, @_) : @_;
         my $old_uuid = $self->{uuid};
         my $uuid = $self->{uuid} = delete $args{uuid} // generate_uuid;
-        # if (defined $old_uuid and my $kdbx = $KDBX{refaddr($self)}) {
-        #     $kdbx->_update_group_uuid($old_uuid, $uuid, $self);
-        # }
+        $self->_signal('uuid.changed', $uuid, $old_uuid) if defined $old_uuid;
     }
     $self->{uuid};
 }
@@ -89,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
@@ -122,19 +125,20 @@ 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);
 }
 
 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;
     }
 }
 
@@ -143,15 +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;
 }
 
-sub all_groups {
+sub groups_deeply {
     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 '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 '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(@_) }
@@ -178,23 +213,51 @@ 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);
 }
 
 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;
     }
 }
 
 ##############################################################################
 
+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);
@@ -241,14 +304,74 @@ 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;
-    return refaddr($kdbx->root) == refaddr($self);
+    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
@@ -306,6 +429,46 @@ sub depth { $_[0]->is_root ? 0 : (scalar @{$_[0]->lineage || []} || -1) }
 
 sub label { shift->name(@_) }
 
+sub _signal {
+    my $self = shift;
+    my $type = shift;
+    return $self->SUPER::_signal("group.$type", @_);
+}
+
+sub _commit {
+    my $self = shift;
+    my $time = gmtime;
+    $self->last_modification_time($time);
+    $self->last_access_time($time);
+}
+
+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;
+}
+
+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;
+}
+
+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;
+}
+
 1;
 __END__