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_ref);
+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 {
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{$self}) {
- # $kdbx->_update_group_uuid($old_uuid, $uuid, $self);
- # }
+ $self->_signal('uuid.changed', $uuid, $old_uuid) if defined $old_uuid;
}
$self->{uuid};
}
$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 {
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;
}
}
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</all_groups>.
+
+See L</QUERY> 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(@_) }
$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 {
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;
}
}
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->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__
projects / chaz / p5-File-KDBX / blobdiff