]> Dogcows Code - chaz/p5-File-KDBX/commitdiff
Further expand support for attributes
authorCharles McGarvey <ccm@cpan.org>
Sun, 24 Apr 2022 20:11:10 +0000 (14:11 -0600)
committerCharles McGarvey <ccm@cpan.org>
Sun, 1 May 2022 00:29:00 +0000 (18:29 -0600)
lib/File/KDBX.pm
lib/File/KDBX/Constants.pm
lib/File/KDBX/Dumper/V3.pm
lib/File/KDBX/Dumper/V4.pm
lib/File/KDBX/Entry.pm
lib/File/KDBX/Group.pm
lib/File/KDBX/Loader/V3.pm
lib/File/KDBX/Loader/V4.pm
lib/File/KDBX/Object.pm
lib/File/KDBX/Util.pm
t/entry.t

index a0f815e703197d83c9a0895cee43552a6cf14ab1..2e7c1e505fd7346774b0dd56fa427f7bbedab688 100644 (file)
@@ -40,7 +40,7 @@ sub new {
 
     my $self = bless {}, $class;
     $self->init(@_);
-    $self->_set_default_attributes if empty $self;
+    $self->_set_nonlazy_attributes if empty $self;
     return $self;
 }
 
@@ -120,6 +120,9 @@ sub STORABLE_thaw {
     $KEYS{$self} = $key;
     $SAFE{$self} = $safe;
 
+    # Dualvars aren't cloned as dualvars, so coerce the compression flags.
+    $self->compression_flags($self->compression_flags);
+
     for my $object (@{$self->all_groups}, @{$self->all_entries(history => 1)}) {
         $object->kdbx($self);
     }
@@ -223,99 +226,82 @@ sub user_agent_string {
         __PACKAGE__, $VERSION, @Config::Config{qw(package version osname osvers archname)});
 }
 
-my %ATTRS = (
-    sig1            => [KDBX_SIG1, coerce => \&to_number],
-    sig2            => [KDBX_SIG2_2, coerce => \&to_number],
-    version         => [KDBX_VERSION_3_1, coerce => \&to_number],
-    headers         => [{}],
-    inner_headers   => [{}],
-    meta            => [{}],
-    binaries        => [{}],
-    deleted_objects => [{}],
-    raw             => [undef, coerce => \&to_string],
-);
-my %ATTRS_HEADERS = (
-    HEADER_COMMENT()                    => ['', coerce => \&to_string],
-    HEADER_CIPHER_ID()                  => [CIPHER_UUID_CHACHA20, coerce => \&to_uuid],
-    HEADER_COMPRESSION_FLAGS()          => [COMPRESSION_GZIP, coerce => sub { compression($_[0]) }],
-    HEADER_MASTER_SEED()                => [sub { random_bytes(32) }, coerce => \&to_string],
-    # HEADER_TRANSFORM_SEED()             => sub { random_bytes(32) },
-    # HEADER_TRANSFORM_ROUNDS()           => 100_000,
-    HEADER_ENCRYPTION_IV()              => [sub { random_bytes(16) }, coerce => \&to_string],
-    # HEADER_INNER_RANDOM_STREAM_KEY()    => sub { random_bytes(32) }, # 64?
-    HEADER_STREAM_START_BYTES()         => [sub { random_bytes(32) }, coerce => \&to_string],
-    # HEADER_INNER_RANDOM_STREAM_ID()     => STREAM_ID_CHACHA20,
-    HEADER_KDF_PARAMETERS()             => [sub {
-        +{
-            KDF_PARAM_UUID()        => KDF_UUID_AES,
-            KDF_PARAM_AES_ROUNDS()  => $_[0]->headers->{+HEADER_TRANSFORM_ROUNDS} // KDF_DEFAULT_AES_ROUNDS,
-            KDF_PARAM_AES_SEED()    => $_[0]->headers->{+HEADER_TRANSFORM_SEED} // random_bytes(32),
-        };
-    }],
-    # HEADER_PUBLIC_CUSTOM_DATA()        => sub { +{} },
-);
-my %ATTRS_META = (
-    generator                       => ['', coerce => \&to_string],
-    header_hash                     => ['', coerce => \&to_string],
-    database_name                   => ['', coerce => \&to_string],
-    database_name_changed           => [sub { gmtime }, coerce => \&to_time],
-    database_description            => ['', coerce => \&to_string],
-    database_description_changed    => [sub { gmtime }, coerce => \&to_time],
-    default_username                => ['', coerce => \&to_string],
-    default_username_changed        => [sub { gmtime }, coerce => \&to_time],
-    maintenance_history_days        => [0, coerce => \&to_number],
-    color                           => ['', coerce => \&to_string],
-    master_key_changed              => [sub { gmtime }, coerce => \&to_time],
-    master_key_change_rec           => [-1, coerce => \&to_number],
-    master_key_change_force         => [-1, coerce => \&to_number],
-    # memory_protection               => {},
-    custom_icons                    => [{}],
-    recycle_bin_enabled             => [true, coerce => \&to_bool],
-    recycle_bin_uuid                => ["\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", coerce => \&to_uuid],
-    recycle_bin_changed             => [sub { gmtime }, coerce => \&to_time],
-    entry_templates_group           => ["\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", coerce => \&to_uuid],
-    entry_templates_group_changed   => [sub { gmtime }, coerce => \&to_time],
-    last_selected_group             => ["\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", coerce => \&to_uuid],
-    last_top_visible_group          => ["\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0", coerce => \&to_uuid],
-    history_max_items               => [HISTORY_DEFAULT_MAX_ITEMS, coerce => \&to_number],
-    history_max_size                => [HISTORY_DEFAULT_MAX_SIZE, coerce => \&to_number],
-    settings_changed                => [sub { gmtime }, coerce => \&to_time],
-    # binaries                        => {},
-    # custom_data                     => {},
-);
-my %ATTRS_MEMORY_PROTECTION = (
-    protect_title               => [false, coerce => \&to_bool],
-    protect_username            => [false, coerce => \&to_bool],
-    protect_password            => [true,  coerce => \&to_bool],
-    protect_url                 => [false, coerce => \&to_bool],
-    protect_notes               => [false, coerce => \&to_bool],
-    # auto_enable_visual_hiding   => false,
-);
-
-while (my ($attr, $default) = each %ATTRS) {
-    has $attr => @$default;
-}
-while (my ($attr, $default) = each %ATTRS_HEADERS) {
-    has $attr => @$default, store => 'headers';
-}
-while (my ($attr, $default) = each %ATTRS_META) {
-    has $attr => @$default, store => 'meta';
-}
-while (my ($attr, $default) = each %ATTRS_MEMORY_PROTECTION) {
-    has $attr => @$default, store => 'memory_protection';
-}
-
-my @ATTRS_OTHER = (
+has sig1            => KDBX_SIG1,        coerce => \&to_number;
+has sig2            => KDBX_SIG2_2,      coerce => \&to_number;
+has version         => KDBX_VERSION_3_1, coerce => \&to_number;
+has headers         => {};
+has inner_headers   => {};
+has meta            => {};
+has binaries        => {};
+has deleted_objects => {};
+has raw             => coerce => \&to_string;
+
+# HEADERS
+has 'headers.comment'               => '', coerce => \&to_string;
+has 'headers.cipher_id'             => CIPHER_UUID_CHACHA20, coerce => \&to_uuid;
+has 'headers.compression_flags'     => COMPRESSION_GZIP, coerce => \&to_compression_constant;
+has 'headers.master_seed'           => sub { random_bytes(32) }, coerce => \&to_string;
+has 'headers.encryption_iv'         => sub { random_bytes(16) }, coerce => \&to_string;
+has 'headers.stream_start_bytes'    => sub { random_bytes(32) }, coerce => \&to_string;
+has 'headers.kdf_parameters'        => sub {
+    +{
+        KDF_PARAM_UUID()        => KDF_UUID_AES,
+        KDF_PARAM_AES_ROUNDS()  => $_[0]->headers->{+HEADER_TRANSFORM_ROUNDS} // KDF_DEFAULT_AES_ROUNDS,
+        KDF_PARAM_AES_SEED()    => $_[0]->headers->{+HEADER_TRANSFORM_SEED} // random_bytes(32),
+    };
+};
+# has 'headers.transform_seed'            => sub { random_bytes(32) };
+# has 'headers.transform_rounds'          => 100_000;
+# has 'headers.inner_random_stream_key'   => sub { random_bytes(32) }; # 64 ?
+# has 'headers.inner_random_stream_id'    => STREAM_ID_CHACHA20;
+# has 'headers.public_custom_data'        => {};
+
+# META
+has 'meta.generator'                        => '',                          coerce => \&to_string;
+has 'meta.header_hash'                      => '',                          coerce => \&to_string;
+has 'meta.database_name'                    => '',                          coerce => \&to_string;
+has 'meta.database_name_changed'            => sub { gmtime },              coerce => \&to_time;
+has 'meta.database_description'             => '',                          coerce => \&to_string;
+has 'meta.database_description_changed'     => sub { gmtime },              coerce => \&to_time;
+has 'meta.default_username'                 => '',                          coerce => \&to_string;
+has 'meta.default_username_changed'         => sub { gmtime },              coerce => \&to_time;
+has 'meta.maintenance_history_days'         => 0,                           coerce => \&to_number;
+has 'meta.color'                            => '',                          coerce => \&to_string;
+has 'meta.master_key_changed'               => sub { gmtime },              coerce => \&to_time;
+has 'meta.master_key_change_rec'            => -1,                          coerce => \&to_number;
+has 'meta.master_key_change_force'          => -1,                          coerce => \&to_number;
+# has 'meta.memory_protection'                => {};
+has 'meta.custom_icons'                     => {};
+has 'meta.recycle_bin_enabled'              => true,                        coerce => \&to_bool;
+has 'meta.recycle_bin_uuid'                 => "\0" x 16,                   coerce => \&to_uuid;
+has 'meta.recycle_bin_changed'              => sub { gmtime },              coerce => \&to_time;
+has 'meta.entry_templates_group'            => "\0" x 16,                   coerce => \&to_uuid;
+has 'meta.entry_templates_group_changed'    => sub { gmtime },              coerce => \&to_time;
+has 'meta.last_selected_group'              => "\0" x 16,                   coerce => \&to_uuid;
+has 'meta.last_top_visible_group'           => "\0" x 16,                   coerce => \&to_uuid;
+has 'meta.history_max_items'                => HISTORY_DEFAULT_MAX_ITEMS,   coerce => \&to_number;
+has 'meta.history_max_size'                 => HISTORY_DEFAULT_MAX_SIZE,    coerce => \&to_number;
+has 'meta.settings_changed'                 => sub { gmtime },              coerce => \&to_time;
+# has 'meta.binaries'                         => {};
+# has 'meta.custom_data'                      => {};
+
+has 'memory_protection.protect_title'       => false,   coerce => \&to_bool;
+has 'memory_protection.protect_username'    => false,   coerce => \&to_bool;
+has 'memory_protection.protect_password'    => true,    coerce => \&to_bool;
+has 'memory_protection.protect_url'         => false,   coerce => \&to_bool;
+has 'memory_protection.protect_notes'       => false,   coerce => \&to_bool;
+# has 'memory_protection.auto_enable_visual_hiding'   => false;
+
+my @ATTRS = (
     HEADER_TRANSFORM_SEED,
     HEADER_TRANSFORM_ROUNDS,
     HEADER_INNER_RANDOM_STREAM_KEY,
     HEADER_INNER_RANDOM_STREAM_ID,
     HEADER_PUBLIC_CUSTOM_DATA,
 );
-sub _set_default_attributes {
+sub _set_nonlazy_attributes {
     my $self = shift;
-    $self->$_ for keys %ATTRS, keys %ATTRS_HEADERS, keys %ATTRS_META, keys %ATTRS_MEMORY_PROTECTION,
-        @ATTRS_OTHER;
+    $self->$_ for list_attributes(ref $self), @ATTRS;
 }
 
 =method memory_protection
index fe806242adefadae5090249e022c85bfa080e2a2..6eea0ef01cfb2f80bc877cc3a4ba5aa329bb3fac 100644 (file)
@@ -274,10 +274,10 @@ BEGIN {
 }
 
 our %EXPORT_TAGS;
-push @{$EXPORT_TAGS{header}}, 'kdbx_header';
-push @{$EXPORT_TAGS{compression}}, 'compression';
-push @{$EXPORT_TAGS{inner_header}}, 'kdbx_inner_header';
-push @{$EXPORT_TAGS{icon}}, 'icon';
+push @{$EXPORT_TAGS{header}},       'to_header_constant';
+push @{$EXPORT_TAGS{compression}},  'to_compression_constant';
+push @{$EXPORT_TAGS{inner_header}}, 'to_inner_header_constant';
+push @{$EXPORT_TAGS{icon}},         'to_icon_constant';
 
 $EXPORT_TAGS{all} = [map { @$_ } values %EXPORT_TAGS];
 our @EXPORT_OK = sort @{$EXPORT_TAGS{all}};
@@ -291,13 +291,13 @@ for my $header (
 ) {
     $HEADER{$header} = $HEADER{0+$header} = $header;
 }
-sub kdbx_header { $HEADER{$_[0]} }
+sub to_header_constant { $HEADER{$_[0]} }
 
 my %COMPRESSION;
 for my $compression (COMPRESSION_NONE, COMPRESSION_GZIP) {
     $COMPRESSION{$compression} = $COMPRESSION{0+$compression} = $compression;
 }
-sub compression { $COMPRESSION{$_[0]} }
+sub to_compression_constant { $COMPRESSION{$_[0]} }
 
 my %INNER_HEADER;
 for my $inner_header (
@@ -306,7 +306,7 @@ for my $inner_header (
 ) {
     $INNER_HEADER{$inner_header} = $INNER_HEADER{0+$inner_header} = $inner_header;
 }
-sub kdbx_inner_header { $INNER_HEADER{$_[0]} }
+sub to_inner_header_constant { $INNER_HEADER{$_[0]} }
 
 my %ICON;
 for my $icon (
@@ -324,7 +324,7 @@ for my $icon (
 ) {
     $ICON{$icon} = $ICON{0+$icon} = $icon;
 }
-sub icon { $ICON{$_[0] // ''} // ICON_PASSWORD }
+sub to_icon_constant { $ICON{$_[0] // ''} // ICON_PASSWORD }
 
 1;
 __END__
@@ -406,10 +406,10 @@ Constants related to parsing and generating KDBX file headers:
 = C<HEADER_KDF_PARAMETERS>
 = C<HEADER_PUBLIC_CUSTOM_DATA>
 
-=func kdbx_header
+=func to_header_constant
 
-    $constant = kdbx_header($number);
-    $constant = kdbx_header($string);
+    $constant = to_header_constant($number);
+    $constant = to_header_constant($string);
 
 Get a header constant from an integer or string value.
 
@@ -421,10 +421,10 @@ Constants related to identifying the compression state of a file:
 = C<COMPRESSION_NONE>
 = C<COMPRESSION_GZIP>
 
-=func compression
+=func to_compression_constant
 
-    $constant = compression($number);
-    $constant = compression($string);
+    $constant = to_compression_constant($number);
+    $constant = to_compression_constant($string);
 
 Get a compression constant from an integer or string value.
 
@@ -504,10 +504,10 @@ Constants related to parsing and generating KDBX4 inner headers:
 = C<INNER_HEADER_BINARY>
 = C<INNER_HEADER_BINARY_FLAG_PROTECT>
 
-=func kdbx_inner_header
+=func to_inner_header_constant
 
-    $constant = kdbx_inner_header($number);
-    $constant = kdbx_inner_header($string);
+    $constant = to_inner_header_constant($number);
+    $constant = to_inner_header_constant($string);
 
 Get an inner header constant from an integer or string value.
 
@@ -604,10 +604,10 @@ Constants for default icons used by KeePass password safe implementations:
 = C<ICON_CERTIFICATE>
 = C<ICON_SMARTPHONE>
 
-=func icon
+=func to_icon_constant
 
-    $constant = icon($number);
-    $constant = icon($string);
+    $constant = to_icon_constant($number);
+    $constant = to_icon_constant($string);
 
 Get an icon constant from an integer or string value.
 
index b8cf01c1f056ca3f2c0020d448752f4ce72834a9..a0d5b4df0ee6b15b266405dfca1fc1fbde072712 100644 (file)
@@ -59,7 +59,7 @@ sub _write_header {
     my $type = shift;
     my $val  = shift // '';
 
-    $type = kdbx_header($type);
+    $type = to_header_constant($type);
     if ($type == HEADER_END) {
         $val = "\r\n\r\n";
     }
index f2a8574e8b55413419c4b9c974340cc5e5d11549..c002f0bbdd1a37a1cd374464a1d39ffc315be502 100644 (file)
@@ -61,7 +61,7 @@ sub _write_header {
     my $type = shift;
     my $val  = shift // '';
 
-    $type = kdbx_header($type);
+    $type = to_header_constant($type);
     if ($type == HEADER_END) {
         # nothing
     }
@@ -289,8 +289,7 @@ sub _write_inner_header {
     my $buf = pack('C', $type);
     $fh->print($buf) or throw 'Failed to write inner header type';
 
-    $type = kdbx_inner_header($type);
-
+    $type = to_inner_header_constant($type);
     if ($type == INNER_HEADER_END) {
         # nothing
     }
index fc744fd8c3c00c3c9e47deadc9f8a7d71db05a17..0ad08a0c898c69010db4b98bafcf749357af3c89 100644 (file)
@@ -175,33 +175,30 @@ sub uuid {
     $self->{uuid};
 }
 
-my @ATTRS = qw(uuid custom_data history icon_id);
-my %ATTRS = (
-    # uuid                    => sub { generate_uuid(printable => 1) },
-    # icon_id                 => sub { defined $_[1] ? icon($_[1]) : ICON_PASSWORD },
-    custom_icon_uuid        => [undef,  coerce => \&to_uuid],
-    foreground_color        => ['',     coerce => \&to_string],
-    background_color        => ['',     coerce => \&to_string],
-    override_url            => ['',     coerce => \&to_string],
-    tags                    => ['',     coerce => \&to_string],
-    auto_type               => [{}],
-    previous_parent_group   => [undef,  coerce => \&to_uuid],
-    quality_check           => [true,   coerce => \&to_bool],
-    strings                 => [{}],
-    binaries                => [{}],
-    times                   => [{}],
-    # custom_data             => {},
-    # history                 => [],
-);
-my %ATTRS_TIMES = (
-    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 uuid                    => sub { generate_uuid(printable => 1) };
+has icon_id                 => ICON_PASSWORD,   coerce => \&to_icon_constant;
+has custom_icon_uuid        => undef,           coerce => \&to_uuid;
+has foreground_color        => '',              coerce => \&to_string;
+has background_color        => '',              coerce => \&to_string;
+has override_url            => '',              coerce => \&to_string;
+has tags                    => '',              coerce => \&to_string;
+has auto_type               => {};
+has previous_parent_group   => undef,           coerce => \&to_uuid;
+has quality_check           => true,            coerce => \&to_bool;
+has strings                 => {};
+has binaries                => {};
+has times                   => {};
+# has custom_data             => {};
+# has history                 => [];
+
+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;
+
 my %ATTRS_STRINGS = (
     title                   => 'Title',
     username                => 'UserName',
@@ -209,24 +206,16 @@ my %ATTRS_STRINGS = (
     url                     => 'URL',
     notes                   => 'Notes',
 );
-
-has icon_id => ICON_PASSWORD, coerce => sub { icon($_[0]) };
-
-while (my ($attr, $default) = each %ATTRS) {
-    has $attr => @$default;
-}
-while (my ($attr, $default) = each %ATTRS_TIMES) {
-    has $attr => @$default, store => 'times';
-}
 while (my ($attr, $string_key) = each %ATTRS_STRINGS) {
     no strict 'refs'; ## no critic (ProhibitNoStrict)
     *{$attr} = sub { shift->string_value($string_key, @_) };
     *{"expanded_${attr}"} = sub { shift->expanded_string_value($string_key, @_) };
 }
 
-sub _set_default_attributes {
+my @ATTRS = qw(uuid custom_data history);
+sub _set_nonlazy_attributes {
     my $self = shift;
-    $self->$_ for @ATTRS, keys %ATTRS, keys %ATTRS_TIMES, keys %ATTRS_STRINGS;
+    $self->$_ for @ATTRS, keys %ATTRS_STRINGS, list_attributes(ref $self);
 }
 
 sub init {
index 0870dd1ffb8ab585016c5a684d6b05993e3bd019..87cda2aa187649caf11389ca2db0ef9de0045585 100644 (file)
@@ -22,48 +22,35 @@ our $VERSION = '999.999'; # VERSION
 
 sub _parent_container { 'groups' }
 
-my @ATTRS = qw(uuid custom_data entries groups icon_id);
-my %ATTRS = (
-    # uuid                        => sub { generate_uuid(printable => 1) },
-    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 }, 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) {
-    has $attr => @$default;
-}
-while (my ($attr, $default) = each %ATTRS_TIMES) {
-    has $attr => @$default, store => 'times';
-}
-
-sub _set_default_attributes {
+# 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;
+
+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 {
index 4b89fe97792f2c23617e7a7483a80f11d90818c6..e65a5e761563b69e54290bc5c7cd28a42998fa4f 100644 (file)
@@ -42,7 +42,7 @@ sub _read_header {
         $buf .= $val;
     }
 
-    $type = kdbx_header($type);
+    $type = to_header_constant($type);
     if ($type == HEADER_END) {
         # done
     }
index 87e88262588654b74fe0fad80946405306f74bb5..34802090cc422c71e30403f72765b3477a785738 100644 (file)
@@ -45,7 +45,7 @@ sub _read_header {
         $buf .= $val;
     }
 
-    $type = kdbx_header($type);
+    $type = to_header_constant($type);
     if ($type == HEADER_END) {
         # done
     }
@@ -225,10 +225,7 @@ sub _read_inner_header {
     my $fh   = shift;
     my $kdbx = $self->kdbx;
 
-    read_all $fh, my $buf, 5 or throw 'Expected inner header type and size',
-        compression_error   => $IO::Uncompress::Gunzip::GunzipError,
-        crypt_error         => $File::KDBX::IO::Crypt::ERROR,
-        hmac_error          => $File::KDBX::IO::HmacBLock::ERROR;
+    read_all $fh, my $buf, 5 or throw 'Expected inner header type and size';
     my ($type, $size) = unpack('C L<', $buf);
 
     my $val;
@@ -236,23 +233,18 @@ sub _read_inner_header {
         read_all $fh, $val, $size or throw 'Expected inner header value', type => $type, size => $size;
     }
 
-    my $dualtype = kdbx_inner_header($type);
-
-    if (!defined $dualtype) {
-        alert "Ignoring unknown inner header type ($type)", type => $type, size => $size, value => $val;
-        return wantarray ? ($type => $val) : $type;
-    }
-    elsif ($dualtype == INNER_HEADER_END) {
+    $type = to_inner_header_constant($type) // $type;
+    if ($type == INNER_HEADER_END) {
         # nothing
     }
-    elsif ($dualtype == INNER_HEADER_INNER_RANDOM_STREAM_ID) {
+    elsif ($type == INNER_HEADER_INNER_RANDOM_STREAM_ID) {
         $val = unpack('L<', $val);
-        $kdbx->inner_headers->{$dualtype} = $val;
+        $kdbx->inner_headers->{$type} = $val;
     }
-    elsif ($dualtype == INNER_HEADER_INNER_RANDOM_STREAM_KEY) {
-        $kdbx->inner_headers->{$dualtype} = $val;
+    elsif ($type == INNER_HEADER_INNER_RANDOM_STREAM_KEY) {
+        $kdbx->inner_headers->{$type} = $val;
     }
-    elsif ($dualtype == INNER_HEADER_BINARY) {
+    elsif ($type == INNER_HEADER_BINARY) {
         my $msize = $size - 1;
         my ($flags, $data) = unpack("C a$msize", $val);
         my $id = scalar keys %{$kdbx->binaries};
@@ -261,8 +253,12 @@ sub _read_inner_header {
             $flags & INNER_HEADER_BINARY_FLAG_PROTECT ? (protect => true) : (),
         };
     }
+    else {
+        alert "Ignoring unknown inner header type ($type)", type => $type, size => $size, value => $val;
+        return wantarray ? ($type => $val) : $type;
+    }
 
-    return wantarray ? ($dualtype => $val) : $dualtype;
+    return wantarray ? ($type => $val) : $type;
 }
 
 1;
index 0d53dd91e4885345d8099fa5dad276fdd392ca67..f01944a9d206f731c418610b8d72f38499505c1e 100644 (file)
@@ -73,11 +73,11 @@ sub new {
 
     my $self = bless $data // {}, $class;
     $self->init(%args);
-    $self->_set_default_attributes if !$data;
+    $self->_set_nonlazy_attributes if !$data;
     return $self;
 }
 
-sub _set_default_attributes { die 'Not implemented' }
+sub _set_nonlazy_attributes { die 'Not implemented' }
 
 =method init
 
index 3141c3fe969c35369482d84bd85c911a87b81647..c3d77ae69b2f08e156eeeb11ed29f330ee76fc53 100644 (file)
@@ -21,7 +21,7 @@ our $VERSION = '999.999'; # VERSION
 
 our %EXPORT_TAGS = (
     assert      => [qw(assert_64bit)],
-    class       => [qw(extends has)],
+    class       => [qw(extends has list_attributes)],
     clone       => [qw(clone clone_nomagic)],
     coercion    => [qw(to_bool to_number to_string to_time to_tristate to_uuid)],
     crypt       => [qw(pad_pkcs7)],
@@ -85,6 +85,7 @@ my %OP_NEG = (
     '=~'    =>  '!~',
     '!~'    =>  '=~',
 );
+my %ATTRIBUTES;
 
 =func load_xs
 
@@ -405,9 +406,14 @@ sub has {
     my $has_default = is_coderef $default;
     my $has_coerce  = is_coderef $coerce;
 
+    my $store = $args{store};
+    ($store, $name) = split(/\./, $name, 2) if $name =~ /\./;
+
     my $caller = caller;
+    push @{$ATTRIBUTES{$caller} //= []}, $name;
+
     no strict 'refs'; ## no critic (ProhibitNoStrict)
-    if (my $store = $args{store}) {
+    if ($store) {
         *{"${caller}::${name}"} = $is eq 'ro' && $has_default ? sub {
             $_[0]->$store->{$name} //= scalar $default->($_[0]);
         } : $is eq 'ro' ? sub {
@@ -574,6 +580,19 @@ Check if a thing is a UUID (i.e. scalar string of length 16).
 
 sub is_uuid { defined $_[0] && !is_ref($_[0]) && length($_[0]) == 16 }
 
+=func list_attributes
+
+    @attributes = list_attributes($package);
+
+Get a list of attributes for a class.
+
+=cut
+
+sub list_attributes {
+    my $package = shift;
+    return @{$ATTRIBUTES{$package} // []};
+}
+
 =func load_optional
 
     $package = load_optional($package);
index 6de80287b9974251d272b644971f22a824d6ac3d..3a6267d4a4059301f1d110fef993a80261e8a6ba 100644 (file)
--- a/t/entry.t
+++ b/t/entry.t
@@ -73,6 +73,14 @@ subtest 'Construction' => sub {
     }), 'Entry data contains UserName string and the rest default attributes';
 };
 
+subtest 'Accessors' => sub {
+    my $entry = File::KDBX::Entry->new;
+
+    $entry->creation_time('2022-02-02 12:34:56');
+    cmp_ok $entry->creation_time, '==', 1643805296, 'Creation time coerced into a Time::Piece (epoch)';
+    is $entry->creation_time->datetime, '2022-02-02T12:34:56', 'Creation time coerced into a Time::Piece';
+};
+
 subtest 'Custom icons' => sub {
     plan tests => 10;
     my $gif = pack('H*', '4749463839610100010000ff002c00000000010001000002003b');
This page took 0.046388 seconds and 4 git commands to generate.