my $self = bless {}, $class;
$self->init(@_);
- $self->_set_default_attributes if empty $self;
+ $self->_set_nonlazy_attributes if empty $self;
return $self;
}
$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);
}
__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
}
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}};
) {
$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 (
) {
$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 (
) {
$ICON{$icon} = $ICON{0+$icon} = $icon;
}
-sub icon { $ICON{$_[0] // ''} // ICON_PASSWORD }
+sub to_icon_constant { $ICON{$_[0] // ''} // ICON_PASSWORD }
1;
__END__
= 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.
= 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.
= 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.
= 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.
my $type = shift;
my $val = shift // '';
- $type = kdbx_header($type);
+ $type = to_header_constant($type);
if ($type == HEADER_END) {
$val = "\r\n\r\n";
}
my $type = shift;
my $val = shift // '';
- $type = kdbx_header($type);
+ $type = to_header_constant($type);
if ($type == HEADER_END) {
# nothing
}
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
}
$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',
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 {
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 {
$buf .= $val;
}
- $type = kdbx_header($type);
+ $type = to_header_constant($type);
if ($type == HEADER_END) {
# done
}
$buf .= $val;
}
- $type = kdbx_header($type);
+ $type = to_header_constant($type);
if ($type == HEADER_END) {
# done
}
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;
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};
$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;
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
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)],
'=~' => '!~',
'!~' => '=~',
);
+my %ATTRIBUTES;
=func load_xs
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 {
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);
}), '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');
projects / chaz / p5-File-KDBX / commitdiff
