Add function for creating class attributes

[chaz/p5-File-KDBX] / lib / File / KDBX / Group.pm

diff --git a/lib/File/KDBX/Group.pm b/lib/File/KDBX/Group.pm
index 3aa562ac7631bf0d85a169b2520fec68c0b4c6ac..0870dd1ffb8ab585016c5a684d6b05993e3bd019 100644 (file)
--- 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__