X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;ds=sidebyside;f=lib%2FFile%2FKDBX%2FGroup.pm;h=e801a8d01b4f736eed14c53ae6ec5fc5a0dd7955;hb=c98fc7d0294e641cf8844306808333bdec4fea2f;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..e801a8d 100644 --- a/lib/File/KDBX/Group.pm +++ b/lib/File/KDBX/Group.pm @@ -7,7 +7,7 @@ use strict; use Devel::GlobalDestruction; use File::KDBX::Constants qw(:icon); use File::KDBX::Error; -use File::KDBX::Util qw(generate_uuid); +use File::KDBX::Util qw(:class :coercion generate_uuid); use Hash::Util::FieldHash; use List::Util qw(sum0); use Ref::Util qw(is_coderef is_ref); @@ -16,64 +16,41 @@ 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 => 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; - }; -} +# 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 { @@ -125,7 +102,7 @@ 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 { @@ -135,9 +112,8 @@ sub remove_entry { for (my $i = 0; $i < @$objects; ++$i) { my $o = $objects->[$i]; next if $uuid ne $o->uuid; + $o->_set_group(undef)->_signal('removed'); return splice @$objects, $i, 1; - $o->_set_group(undef); - return @$objects, $i, 1; } } @@ -151,10 +127,44 @@ sub 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 { 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 @groups; + for my $subgroup (@{$self->groups}) { + push @groups, @{$subgroup->all_groups}; + } + + 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)}; } sub _kpx_groups { shift->groups(@_) } @@ -181,7 +191,7 @@ 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 { @@ -191,7 +201,7 @@ sub remove_group { for (my $i = 0; $i < @$objects; ++$i) { my $o = $objects->[$i]; next if $uuid ne $o->uuid; - $o->_set_group(undef); + $o->_set_group(undef)->_signal('removed'); return splice @$objects, $i, 1; } } @@ -322,6 +332,33 @@ sub _commit { $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->parent 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->parent 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->parent or return true; + return $parent->effective_enable_searching; +} + 1; __END__