X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FGroup.pm;h=0870dd1ffb8ab585016c5a684d6b05993e3bd019;hb=37b09e0f2832514b33de4499a83f22d5ffe7c0a3;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..0870dd1 100644 --- a/lib/File/KDBX/Group.pm +++ b/lib/File/KDBX/Group.pm @@ -7,63 +7,58 @@ 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_ref); -use Scalar::Util qw(blessed refaddr); +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 = qw(uuid custom_data entries groups icon_id); 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 { +[] }, + name => ['', coerce => \&to_string], + notes => ['', coerce => \&to_string], + tags => ['', coerce => \&to_string], + # icon_id => sub { defined $_[1] ? icon($_[1]) : ICON_FOLDER }, + custom_icon_uuid => [undef, coerce => \&to_uuid], + is_expanded => [false, coerce => \&to_bool], + default_auto_type_sequence => ['', coerce => \&to_string], + enable_auto_type => [undef, coerce => \&to_tristate], + enable_searching => [undef, coerce => \&to_tristate], + last_top_visible_entry => [undef, coerce => \&to_uuid], + # custom_data => {}, + previous_parent_group => [undef, coerce => \&to_uuid], + # entries => [], + # groups => [], + times => [{}], ); + 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 }, + last_modification_time => [sub { gmtime }, coerce => \&to_time], + creation_time => [sub { gmtime }, coerce => \&to_time], + last_access_time => [sub { gmtime }, coerce => \&to_time], + expiry_time => [sub { gmtime }, coerce => \&to_time], + expires => [false, coerce => \&to_bool], + usage_count => [0, coerce => \&to_number], + location_changed => [sub { gmtime }, coerce => \&to_time], ); +has icon_id => ICON_FOLDER, coerce => sub { icon($_[0]) }; + 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; - }; + has $attr => @$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 $attr => @$default, store => 'times'; } sub _set_default_attributes { @@ -77,9 +72,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}; } @@ -248,7 +241,7 @@ Determine if a group is the root group of its associated database. sub is_root { my $self = shift; my $kdbx = eval { $self->kdbx } or return; - return refaddr($kdbx->root) == refaddr($self); + return Hash::Util::FieldHash::id($kdbx->root) == Hash::Util::FieldHash::id($self); } =method path @@ -306,6 +299,19 @@ 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); +} + 1; __END__