Add function for creating class attributes

diff --git a/lib/File/KDBX.pm b/lib/File/KDBX.pm
index 2326b9b5d403f9ff2b631cc9e20c3b5c9c1ae466..a0f815e703197d83c9a0895cee43552a6cf14ab1 100644 (file)
--- a/lib/File/KDBX.pm
+++ b/lib/File/KDBX.pm
@@ -9,7 +9,7 @@ use Devel::GlobalDestruction;
 use File::KDBX::Constants qw(:all);
 use File::KDBX::Error;
 use File::KDBX::Safe;
 use File::KDBX::Constants qw(:all);
 use File::KDBX::Error;
 use File::KDBX::Safe;

-use File::KDBX::Util qw(:empty :uuid :search erase simple_expression_query snakify);
+use File::KDBX::Util qw(:class :coercion :empty :uuid :search erase simple_expression_query snakify);

 use Hash::Util::FieldHash qw(fieldhashes);
 use List::Util qw(any);
 use Ref::Util qw(is_ref is_arrayref is_plain_hashref);
 use Hash::Util::FieldHash qw(fieldhashes);
 use List::Util qw(any);
 use Ref::Util qw(is_ref is_arrayref is_plain_hashref);


@@ -224,105 +224,85 @@ sub user_agent_string {
 }
 
 my %ATTRS = (
 }
 
 my %ATTRS = (

-    sig1            => KDBX_SIG1,
-    sig2            => KDBX_SIG2_2,
-    version         => KDBX_VERSION_3_1,
-    headers         => sub { +{} },
-    inner_headers   => sub { +{} },
-    meta            => sub { +{} },
-    binaries        => sub { +{} },
-    deleted_objects => sub { +{} },
-    raw             => undef,
+    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 = (
 );
 my %ATTRS_HEADERS = (

-    HEADER_COMMENT()                    => '',
-    HEADER_CIPHER_ID()                  => CIPHER_UUID_CHACHA20,
-    HEADER_COMPRESSION_FLAGS()          => COMPRESSION_GZIP,
-    HEADER_MASTER_SEED()                => sub { random_bytes(32) },
+    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_TRANSFORM_SEED()             => sub { random_bytes(32) },
     # HEADER_TRANSFORM_ROUNDS()           => 100_000,

-    HEADER_ENCRYPTION_IV()              => sub { random_bytes(16) },
+    HEADER_ENCRYPTION_IV()              => [sub { random_bytes(16) }, coerce => \&to_string],

     # HEADER_INNER_RANDOM_STREAM_KEY()    => sub { random_bytes(32) }, # 64?
     # HEADER_INNER_RANDOM_STREAM_KEY()    => sub { random_bytes(32) }, # 64?

-    HEADER_STREAM_START_BYTES()         => sub { random_bytes(32) },
+    HEADER_STREAM_START_BYTES()         => [sub { random_bytes(32) }, coerce => \&to_string],

     # HEADER_INNER_RANDOM_STREAM_ID()     => STREAM_ID_CHACHA20,
     # HEADER_INNER_RANDOM_STREAM_ID()     => STREAM_ID_CHACHA20,

-    HEADER_KDF_PARAMETERS()             => sub {
+    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),
         };
         +{
             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 = (
     # HEADER_PUBLIC_CUSTOM_DATA()        => sub { +{} },
 );
 my %ATTRS_META = (

-    generator                       => '',
-    header_hash                     => '',
-    database_name                   => '',
-    database_name_changed           => sub { scalar gmtime },
-    database_description            => '',
-    database_description_changed    => sub { scalar gmtime },
-    default_username                => '',
-    default_username_changed        => sub { scalar gmtime },
-    maintenance_history_days        => 0,
-    color                           => '',
-    master_key_changed              => sub { scalar gmtime },
-    master_key_change_rec           => -1,
-    master_key_change_force         => -1,
-    # memory_protection               => sub { +{} },
-    custom_icons                    => sub { +{} },
-    recycle_bin_enabled             => true,
-    recycle_bin_uuid                => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
-    recycle_bin_changed             => sub { scalar gmtime },
-    entry_templates_group           => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
-    entry_templates_group_changed   => sub { scalar gmtime },
-    last_selected_group             => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
-    last_top_visible_group          => "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
-    history_max_items               => HISTORY_DEFAULT_MAX_ITEMS,
-    history_max_size                => HISTORY_DEFAULT_MAX_SIZE,
-    settings_changed                => sub { scalar gmtime },
-    # binaries                        => sub { +{} },
-    # custom_data                     => sub { +{} },
+    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 = (
 );
 my %ATTRS_MEMORY_PROTECTION = (

-    protect_title               => false,
-    protect_username            => false,
-    protect_password            => true,
-    protect_url                 => false,
-    protect_notes               => false,
+    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) {
     # auto_enable_visual_hiding   => false,
 );
 
 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_HEADERS) {
 }
 while (my ($attr, $default) = each %ATTRS_HEADERS) {

-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    *{$attr} = sub {
-        my $self = shift;
-        $self->headers->{$attr} = shift if @_;
-        $self->headers->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
-    };
+    has $attr => @$default, store => 'headers';

 }
 while (my ($attr, $default) = each %ATTRS_META) {
 }
 while (my ($attr, $default) = each %ATTRS_META) {

-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    *{$attr} = sub {
-        my $self = shift;
-        $self->meta->{$attr} = shift if @_;
-        $self->meta->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
-    };
+    has $attr => @$default, store => 'meta';

 }
 while (my ($attr, $default) = each %ATTRS_MEMORY_PROTECTION) {
 }
 while (my ($attr, $default) = each %ATTRS_MEMORY_PROTECTION) {

-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    *{$attr} = sub {
-        my $self = shift;
-        $self->meta->{$attr} = shift if @_;
-        $self->meta->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
-    };
+    has $attr => @$default, store => 'memory_protection';

 }
 
 my @ATTRS_OTHER = (
 }
 
 my @ATTRS_OTHER = (


@@ -330,6 +310,7 @@ my @ATTRS_OTHER = (
     HEADER_TRANSFORM_ROUNDS,
     HEADER_INNER_RANDOM_STREAM_KEY,
     HEADER_INNER_RANDOM_STREAM_ID,
     HEADER_TRANSFORM_ROUNDS,
     HEADER_INNER_RANDOM_STREAM_KEY,
     HEADER_INNER_RANDOM_STREAM_ID,

+    HEADER_PUBLIC_CUSTOM_DATA,

 );
 sub _set_default_attributes {
     my $self = shift;
 );
 sub _set_default_attributes {
     my $self = shift;


@@ -907,7 +888,7 @@ ways. Public custom data:
 =for :list
 * can store strings, booleans and up to 64-bit integer values (custom data can only store text values)
 * is NOT encrypted within a KDBX file (hence the "public" part of the name)
 =for :list
 * can store strings, booleans and up to 64-bit integer values (custom data can only store text values)
 * is NOT encrypted within a KDBX file (hence the "public" part of the name)

-* is a flat hash/dict of key-value pairs (no other associated fields like modification times)
+* is a plain hash/dict of key-value pairs with no other associated fields (like modification times)

 
 =cut
 
 
 =cut
 

diff --git a/lib/File/KDBX/Cipher.pm b/lib/File/KDBX/Cipher.pm
index 5dbde84040072e1b35773f6cafacf2ce60402002..655f8fbe7448a872ba70b80d04d590bd1cb926eb 100644 (file)
--- a/lib/File/KDBX/Cipher.pm
+++ b/lib/File/KDBX/Cipher.pm
@@ -7,7 +7,7 @@ use strict;
 use Devel::GlobalDestruction;
 use File::KDBX::Constants qw(:cipher :random_stream);
 use File::KDBX::Error;
 use Devel::GlobalDestruction;
 use File::KDBX::Constants qw(:cipher :random_stream);
 use File::KDBX::Error;

-use File::KDBX::Util qw(erase format_uuid);
+use File::KDBX::Util qw(:class erase format_uuid);

 use Module::Load;
 use Scalar::Util qw(looks_like_number);
 use namespace::clean;
 use Module::Load;
 use Scalar::Util qw(looks_like_number);
 use namespace::clean;


@@ -16,6 +16,63 @@ our $VERSION = '999.999'; # VERSION
 
 my %CIPHERS;
 
 
 my %CIPHERS;
 

+=attr uuid
+
+    $uuid = $cipher->uuid;
+
+Get the UUID if the cipher was constructed with one.
+
+=attr stream_id
+
+    $stream_id = $cipher->stream_id;
+
+Get the stream ID if the cipher was constructed with one.
+
+=attr key
+
+    $key = $cipher->key;
+
+Get the raw encryption key.
+
+=attr iv
+
+    $iv = $cipher->iv;
+
+Get the initialization vector.
+
+=attr iv_size
+
+    $size = $cipher->iv_size;
+
+Get the expected size of the initialization vector, in bytes.
+
+=attr key_size
+
+    $size = $cipher->key_size;
+
+Get the size the mode or stream expects the key to be, in bytes.
+
+=attr block_size
+
+    $size = $cipher->block_size;
+
+Get the block size, in bytes.
+
+=attr algorithm
+
+Get the symmetric cipher algorithm.
+
+=cut
+
+has 'uuid',         is => 'ro';
+has 'stream_id',    is => 'ro';
+has 'key',          is => 'ro';
+has 'iv',           is => 'ro';
+sub iv_size     {  0 }
+sub key_size    { -1 }
+sub block_size  {  0 }
+sub algorithm   { $_[0]->{algorithm} or throw 'Block cipher algorithm is not set' }
+

 =method new
 
 =method new_from_uuid
 =method new
 
 =method new_from_uuid


@@ -93,76 +150,6 @@ sub init { $_[0] }
 
 sub DESTROY { !in_global_destruction and erase \$_[0]->{key} }
 
 
 sub DESTROY { !in_global_destruction and erase \$_[0]->{key} }
 

-=attr uuid
-
-    $uuid = $cipher->uuid;
-
-Get the UUID if the cipher was constructed with one.
-
-=cut
-
-sub uuid { $_[0]->{uuid} }
-
-=attr stream_id
-
-    $stream_id = $cipher->stream_id;
-
-Get the stream ID if the cipher was constructed with one.
-
-=cut
-
-sub stream_id { $_[0]->{stream_id} }
-
-=attr key
-
-    $key = $cipher->key;
-
-Get the raw encryption key.
-
-=cut
-
-sub key { $_[0]->{key} }
-
-=attr iv
-
-    $iv = $cipher->iv;
-
-Get the initialization vector.
-
-=cut
-
-sub iv { $_[0]->{iv} }
-
-=attr iv_size
-
-    $size = $cipher->iv_size;
-
-Get the expected size of the initialization vector, in bytes.
-
-=cut
-
-sub iv_size { 0 }
-
-=attr key_size
-
-    $size = $cipher->key_size;
-
-Get the size the mode or stream expects the key to be, in bytes.
-
-=cut
-
-sub key_size { -1 }
-
-=attr block_size
-
-    $size = $cipher->block_size;
-
-Get the block size, in bytes.
-
-=cut
-
-sub block_size { 0 }
-

 =method encrypt
 
     $ciphertext = $cipher->encrypt($plaintext, ...);
 =method encrypt
 
     $ciphertext = $cipher->encrypt($plaintext, ...);


@@ -171,7 +158,7 @@ Encrypt some data.
 
 =cut
 
 
 =cut
 

-sub encrypt { die "Not implemented" }
+sub encrypt { die 'Not implemented' }

 
 =method decrypt
 
 
 =method decrypt
 


@@ -181,7 +168,7 @@ Decrypt some data.
 
 =cut
 
 
 =cut
 

-sub decrypt { die "Not implemented" }
+sub decrypt { die 'Not implemented' }

 
 =method finish
 
 
 =method finish
 


@@ -295,12 +282,12 @@ __END__
 
     my $cipher = File::KDBX::Cipher->new(uuid => $uuid, key => $key, iv => $iv);
 
 
     my $cipher = File::KDBX::Cipher->new(uuid => $uuid, key => $key, iv => $iv);
 

-    my $ciphertext = $cipher->encrypt('data');
-    $ciphertext .= $cipher->encrypt('more data');
+    my $ciphertext = $cipher->encrypt('plaintext');
+    $ciphertext .= $cipher->encrypt('more plaintext');

     $ciphertext .= $cipher->finish;
 
     $ciphertext .= $cipher->finish;
 

-    my $plaintext = $cipher->decrypt('data');
-    $plaintext .= $cipher->decrypt('more data');
+    my $plaintext = $cipher->decrypt('ciphertext');
+    $plaintext .= $cipher->decrypt('more ciphertext');

     $plaintext .= $cipher->finish;
 
 =head1 DESCRIPTION
     $plaintext .= $cipher->finish;
 
 =head1 DESCRIPTION

diff --git a/lib/File/KDBX/Cipher/CBC.pm b/lib/File/KDBX/Cipher/CBC.pm
index 8336af4b4a31e79688833d3b6bc14f0d1da59ba2..467b935f65104d1a1c9146deb8e322c82a89e8ac 100644 (file)
--- a/lib/File/KDBX/Cipher/CBC.pm
+++ b/lib/File/KDBX/Cipher/CBC.pm
@@ -6,12 +6,17 @@ use strict;
 
 use Crypt::Mode::CBC;
 use File::KDBX::Error;
 
 use Crypt::Mode::CBC;
 use File::KDBX::Error;

+use File::KDBX::Util qw(:class);

 use namespace::clean;
 
 use namespace::clean;
 

-use parent 'File::KDBX::Cipher';
+extends 'File::KDBX::Cipher';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

+has key_size => 32;
+sub iv_size     { 16 }
+sub block_size  { 16 }
+

 sub encrypt {
     my $self = shift;
 
 sub encrypt {
     my $self = shift;
 


@@ -44,17 +49,6 @@ sub finish {
     return $out;
 }
 
     return $out;
 }
 

-=attr algorithm
-
-Get the symmetric cipher algorithm.
-
-=cut
-
-sub algorithm   { $_[0]->{algorithm} or throw 'Block cipher algorithm is not set' }
-sub key_size    { $_[0]->{key_size} // 32 }
-sub iv_size     { 16 }
-sub block_size  { 16 }
-

 1;
 __END__
 
 1;
 __END__
 

diff --git a/lib/File/KDBX/Cipher/Stream.pm b/lib/File/KDBX/Cipher/Stream.pm
index e904c0f9766bbfd46b91706f49126cd4d65ba7a9..367619acbd1548bc0055420e2e251b5f1d081247 100644 (file)
--- a/lib/File/KDBX/Cipher/Stream.pm
+++ b/lib/File/KDBX/Cipher/Stream.pm
@@ -7,14 +7,35 @@ use strict;
 use Crypt::Digest qw(digest_data);
 use File::KDBX::Constants qw(:cipher :random_stream);
 use File::KDBX::Error;
 use Crypt::Digest qw(digest_data);
 use File::KDBX::Constants qw(:cipher :random_stream);
 use File::KDBX::Error;

+use File::KDBX::Util qw(:class);

 use Scalar::Util qw(blessed);
 use Module::Load;
 use namespace::clean;
 
 use Scalar::Util qw(blessed);
 use Module::Load;
 use namespace::clean;
 

-use parent 'File::KDBX::Cipher';
+extends 'File::KDBX::Cipher';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

+=attr counter
+
+    $counter = $cipher->counter;
+
+Get the initial counter / block count into the keystream.
+
+=attr offset
+
+    $offset = $cipher->offset;
+
+Get the initial byte offset into the keystream. This has precedence over L</counter> if both are set.
+
+=cut
+
+has 'counter',  is => 'ro', default => 0;
+has 'offset',   is => 'ro';
+sub key_size    { { Salsa20 => 32, ChaCha => 32 }->{$_[0]->{algorithm} || ''} //  0 }
+sub iv_size     { { Salsa20 =>  8, ChaCha => 12 }->{$_[0]->{algorithm} || ''} // -1 }
+sub block_size  { 1 }
+

 sub init {
     my $self = shift;
     my %args = @_;
 sub init {
     my $self = shift;
     my %args = @_;


@@ -109,7 +130,7 @@ sub _stream {
         if (my $err = $@) {
             throw 'Failed to initialize stream cipher library',
                 error       => $err,
         if (my $err = $@) {
             throw 'Failed to initialize stream cipher library',
                 error       => $err,

-                algorithm   => $self->algorithm,
+                algorithm   => $self->{algorithm},

                 key_length  => length($self->key),
                 iv_length   => length($self->iv),
                 iv          => unpack('H*', $self->iv),
                 key_length  => length($self->key),
                 iv_length   => length($self->iv),
                 iv          => unpack('H*', $self->iv),


@@ -124,33 +145,6 @@ sub decrypt { goto &crypt }
 
 sub finish { delete $_[0]->{stream}; '' }
 
 
 sub finish { delete $_[0]->{stream}; '' }
 

-=attr algorithm
-
-    $algorithm = $cipher->algorithm;
-
-Get the stream cipher algorithm. Can be one of C<Salsa20> and C<ChaCha>.
-
-=attr counter
-
-    $counter = $cipher->counter;
-
-Get the initial counter / block count into the keystream.
-
-=attr offset
-
-    $offset = $cipher->offset;
-
-Get the initial byte offset into the keystream. This has precedence over L</counter> if both are set.
-
-=cut
-
-sub algorithm   { $_[0]->{algorithm} or throw 'Stream cipher algorithm is not set' }
-sub counter     { $_[0]->{counter} // 0 }
-sub offset      { $_[0]->{offset} }
-sub key_size    { { Salsa20 => 32, ChaCha => 32 }->{$_[0]->{algorithm} || ''} //  0 }
-sub iv_size     { { Salsa20 =>  8, ChaCha => 12 }->{$_[0]->{algorithm} || ''} // -1 }
-sub block_size  { 1 }
-

 1;
 __END__
 
 1;
 __END__
 

diff --git a/lib/File/KDBX/Constants.pm b/lib/File/KDBX/Constants.pm
index ea4e02636d56900fee53f42e299f9fc964ea8db5..fe806242adefadae5090249e022c85bfa080e2a2 100644 (file)
--- a/lib/File/KDBX/Constants.pm
+++ b/lib/File/KDBX/Constants.pm
@@ -274,8 +274,9 @@ BEGIN {
 }
 
 our %EXPORT_TAGS;
 }
 
 our %EXPORT_TAGS;

-push @{$EXPORT_TAGS{header}}, 'KDBX_HEADER';
-push @{$EXPORT_TAGS{inner_header}}, 'KDBX_INNER_HEADER';
+push @{$EXPORT_TAGS{header}}, 'kdbx_header';
+push @{$EXPORT_TAGS{compression}}, 'compression';
+push @{$EXPORT_TAGS{inner_header}}, 'kdbx_inner_header';

 push @{$EXPORT_TAGS{icon}}, 'icon';
 
 $EXPORT_TAGS{all} = [map { @$_ } values %EXPORT_TAGS];
 push @{$EXPORT_TAGS{icon}}, 'icon';
 
 $EXPORT_TAGS{all} = [map { @$_ } values %EXPORT_TAGS];


@@ -290,8 +291,13 @@ for my $header (
 ) {
     $HEADER{$header} = $HEADER{0+$header} = $header;
 }
 ) {
     $HEADER{$header} = $HEADER{0+$header} = $header;
 }

-sub KDBX_HEADER { $HEADER{$_[0]} }
+sub kdbx_header { $HEADER{$_[0]} }

 
 

+my %COMPRESSION;
+for my $compression (COMPRESSION_NONE, COMPRESSION_GZIP) {
+    $COMPRESSION{$compression} = $COMPRESSION{0+$compression} = $compression;
+}
+sub compression { $COMPRESSION{$_[0]} }

 
 my %INNER_HEADER;
 for my $inner_header (
 
 my %INNER_HEADER;
 for my $inner_header (


@@ -300,7 +306,7 @@ for my $inner_header (
 ) {
     $INNER_HEADER{$inner_header} = $INNER_HEADER{0+$inner_header} = $inner_header;
 }
 ) {
     $INNER_HEADER{$inner_header} = $INNER_HEADER{0+$inner_header} = $inner_header;
 }

-sub KDBX_INNER_HEADER { $INNER_HEADER{$_[0]} }
+sub kdbx_inner_header { $INNER_HEADER{$_[0]} }

 
 my %ICON;
 for my $icon (
 
 my %ICON;
 for my $icon (


@@ -399,7 +405,13 @@ Constants related to parsing and generating KDBX file headers:
 = C<HEADER_INNER_RANDOM_STREAM_ID>
 = C<HEADER_KDF_PARAMETERS>
 = C<HEADER_PUBLIC_CUSTOM_DATA>
 = C<HEADER_INNER_RANDOM_STREAM_ID>
 = C<HEADER_KDF_PARAMETERS>
 = C<HEADER_PUBLIC_CUSTOM_DATA>

-= C<KDBX_HEADER>
+
+=func kdbx_header
+
+    $constant = kdbx_header($number);
+    $constant = kdbx_header($string);
+
+Get a header constant from an integer or string value.

 
 =head2 :compression
 
 
 =head2 :compression
 


@@ -409,6 +421,13 @@ Constants related to identifying the compression state of a file:
 = C<COMPRESSION_NONE>
 = C<COMPRESSION_GZIP>
 
 = C<COMPRESSION_NONE>
 = C<COMPRESSION_GZIP>
 

+=func compression
+
+    $constant = compression($number);
+    $constant = compression($string);
+
+Get a compression constant from an integer or string value.
+

 =head2 :cipher
 
 Constants related ciphers:
 =head2 :cipher
 
 Constants related ciphers:


@@ -484,7 +503,13 @@ Constants related to parsing and generating KDBX4 inner headers:
 = C<INNER_HEADER_INNER_RANDOM_STREAM_KEY>
 = C<INNER_HEADER_BINARY>
 = C<INNER_HEADER_BINARY_FLAG_PROTECT>
 = C<INNER_HEADER_INNER_RANDOM_STREAM_KEY>
 = C<INNER_HEADER_BINARY>
 = C<INNER_HEADER_BINARY_FLAG_PROTECT>

-= C<KDBX_INNER_HEADER>
+
+=func kdbx_inner_header
+
+    $constant = kdbx_inner_header($number);
+    $constant = kdbx_inner_header($string);
+
+Get an inner header constant from an integer or string value.

 
 =head2 :key_file
 
 
 =head2 :key_file
 


@@ -579,6 +604,13 @@ Constants for default icons used by KeePass password safe implementations:
 = C<ICON_CERTIFICATE>
 = C<ICON_SMARTPHONE>
 
 = C<ICON_CERTIFICATE>
 = C<ICON_SMARTPHONE>
 

+=func icon
+
+    $constant = icon($number);
+    $constant = icon($string);
+
+Get an icon constant from an integer or string value.
+

 =head2 :bool
 
 Boolean values:
 =head2 :bool
 
 Boolean values:

diff --git a/lib/File/KDBX/Dumper.pm b/lib/File/KDBX/Dumper.pm
index 8be64be930cbda8f003d445c45a06be96e535fd0..7e2741c9353fb1212b03e168bec57110a946c403 100644 (file)
--- a/lib/File/KDBX/Dumper.pm
+++ b/lib/File/KDBX/Dumper.pm
@@ -7,6 +7,7 @@ use strict;
 use Crypt::Digest qw(digest_data);
 use File::KDBX::Constants qw(:magic :header :version :random_stream);
 use File::KDBX::Error;
 use Crypt::Digest qw(digest_data);
 use File::KDBX::Constants qw(:magic :header :version :random_stream);
 use File::KDBX::Error;

+use File::KDBX::Util qw(:class);

 use File::KDBX;
 use IO::Handle;
 use Module::Load;
 use File::KDBX;
 use IO::Handle;
 use Module::Load;


@@ -254,10 +255,6 @@ The most common reason to explicitly specify the file format is to save a databa
 
     $kdbx->dump_file('database.xml', format => 'XML');
 
 
     $kdbx->dump_file('database.xml', format => 'XML');
 

-=cut
-
-sub format { $_[0]->{format} }
-

 =attr inner_format
 
 Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible
 =attr inner_format
 
 Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible


@@ -267,23 +264,6 @@ formats:
 * C<XML> - Write the database groups and entries as XML (default)
 * C<Raw> - Write L<File::KDBX/raw> instead of the actual database contents
 
 * C<XML> - Write the database groups and entries as XML (default)
 * C<Raw> - Write L<File::KDBX/raw> instead of the actual database contents
 

-=cut
-
-sub inner_format { $_[0]->{inner_format} // 'XML' }
-
-=attr min_version
-
-    $min_version = File::KDBX::Dumper->min_version;
-
-Get the minimum KDBX file version supported, which is 3.0 or C<0x00030000> as
-it is encoded.
-
-To generate older KDBX files unsupported by this module, try L<File::KeePass>.
-
-=cut
-
-sub min_version { KDBX_VERSION_OLDEST }
-

 =attr allow_upgrade
 
     $bool = $dumper->allow_upgrade;
 =attr allow_upgrade
 
     $bool = $dumper->allow_upgrade;


@@ -294,10 +274,6 @@ too low to support new features being used.
 
 The default is to allow upgrading.
 
 
 The default is to allow upgrading.
 

-=cut
-
-sub allow_upgrade { $_[0]->{allow_upgrade} // 1 }
-

 =attr randomize_seeds
 
     $bool = $dumper->randomize_seeds;
 =attr randomize_seeds
 
     $bool = $dumper->randomize_seeds;


@@ -308,7 +284,23 @@ they are.
 
 =cut
 
 
 =cut
 

-sub randomize_seeds { $_[0]->{randomize_seeds} // 1 }
+has 'format',           is => 'ro';
+has 'inner_format',     is => 'ro', default => 'XML';
+has 'allow_upgrade',    is => 'ro', default => 1;
+has 'randomize_seeds',  is => 'ro', default => 1;
+
+=method min_version
+
+    $min_version = File::KDBX::Dumper->min_version;
+
+Get the minimum KDBX file version supported, which is 3.0 or C<0x00030000> as
+it is encoded.
+
+To generate older KDBX files unsupported by this module, try L<File::KeePass>.
+
+=cut
+
+sub min_version { KDBX_VERSION_OLDEST }

 
 sub _fh { $_[0]->{fh} or throw 'IO handle not set' }
 
 
 sub _fh { $_[0]->{fh} or throw 'IO handle not set' }
 

diff --git a/lib/File/KDBX/Dumper/KDB.pm b/lib/File/KDBX/Dumper/KDB.pm
index b1d5ba7d4a49f9e18c8b2be9cb2fd41b5df2b68c..3e4bcd7cd78b3b23d7f8d31b1e4f5febee4a0536 100644 (file)
--- a/lib/File/KDBX/Dumper/KDB.pm
+++ b/lib/File/KDBX/Dumper/KDB.pm
@@ -9,10 +9,10 @@ use Encode qw(encode);
 use File::KDBX::Constants qw(:magic);
 use File::KDBX::Error;
 use File::KDBX::Loader::KDB;
 use File::KDBX::Constants qw(:magic);
 use File::KDBX::Error;
 use File::KDBX::Loader::KDB;

-use File::KDBX::Util qw(:uuid load_optional);
+use File::KDBX::Util qw(:class :uuid load_optional);

 use namespace::clean;
 
 use namespace::clean;
 

-use parent 'File::KDBX::Dumper';
+extends 'File::KDBX::Dumper';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

diff --git a/lib/File/KDBX/Dumper/Raw.pm b/lib/File/KDBX/Dumper/Raw.pm
index 00205c85a7f6c89ead00768259dc42684d361464..124a267b4f71627e4d4507b96641bb52db2d5d01 100644 (file)
--- a/lib/File/KDBX/Dumper/Raw.pm
+++ b/lib/File/KDBX/Dumper/Raw.pm
@@ -4,7 +4,9 @@ package File::KDBX::Dumper::Raw;
 use warnings;
 use strict;
 
 use warnings;
 use strict;
 

-use parent 'File::KDBX::Dumper';
+use File::KDBX::Util qw(:class);
+
+extends 'File::KDBX::Dumper';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

diff --git a/lib/File/KDBX/Dumper/V3.pm b/lib/File/KDBX/Dumper/V3.pm
index ceb9f297f7e67d968944e2006f05318499f9aaf2..b8cf01c1f056ca3f2c0020d448752f4ce72834a9 100644 (file)
--- a/lib/File/KDBX/Dumper/V3.pm
+++ b/lib/File/KDBX/Dumper/V3.pm
@@ -10,11 +10,11 @@ use File::KDBX::Constants qw(:header :compression);
 use File::KDBX::Error;
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HashBlock;
 use File::KDBX::Error;
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HashBlock;

-use File::KDBX::Util qw(:empty :load assert_64bit erase_scoped);
+use File::KDBX::Util qw(:class :empty :load assert_64bit erase_scoped);

 use IO::Handle;
 use namespace::clean;
 
 use IO::Handle;
 use namespace::clean;
 

-use parent 'File::KDBX::Dumper';
+extends 'File::KDBX::Dumper';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 


@@ -59,7 +59,7 @@ sub _write_header {
     my $type = shift;
     my $val  = shift // '';
 
     my $type = shift;
     my $val  = shift // '';
 

-    $type = KDBX_HEADER($type);
+    $type = kdbx_header($type);

     if ($type == HEADER_END) {
         $val = "\r\n\r\n";
     }
     if ($type == HEADER_END) {
         $val = "\r\n\r\n";
     }

diff --git a/lib/File/KDBX/Dumper/V4.pm b/lib/File/KDBX/Dumper/V4.pm
index 642f689b8dd104b8cf35d1346f186d983c2f2d5e..f2a8574e8b55413419c4b9c974340cc5e5d11549 100644 (file)
--- a/lib/File/KDBX/Dumper/V4.pm
+++ b/lib/File/KDBX/Dumper/V4.pm
@@ -11,17 +11,17 @@ use File::KDBX::Constants qw(:header :inner_header :compression :kdf :variant_ma
 use File::KDBX::Error;
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HmacBlock;
 use File::KDBX::Error;
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HmacBlock;

-use File::KDBX::Util qw(:empty :load assert_64bit erase_scoped);
+use File::KDBX::Util qw(:class :empty :load assert_64bit erase_scoped);

 use IO::Handle;
 use Scalar::Util qw(looks_like_number);
 use boolean qw(:all);
 use namespace::clean;
 
 use IO::Handle;
 use Scalar::Util qw(looks_like_number);
 use boolean qw(:all);
 use namespace::clean;
 

-use parent 'File::KDBX::Dumper';
+extends 'File::KDBX::Dumper';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

-sub _binaries_written { $_[0]->{_binaries_written} //= {} }
+has _binaries_written => {}, is => 'ro';

 
 sub _write_headers {
     my $self = shift;
 
 sub _write_headers {
     my $self = shift;


@@ -61,7 +61,7 @@ sub _write_header {
     my $type = shift;
     my $val  = shift // '';
 
     my $type = shift;
     my $val  = shift // '';
 

-    $type = KDBX_HEADER($type);
+    $type = kdbx_header($type);

     if ($type == HEADER_END) {
         # nothing
     }
     if ($type == HEADER_END) {
         # nothing
     }


@@ -289,7 +289,7 @@ sub _write_inner_header {
     my $buf = pack('C', $type);
     $fh->print($buf) or throw 'Failed to write inner header type';
 
     my $buf = pack('C', $type);
     $fh->print($buf) or throw 'Failed to write inner header type';
 

-    $type = KDBX_INNER_HEADER($type);
+    $type = kdbx_inner_header($type);

 
     if ($type == INNER_HEADER_END) {
         # nothing
 
     if ($type == INNER_HEADER_END) {
         # nothing

diff --git a/lib/File/KDBX/Dumper/XML.pm b/lib/File/KDBX/Dumper/XML.pm
index a079aed4a6871e80c1788d7ee280fbbc036b5d53..3a9e70ba9a32b5da4d8f7fbf952df99621383492 100644 (file)
--- a/lib/File/KDBX/Dumper/XML.pm
+++ b/lib/File/KDBX/Dumper/XML.pm
@@ -9,15 +9,15 @@ use Crypt::Misc 0.029 qw(encode_b64);
 use Encode qw(encode);
 use File::KDBX::Constants qw(:version :time);
 use File::KDBX::Error;
 use Encode qw(encode);
 use File::KDBX::Constants qw(:version :time);
 use File::KDBX::Error;

-use File::KDBX::Util qw(assert_64bit erase_scoped gzip snakify);
+use File::KDBX::Util qw(:class assert_64bit erase_scoped gzip snakify);

 use IO::Handle;
 use IO::Handle;

-use Scalar::Util qw(isdual looks_like_number);
+use Scalar::Util qw(blessed isdual looks_like_number);

 use Time::Piece;
 use XML::LibXML;
 use boolean;
 use namespace::clean;
 
 use Time::Piece;
 use XML::LibXML;
 use boolean;
 use namespace::clean;
 

-use parent 'File::KDBX::Dumper';
+extends 'File::KDBX::Dumper';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 


@@ -27,28 +27,12 @@ our $VERSION = '999.999'; # VERSION
 
 Get whether or not protected strings and binaries should be written in an encrypted stream. Default: C<TRUE>
 
 
 Get whether or not protected strings and binaries should be written in an encrypted stream. Default: C<TRUE>
 

-=cut
-
-sub allow_protection {
-    my $self = shift;
-    $self->{allow_protection} = shift if @_;
-    $self->{allow_protection} //= 1;
-}
-

 =attr binaries
 
     $bool = $dumper->binaries;
 
 Get whether or not binaries within the database should be written. Default: C<TRUE>
 
 =attr binaries
 
     $bool = $dumper->binaries;
 
 Get whether or not binaries within the database should be written. Default: C<TRUE>
 

-=cut
-
-sub binaries {
-    my $self = shift;
-    $self->{binaries} = shift if @_;
-    $self->{binaries} //= $self->kdbx->version < KDBX_VERSION_4_0;
-}
-

 =attr compress_binaries
 
     $tristate = $dumper->compress_binaries;
 =attr compress_binaries
 
     $tristate = $dumper->compress_binaries;


@@ -60,14 +44,6 @@ Get whether or not to compress binaries. Possible values:
 * C<FALSE> - Never compress binaries
 * C<undef> - Compress binaries if it results in smaller database sizes (default)
 
 * C<FALSE> - Never compress binaries
 * C<undef> - Compress binaries if it results in smaller database sizes (default)
 

-=cut
-
-sub compress_binaries {
-    my $self = shift;
-    $self->{compress_binaries} = shift if @_;
-    $self->{compress_binaries};
-}
-

 =attr compress_datetimes
 
     $bool = $dumper->compress_datetimes;
 =attr compress_datetimes
 
     $bool = $dumper->compress_datetimes;


@@ -77,14 +53,6 @@ string format of C<1970-01-01T00:00:00Z>, but they can also be written in a comp
 bytes. The default is to write compressed datetimes if the KDBX file version is 4+, otherwise use the
 human-readable format.
 
 bytes. The default is to write compressed datetimes if the KDBX file version is 4+, otherwise use the
 human-readable format.
 

-=cut
-
-sub compress_datetimes {
-    my $self = shift;
-    $self->{compress_datetimes} = shift if @_;
-    $self->{compress_datetimes};
-}
-

 =attr header_hash
 
     $octets = $dumper->header_hash;
 =attr header_hash
 
     $octets = $dumper->header_hash;


@@ -99,6 +67,11 @@ is probably never any reason to set this manually.
 
 =cut
 
 
 =cut
 

+has allow_protection => 1;
+has binaries => sub { $_[0]->kdbx->version < KDBX_VERSION_4_0 };
+has 'compress_binaries';
+has 'compress_datetimes';
+

 sub header_hash { $_[0]->{header_hash} }
 
 sub _binaries_written { $_[0]->{_binaries_written} //= {} }
 sub header_hash { $_[0]->{header_hash} }
 
 sub _binaries_written { $_[0]->{_binaries_written} //= {} }


@@ -592,7 +565,6 @@ sub _encode_bool {
 }
 
 sub _encode_datetime {
 }
 
 sub _encode_datetime {

-    goto &_encode_datetime_binary if defined $_[2] && KDBX_VERSION_4_0 <= $_[2];

     local $_ = shift;
     return $_->strftime('%Y-%m-%dT%H:%M:%SZ');
 }
     local $_ = shift;
     return $_->strftime('%Y-%m-%dT%H:%M:%SZ');
 }

diff --git a/lib/File/KDBX/Entry.pm b/lib/File/KDBX/Entry.pm
index bc81d5ac87948c2f0aa8db79949e60c7b05c7e2f..fc744fd8c3c00c3c9e47deadc9f8a7d71db05a17 100644 (file)
--- a/lib/File/KDBX/Entry.pm
+++ b/lib/File/KDBX/Entry.pm
@@ -4,12 +4,12 @@ package File::KDBX::Entry;
 use warnings;
 use strict;
 
 use warnings;
 use strict;
 

-use Crypt::Misc 0.029 qw(encode_b32r decode_b64);
+use Crypt::Misc 0.029 qw(decode_b64 encode_b32r);

 use Devel::GlobalDestruction;
 use Encode qw(encode);
 use File::KDBX::Constants qw(:history :icon);
 use File::KDBX::Error;
 use Devel::GlobalDestruction;
 use Encode qw(encode);
 use File::KDBX::Constants qw(:history :icon);
 use File::KDBX::Error;

-use File::KDBX::Util qw(:function :uri generate_uuid load_optional);
+use File::KDBX::Util qw(:class :coercion :function :uri generate_uuid load_optional);

 use Hash::Util::FieldHash;
 use List::Util qw(first sum0);
 use Ref::Util qw(is_coderef is_plain_hashref);
 use Hash::Util::FieldHash;
 use List::Util qw(first sum0);
 use Ref::Util qw(is_coderef is_plain_hashref);


@@ -19,7 +19,7 @@ use Time::Piece;
 use boolean;
 use namespace::clean;
 
 use boolean;
 use namespace::clean;
 

-use parent 'File::KDBX::Object';
+extends 'File::KDBX::Object';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 


@@ -175,31 +175,32 @@ sub uuid {
     $self->{uuid};
 }
 
     $self->{uuid};
 }
 

-my @ATTRS = qw(uuid custom_data history);
+my @ATTRS = qw(uuid custom_data history icon_id);

 my %ATTRS = (
     # uuid                    => sub { generate_uuid(printable => 1) },
 my %ATTRS = (
     # uuid                    => sub { generate_uuid(printable => 1) },

-    icon_id                 => sub { defined $_[1] ? icon($_[1]) : ICON_PASSWORD },
-    custom_icon_uuid        => undef,
-    foreground_color        => '',
-    background_color        => '',
-    override_url            => '',
-    tags                    => '',
-    auto_type               => sub { +{} },
-    previous_parent_group   => undef,
-    quality_check           => true,
-    strings                 => sub { +{} },
-    binaries                => sub { +{} },
-    # custom_data             => sub { +{} },
-    # history                 => sub { +[] },
+    # 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 = (
 );
 my %ATTRS_TIMES = (

-    last_modification_time  => sub { scalar gmtime },
-    creation_time           => sub { scalar gmtime },
-    last_access_time        => sub { scalar gmtime },
-    expiry_time             => sub { scalar gmtime },
-    expires                 => false,
-    usage_count             => 0,
-    location_changed        => sub { scalar 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],

 );
 my %ATTRS_STRINGS = (
     title                   => 'Title',
 );
 my %ATTRS_STRINGS = (
     title                   => 'Title',


@@ -209,26 +210,13 @@ my %ATTRS_STRINGS = (
     notes                   => 'Notes',
 );
 
     notes                   => 'Notes',
 );
 

-while (my ($attr, $setter) = each %ATTRS) {
-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    *{$attr} = is_coderef $setter ? sub {
-        my $self = shift;
-        $self->{$attr} = $setter->($self, shift) if @_;
-        $self->{$attr} //= $setter->($self);
-    } : sub {
-        my $self = shift;
-        $self->{$attr} = shift if @_;
-        $self->{$attr} //= $setter;
-    };
+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) {
 }
 while (my ($attr, $default) = each %ATTRS_TIMES) {

-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    *{$attr} = sub {
-        my $self = shift;
-        $self->{times} //= {};
-        $self->{times}{$attr} = shift if @_;
-        $self->{times}{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
-    };
+    has $attr => @$default, store => 'times';

 }
 while (my ($attr, $string_key) = each %ATTRS_STRINGS) {
     no strict 'refs'; ## no critic (ProhibitNoStrict)
 }
 while (my ($attr, $string_key) = each %ATTRS_STRINGS) {
     no strict 'refs'; ## no critic (ProhibitNoStrict)

diff --git a/lib/File/KDBX/Error.pm b/lib/File/KDBX/Error.pm
index d23837a8d3ba5018a89cdf7ae7a23a198d5e70b6..d12d0806588e35ae67bddfe1148847fc504055c8 100644 (file)
--- a/lib/File/KDBX/Error.pm
+++ b/lib/File/KDBX/Error.pm
@@ -112,34 +112,26 @@ sub details {
 
 Get the value of C<errno> when the exception was created.
 
 
 Get the value of C<errno> when the exception was created.
 

-=cut
-
-sub errno { $_[0]->{errno} }
-

 =attr previous
 
 Get the value of C<$@> (i.e. latest exception) at the time the exception was created.
 
 =attr previous
 
 Get the value of C<$@> (i.e. latest exception) at the time the exception was created.
 

-
-=cut
-
-sub previous { $_[0]->{previous} }
-

 =attr trace
 
 Get a stack trace indicating where in the code the exception was created.
 
 =cut
 
 =attr trace
 
 Get a stack trace indicating where in the code the exception was created.
 
 =cut
 

-sub trace { $_[0]->{trace} // [] }
-

 =attr type
 
 Get the exception type, if any.
 
 =cut
 
 =attr type
 
 Get the exception type, if any.
 
 =cut
 

-sub type { $_[0]->details->{type} // '' }
+sub errno    { $_[0]->{errno} }
+sub previous { $_[0]->{previous} }
+sub trace    { $_[0]->{trace} // [] }
+sub type     { $_[0]->details->{type} // '' }

 
 =method to_string
 
 
 =method to_string
 

diff --git a/lib/File/KDBX/Group.pm b/lib/File/KDBX/Group.pm
index d68189fd5da0e2d74f5699aa2fb3e99aaf4dc63c..0870dd1ffb8ab585016c5a684d6b05993e3bd019 100644 (file)
--- a/lib/File/KDBX/Group.pm
+++ b/lib/File/KDBX/Group.pm
@@ -7,7 +7,7 @@ use strict;
 use Devel::GlobalDestruction;
 use File::KDBX::Constants qw(:icon);
 use File::KDBX::Error;
 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_coderef is_ref);
 use Hash::Util::FieldHash;
 use List::Util qw(sum0);
 use Ref::Util qw(is_coderef is_ref);


@@ -16,59 +16,49 @@ use Time::Piece;
 use boolean;
 use namespace::clean;
 
 use boolean;
 use namespace::clean;
 

-use parent 'File::KDBX::Object';
+extends 'File::KDBX::Object';

 
 our $VERSION = '999.999'; # VERSION
 
 sub _parent_container { 'groups' }
 
 
 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) },
 my %ATTRS = (
     # uuid                        => sub { generate_uuid(printable => 1) },

-    name                        => '',
-    notes                       => '',
-    tags                        => '',
-    icon_id                     => sub { defined $_[1] ? icon($_[1]) : 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 = (
 my %ATTRS_TIMES = (

-    last_modification_time  => sub { scalar gmtime },
-    creation_time           => sub { scalar gmtime },
-    last_access_time        => sub { scalar gmtime },
-    expiry_time             => sub { scalar gmtime },
-    expires                 => false,
-    usage_count             => 0,
-    location_changed        => sub { scalar 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],

 );
 
 );
 

-while (my ($attr, $setter) = each %ATTRS) {
-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    *{$attr} = is_coderef $setter ? sub {
-        my $self = shift;
-        $self->{$attr} = $setter->($self, shift) if @_;
-        $self->{$attr} //= $setter->($self);
-    } : sub {
-        my $self = shift;
-        $self->{$attr} = shift if @_;
-        $self->{$attr} //= $setter;
-    };
+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) {
 }
 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 {
 }
 
 sub _set_default_attributes {

diff --git a/lib/File/KDBX/IO.pm b/lib/File/KDBX/IO.pm
index 22de9a3badca0ded704b5f2ea16a0ef851071a8f..4d6009ddf84e84734fecb931523dd531d4758fae 100644 (file)
--- a/lib/File/KDBX/IO.pm
+++ b/lib/File/KDBX/IO.pm
@@ -6,13 +6,13 @@ use strict;
 
 use Devel::GlobalDestruction;
 use File::KDBX::Constants qw(:bool);
 
 use Devel::GlobalDestruction;
 use File::KDBX::Constants qw(:bool);

-use File::KDBX::Util qw(:empty);
+use File::KDBX::Util qw(:class :empty);

 use List::Util qw(sum0);
 use Ref::Util qw(is_blessed_ref is_ref is_scalarref);
 use Symbol qw(gensym);
 use namespace::clean;
 
 use List::Util qw(sum0);
 use Ref::Util qw(is_blessed_ref is_ref is_scalarref);
 use Symbol qw(gensym);
 use namespace::clean;
 

-use parent 'IO::Handle';
+extends 'IO::Handle';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

diff --git a/lib/File/KDBX/IO/Crypt.pm b/lib/File/KDBX/IO/Crypt.pm
index 22fe45e306064990cd0724be36e841265a4a7db8..4218af21fb0aeba685e3ba3dbbed478e55285413 100644 (file)
--- a/lib/File/KDBX/IO/Crypt.pm
+++ b/lib/File/KDBX/IO/Crypt.pm
@@ -6,33 +6,15 @@ use strict;
 
 use Errno;
 use File::KDBX::Error;
 
 use Errno;
 use File::KDBX::Error;

-use File::KDBX::Util qw(:empty);
+use File::KDBX::Util qw(:class :empty);

 use namespace::clean;
 
 use namespace::clean;
 

-use parent 'File::KDBX::IO';
+extends 'File::KDBX::IO';

 
 our $VERSION = '999.999'; # VERSION
 our $BUFFER_SIZE = 16384;
 our $ERROR;
 
 
 our $VERSION = '999.999'; # VERSION
 our $BUFFER_SIZE = 16384;
 our $ERROR;
 

-=method new
-
-    $fh = File::KDBX::IO::Crypt->new(%attributes);
-    $fh = File::KDBX::IO::Crypt->new($fh, %attributes);
-
-Construct a new crypto IO handle.
-
-=cut
-
-sub new {
-    my $class = shift;
-    my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
-    my $self = $class->SUPER::new;
-    $self->_fh($args{fh}) or throw 'IO handle required';
-    $self->cipher($args{cipher}) or throw 'Cipher required';
-    return $self;
-}
-

 =attr cipher
 
 A L<File::KDBX::Cipher> instance to do the actual encryption or decryption.
 =attr cipher
 
 A L<File::KDBX::Cipher> instance to do the actual encryption or decryption.


@@ -51,6 +33,24 @@ while (my ($attr, $default) = each %ATTRS) {
     };
 }
 
     };
 }
 

+=method new
+
+    $fh = File::KDBX::IO::Crypt->new(%attributes);
+    $fh = File::KDBX::IO::Crypt->new($fh, %attributes);
+
+Construct a new crypto IO handle.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
+    my $self = $class->SUPER::new;
+    $self->_fh($args{fh}) or throw 'IO handle required';
+    $self->cipher($args{cipher}) or throw 'Cipher required';
+    return $self;
+}
+

 sub _FILL {
     my ($self, $fh) = @_;
 
 sub _FILL {
     my ($self, $fh) = @_;
 

diff --git a/lib/File/KDBX/IO/HashBlock.pm b/lib/File/KDBX/IO/HashBlock.pm
index adb1cc6f28e60f7fc36c76bbb2328675fabd38c6..f4ab8b6fba9ab1e36e66135e4b6275a0716dd13e 100644 (file)
--- a/lib/File/KDBX/IO/HashBlock.pm
+++ b/lib/File/KDBX/IO/HashBlock.pm
@@ -7,37 +7,17 @@ use strict;
 use Crypt::Digest qw(digest_data);
 use Errno;
 use File::KDBX::Error;
 use Crypt::Digest qw(digest_data);
 use Errno;
 use File::KDBX::Error;

-use File::KDBX::Util qw(:io);
+use File::KDBX::Util qw(:class :io);

 use IO::Handle;
 use namespace::clean;
 
 use IO::Handle;
 use namespace::clean;
 

-use parent 'File::KDBX::IO';
+extends 'File::KDBX::IO';

 
 our $VERSION = '999.999'; # VERSION
 our $ALGORITHM = 'SHA256';
 our $BLOCK_SIZE = 1048576;  # 1MiB
 our $ERROR;
 
 
 our $VERSION = '999.999'; # VERSION
 our $ALGORITHM = 'SHA256';
 our $BLOCK_SIZE = 1048576;  # 1MiB
 our $ERROR;
 

-=method new
-
-    $fh = File::KDBX::IO::HashBlock->new(%attributes);
-    $fh = File::KDBX::IO::HashBlock->new($fh, %attributes);
-
-Construct a new hash-block stream IO handle.
-
-=cut
-
-sub new {
-    my $class = shift;
-    my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
-    my $self = $class->SUPER::new;
-    $self->_fh($args{fh}) or throw 'IO handle required';
-    $self->algorithm($args{algorithm});
-    $self->block_size($args{block_size});
-    $self->_buffer;
-    return $self;
-}
-

 =attr algorithm
 
 Digest algorithm in hash-blocking the stream (default: C<SHA-256>)
 =attr algorithm
 
 Digest algorithm in hash-blocking the stream (default: C<SHA-256>)


@@ -50,7 +30,7 @@ Desired block size when writing (default: C<$File::KDBX::IO::HashBlock::BLOCK_SI
 
 my %ATTRS = (
     _block_index    => 0,
 
 my %ATTRS = (
     _block_index    => 0,

-    _buffer         => \(my $buf = ''),
+    _buffer         => sub { \(my $buf = '') },

     _finished       => 0,
     algorithm       => sub { $ALGORITHM },
     block_size      => sub { $BLOCK_SIZE },
     _finished       => 0,
     algorithm       => sub { $ALGORITHM },
     block_size      => sub { $BLOCK_SIZE },


@@ -64,6 +44,26 @@ while (my ($attr, $default) = each %ATTRS) {
     };
 }
 
     };
 }
 

+=method new
+
+    $fh = File::KDBX::IO::HashBlock->new(%attributes);
+    $fh = File::KDBX::IO::HashBlock->new($fh, %attributes);
+
+Construct a new hash-block stream IO handle.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
+    my $self = $class->SUPER::new;
+    $self->_fh($args{fh}) or throw 'IO handle required';
+    $self->algorithm($args{algorithm});
+    $self->block_size($args{block_size});
+    $self->_buffer;
+    return $self;
+}
+

 sub _FILL {
     my ($self, $fh) = @_;
 
 sub _FILL {
     my ($self, $fh) = @_;
 

diff --git a/lib/File/KDBX/IO/HmacBlock.pm b/lib/File/KDBX/IO/HmacBlock.pm
index ac07e7e474bb6f5688feee516f2042c03daab7eb..50f054ba2d09fb810deb49cbbdad7b7520f164ac 100644 (file)
--- a/lib/File/KDBX/IO/HmacBlock.pm
+++ b/lib/File/KDBX/IO/HmacBlock.pm
@@ -8,37 +8,15 @@ use Crypt::Digest qw(digest_data);
 use Crypt::Mac::HMAC qw(hmac);
 use Errno;
 use File::KDBX::Error;
 use Crypt::Mac::HMAC qw(hmac);
 use Errno;
 use File::KDBX::Error;

-use File::KDBX::Util qw(:io assert_64bit);
+use File::KDBX::Util qw(:class :io assert_64bit);

 use namespace::clean;
 
 use namespace::clean;
 

-use parent 'File::KDBX::IO';
+extends 'File::KDBX::IO';

 
 our $VERSION = '999.999'; # VERSION
 our $BLOCK_SIZE = 1048576;  # 1MiB
 our $ERROR;
 
 
 our $VERSION = '999.999'; # VERSION
 our $BLOCK_SIZE = 1048576;  # 1MiB
 our $ERROR;
 

-=method new
-
-    $fh = File::KDBX::IO::HmacBlock->new(%attributes);
-    $fh = File::KDBX::IO::HmacBlock->new($fh, %attributes);
-
-Construct a new HMAC-block stream IO handle.
-
-=cut
-
-sub new {
-    assert_64bit;
-
-    my $class = shift;
-    my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
-    my $self = $class->SUPER::new;
-    $self->_fh($args{fh}) or throw 'IO handle required';
-    $self->key($args{key}) or throw 'Key required';
-    $self->block_size($args{block_size});
-    $self->_buffer;
-    return $self;
-}
-

 =attr block_size
 
 Desired block size when writing (default: C<$File::KDBX::IO::HmacBlock::BLOCK_SIZE> or 1,048,576 bytes)
 =attr block_size
 
 Desired block size when writing (default: C<$File::KDBX::IO::HmacBlock::BLOCK_SIZE> or 1,048,576 bytes)


@@ -51,7 +29,7 @@ HMAC-SHA256 key for authenticating the data stream (required)
 
 my %ATTRS = (
     _block_index    => 0,
 
 my %ATTRS = (
     _block_index    => 0,

-    _buffer         => \(my $buf = ''),
+    _buffer         => sub { \(my $buf = '') },

     _finished       => 0,
     block_size      => sub { $BLOCK_SIZE },
     key             => undef,
     _finished       => 0,
     block_size      => sub { $BLOCK_SIZE },
     key             => undef,


@@ -65,6 +43,28 @@ while (my ($attr, $default) = each %ATTRS) {
     };
 }
 
     };
 }
 

+=method new
+
+    $fh = File::KDBX::IO::HmacBlock->new(%attributes);
+    $fh = File::KDBX::IO::HmacBlock->new($fh, %attributes);
+
+Construct a new HMAC-block stream IO handle.
+
+=cut
+
+sub new {
+    assert_64bit;
+
+    my $class = shift;
+    my %args = @_ % 2 == 1 ? (fh => shift, @_) : @_;
+    my $self = $class->SUPER::new;
+    $self->_fh($args{fh}) or throw 'IO handle required';
+    $self->key($args{key}) or throw 'Key required';
+    $self->block_size($args{block_size});
+    $self->_buffer;
+    return $self;
+}
+

 sub _FILL {
     my ($self, $fh) = @_;
 
 sub _FILL {
     my ($self, $fh) = @_;
 

diff --git a/lib/File/KDBX/KDF.pm b/lib/File/KDBX/KDF.pm
index 7d29ec3b7f476480fc8e6096b77f7b0fa23cb193..ce32945361ad81ea6114421932b5a1d9e7b19e44 100644 (file)
--- a/lib/File/KDBX/KDF.pm
+++ b/lib/File/KDBX/KDF.pm
@@ -74,7 +74,7 @@ Get the seed (or salt, depending on the function).
 
 =cut
 
 
 =cut
 

-sub seed { die "Not implemented" }
+sub seed { die 'Not implemented' }

 
 =method transform
 
 
 =method transform
 


@@ -103,7 +103,7 @@ sub transform {
     return $self->_transform($key);
 }
 
     return $self->_transform($key);
 }
 

-sub _transform { die "Not implemented" }
+sub _transform { die 'Not implemented' }

 
 =method randomize_seed
 
 
 =method randomize_seed
 

diff --git a/lib/File/KDBX/KDF/AES.pm b/lib/File/KDBX/KDF/AES.pm
index 548f8620d5b1185e0a49ab59d4840ce24155d361..5d6177b937f613cf99a2c9699884a692244750f5 100644 (file)
--- a/lib/File/KDBX/KDF/AES.pm
+++ b/lib/File/KDBX/KDF/AES.pm
@@ -8,10 +8,10 @@ use Crypt::Cipher;
 use Crypt::Digest qw(digest_data);
 use File::KDBX::Constants qw(:bool :kdf);
 use File::KDBX::Error;
 use Crypt::Digest qw(digest_data);
 use File::KDBX::Constants qw(:bool :kdf);
 use File::KDBX::Error;

-use File::KDBX::Util qw(:load can_fork);
+use File::KDBX::Util qw(:class :load can_fork);

 use namespace::clean;
 
 use namespace::clean;
 

-use parent 'File::KDBX::KDF';
+extends 'File::KDBX::KDF';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 


@@ -23,15 +23,6 @@ BEGIN {
     *_USE_FORK = $use_fork ? \&TRUE : \&FALSE;
 }
 
     *_USE_FORK = $use_fork ? \&TRUE : \&FALSE;
 }
 

-sub init {
-    my $self = shift;
-    my %args = @_;
-    return $self->SUPER::init(
-        KDF_PARAM_AES_ROUNDS()  => $args{+KDF_PARAM_AES_ROUNDS} // $args{rounds},
-        KDF_PARAM_AES_SEED()    => $args{+KDF_PARAM_AES_SEED}   // $args{seed},
-    );
-}
-

 =attr rounds
 
     $rounds = $kdf->rounds;
 =attr rounds
 
     $rounds = $kdf->rounds;


@@ -43,6 +34,15 @@ Get the number of times to run the function during transformation.
 sub rounds  { $_[0]->{+KDF_PARAM_AES_ROUNDS} || KDF_DEFAULT_AES_ROUNDS }
 sub seed    { $_[0]->{+KDF_PARAM_AES_SEED} }
 
 sub rounds  { $_[0]->{+KDF_PARAM_AES_ROUNDS} || KDF_DEFAULT_AES_ROUNDS }
 sub seed    { $_[0]->{+KDF_PARAM_AES_SEED} }
 

+sub init {
+    my $self = shift;
+    my %args = @_;
+    return $self->SUPER::init(
+        KDF_PARAM_AES_ROUNDS()  => $args{+KDF_PARAM_AES_ROUNDS} // $args{rounds},
+        KDF_PARAM_AES_SEED()    => $args{+KDF_PARAM_AES_SEED}   // $args{seed},
+    );
+}
+

 sub _transform {
     my $self    = shift;
     my $key     = shift;
 sub _transform {
     my $self    = shift;
     my $key     = shift;

diff --git a/lib/File/KDBX/KDF/Argon2.pm b/lib/File/KDBX/KDF/Argon2.pm
index 6019380fe016ea218fd2bfd5fdbeb66feb321957..dde0f2c8eb299706bf8a00fc44809634c691c5d6 100644 (file)
--- a/lib/File/KDBX/KDF/Argon2.pm
+++ b/lib/File/KDBX/KDF/Argon2.pm
@@ -7,26 +7,13 @@ use strict;
 use Crypt::Argon2 qw(argon2d_raw argon2id_raw);
 use File::KDBX::Constants qw(:kdf);
 use File::KDBX::Error;
 use Crypt::Argon2 qw(argon2d_raw argon2id_raw);
 use File::KDBX::Constants qw(:kdf);
 use File::KDBX::Error;

+use File::KDBX::Util qw(:class);

 use namespace::clean;
 
 use namespace::clean;
 

-use parent 'File::KDBX::KDF';
+extends 'File::KDBX::KDF';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

-sub init {
-    my $self = shift;
-    my %args = @_;
-    return $self->SUPER::init(
-        KDF_PARAM_ARGON2_SALT()         => $args{+KDF_PARAM_ARGON2_SALT}        // $args{salt},
-        KDF_PARAM_ARGON2_PARALLELISM()  => $args{+KDF_PARAM_ARGON2_PARALLELISM} // $args{parallelism},
-        KDF_PARAM_ARGON2_MEMORY()       => $args{+KDF_PARAM_ARGON2_MEMORY}      // $args{memory},
-        KDF_PARAM_ARGON2_ITERATIONS()   => $args{+KDF_PARAM_ARGON2_ITERATIONS}  // $args{iterations},
-        KDF_PARAM_ARGON2_VERSION()      => $args{+KDF_PARAM_ARGON2_VERSION}     // $args{version},
-        KDF_PARAM_ARGON2_SECRET()       => $args{+KDF_PARAM_ARGON2_SECRET}      // $args{secret},
-        KDF_PARAM_ARGON2_ASSOCDATA()    => $args{+KDF_PARAM_ARGON2_ASSOCDATA}   // $args{assocdata},
-    );
-}
-

 =attr salt
 
 =attr parallelism
 =attr salt
 
 =attr parallelism


@@ -48,6 +35,7 @@ C<version>, C<secret> and C<assocdata> are currently unused.
 =cut
 
 sub salt        { $_[0]->{+KDF_PARAM_ARGON2_SALT} or throw 'Salt is not set' }
 =cut
 
 sub salt        { $_[0]->{+KDF_PARAM_ARGON2_SALT} or throw 'Salt is not set' }

+sub seed        { $_[0]->salt }

 sub parallelism { $_[0]->{+KDF_PARAM_ARGON2_PARALLELISM}    //= KDF_DEFAULT_ARGON2_PARALLELISM }
 sub memory      { $_[0]->{+KDF_PARAM_ARGON2_MEMORY}         //= KDF_DEFAULT_ARGON2_MEMORY }
 sub iterations  { $_[0]->{+KDF_PARAM_ARGON2_ITERATIONS}     //= KDF_DEFAULT_ARGON2_ITERATIONS }
 sub parallelism { $_[0]->{+KDF_PARAM_ARGON2_PARALLELISM}    //= KDF_DEFAULT_ARGON2_PARALLELISM }
 sub memory      { $_[0]->{+KDF_PARAM_ARGON2_MEMORY}         //= KDF_DEFAULT_ARGON2_MEMORY }
 sub iterations  { $_[0]->{+KDF_PARAM_ARGON2_ITERATIONS}     //= KDF_DEFAULT_ARGON2_ITERATIONS }


@@ -55,7 +43,19 @@ sub version     { $_[0]->{+KDF_PARAM_ARGON2_VERSION}        //= KDF_DEFAULT_ARGO
 sub secret      { $_[0]->{+KDF_PARAM_ARGON2_SECRET} }
 sub assocdata   { $_[0]->{+KDF_PARAM_ARGON2_ASSOCDATA} }
 
 sub secret      { $_[0]->{+KDF_PARAM_ARGON2_SECRET} }
 sub assocdata   { $_[0]->{+KDF_PARAM_ARGON2_ASSOCDATA} }
 

-sub seed { $_[0]->salt }
+sub init {
+    my $self = shift;
+    my %args = @_;
+    return $self->SUPER::init(
+        KDF_PARAM_ARGON2_SALT()         => $args{+KDF_PARAM_ARGON2_SALT}        // $args{salt},
+        KDF_PARAM_ARGON2_PARALLELISM()  => $args{+KDF_PARAM_ARGON2_PARALLELISM} // $args{parallelism},
+        KDF_PARAM_ARGON2_MEMORY()       => $args{+KDF_PARAM_ARGON2_MEMORY}      // $args{memory},
+        KDF_PARAM_ARGON2_ITERATIONS()   => $args{+KDF_PARAM_ARGON2_ITERATIONS}  // $args{iterations},
+        KDF_PARAM_ARGON2_VERSION()      => $args{+KDF_PARAM_ARGON2_VERSION}     // $args{version},
+        KDF_PARAM_ARGON2_SECRET()       => $args{+KDF_PARAM_ARGON2_SECRET}      // $args{secret},
+        KDF_PARAM_ARGON2_ASSOCDATA()    => $args{+KDF_PARAM_ARGON2_ASSOCDATA}   // $args{assocdata},
+    );
+}

 
 sub _transform {
     my $self = shift;
 
 sub _transform {
     my $self = shift;

diff --git a/lib/File/KDBX/Key/ChallengeResponse.pm b/lib/File/KDBX/Key/ChallengeResponse.pm
index f9b2d483119b213319e313bd1870e7750bc0dbdd..2bbf36889e6b15f414210cf8b3331d1f3d1cb606 100644 (file)
--- a/lib/File/KDBX/Key/ChallengeResponse.pm
+++ b/lib/File/KDBX/Key/ChallengeResponse.pm
@@ -5,9 +5,10 @@ use warnings;
 use strict;
 
 use File::KDBX::Error;
 use strict;
 
 use File::KDBX::Error;

+use File::KDBX::Util qw(:class);

 use namespace::clean;
 
 use namespace::clean;
 

-use parent 'File::KDBX::Key';
+extends 'File::KDBX::Key';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

diff --git a/lib/File/KDBX/Key/Composite.pm b/lib/File/KDBX/Key/Composite.pm
index 86b803aaeb85f920025492ee396a9921bad30d40..8878bcd2a5dfc024dea5ed3f556c5c5f7708e5c8 100644 (file)
--- a/lib/File/KDBX/Key/Composite.pm
+++ b/lib/File/KDBX/Key/Composite.pm
@@ -6,12 +6,12 @@ use strict;
 
 use Crypt::Digest qw(digest_data);
 use File::KDBX::Error;
 
 use Crypt::Digest qw(digest_data);
 use File::KDBX::Error;

-use File::KDBX::Util qw(:erase);
+use File::KDBX::Util qw(:class :erase);

 use Ref::Util qw(is_arrayref);
 use Scalar::Util qw(blessed);
 use namespace::clean;
 
 use Ref::Util qw(is_arrayref);
 use Scalar::Util qw(blessed);
 use namespace::clean;
 

-use parent 'File::KDBX::Key';
+extends 'File::KDBX::Key';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

diff --git a/lib/File/KDBX/Key/File.pm b/lib/File/KDBX/Key/File.pm
index 5949d4c8afa2ea3147de65bd3a869cd1fbfd909e..fdf131a0993a2fb6fc86c7cff1495ab9561dc596 100644 (file)
--- a/lib/File/KDBX/Key/File.pm
+++ b/lib/File/KDBX/Key/File.pm
@@ -9,16 +9,46 @@ use Crypt::Misc 0.029 qw(decode_b64 encode_b64);
 use Crypt::PRNG qw(random_bytes);
 use File::KDBX::Constants qw(:key_file);
 use File::KDBX::Error;
 use Crypt::PRNG qw(random_bytes);
 use File::KDBX::Constants qw(:key_file);
 use File::KDBX::Error;

-use File::KDBX::Util qw(:erase trim);
+use File::KDBX::Util qw(:class :erase trim);

 use Ref::Util qw(is_ref is_scalarref);
 use Scalar::Util qw(openhandle);
 use XML::LibXML::Reader;
 use namespace::clean;
 
 use Ref::Util qw(is_ref is_scalarref);
 use Scalar::Util qw(openhandle);
 use XML::LibXML::Reader;
 use namespace::clean;
 

-use parent 'File::KDBX::Key';
+extends 'File::KDBX::Key';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

+=attr type
+
+    $type = $key->type;
+
+Get the type of key file. Can be one of:
+
+=for :list
+* C<KEY_FILE_TYPE_BINARY>
+* C<KEY_FILE_TYPE_HEX>
+* C<KEY_FILE_TYPE_XML>
+* C<KEY_FILE_TYPE_HASHED>
+
+=attr version
+
+    $version = $key->version;
+
+Get the file version. Only applies to XML key files.
+
+=attr filepath
+
+    $filepath = $key->filepath;
+
+Get the filepath to the key file, if known.
+
+=cut
+
+has 'type',     is => 'ro';
+has 'version',  is => 'ro';
+has 'filepath', is => 'ro';
+

 =method load
 
     $key = $key->load($filepath);
 =method load
 
     $key = $key->load($filepath);


@@ -97,42 +127,6 @@ sub reload {
     return $self;
 }
 
     return $self;
 }
 

-=attr type
-
-    $type = $key->type;
-
-Get the type of key file. Can be one of:
-
-=for :list
-* C<KEY_FILE_TYPE_BINARY>
-* C<KEY_FILE_TYPE_HEX>
-* C<KEY_FILE_TYPE_XML>
-* C<KEY_FILE_TYPE_HASHED>
-
-=cut
-
-sub type { $_[0]->{type} }
-
-=attr version
-
-    $version = $key->version;
-
-Get the file version. Only applies to XML key files.
-
-=cut
-
-sub version { $_[0]->{version} }
-
-=attr filepath
-
-    $filepath = $key->filepath;
-
-Get the filepath to the key file, if known.
-
-=cut
-
-sub filepath { $_[0]->{filepath} }
-

 =method save
 
     $key->save;
 =method save
 
     $key->save;

diff --git a/lib/File/KDBX/Key/Password.pm b/lib/File/KDBX/Key/Password.pm
index ba46f99b501d56a11dd6ebcb171f593726881eac..032de09d64337c5dc8096cdf032eeb361092c9e1 100644 (file)
--- a/lib/File/KDBX/Key/Password.pm
+++ b/lib/File/KDBX/Key/Password.pm
@@ -7,10 +7,10 @@ use strict;
 use Crypt::Digest qw(digest_data);
 use Encode qw(encode);
 use File::KDBX::Error;
 use Crypt::Digest qw(digest_data);
 use Encode qw(encode);
 use File::KDBX::Error;

-use File::KDBX::Util qw(erase);
+use File::KDBX::Util qw(:class erase);

 use namespace::clean;
 
 use namespace::clean;
 

-use parent 'File::KDBX::Key';
+extends 'File::KDBX::Key';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

diff --git a/lib/File/KDBX/Key/YubiKey.pm b/lib/File/KDBX/Key/YubiKey.pm
index 51a05aae4de441051e8b477f0da86036cb5ff7d3..0e42eb0766a68ffe1a8d99f260a4be03504bc4ce 100644 (file)
--- a/lib/File/KDBX/Key/YubiKey.pm
+++ b/lib/File/KDBX/Key/YubiKey.pm
@@ -6,13 +6,13 @@ use strict;
 
 use File::KDBX::Constants qw(:yubikey);
 use File::KDBX::Error;
 
 use File::KDBX::Constants qw(:yubikey);
 use File::KDBX::Error;

-use File::KDBX::Util qw(:io pad_pkcs7);
+use File::KDBX::Util qw(:class :io pad_pkcs7);

 use IPC::Cmd 0.52 qw(run_forked);
 use Ref::Util qw(is_arrayref);
 use Symbol qw(gensym);
 use namespace::clean;
 
 use IPC::Cmd 0.52 qw(run_forked);
 use Ref::Util qw(is_arrayref);
 use Symbol qw(gensym);
 use namespace::clean;
 

-use parent 'File::KDBX::Key::ChallengeResponse';
+extends 'File::KDBX::Key::ChallengeResponse';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 


@@ -222,40 +222,13 @@ Get or set the L<ykinfo(1)> program name or filepath. Defaults to C<$ENV{YKINFO}
 
 =cut
 
 
 =cut
 

-my %ATTRS = (
-    device          => 0,
-    slot            => 1,
-    timeout         => 10,
-    pre_challenge   => undef,
-    post_challenge  => undef,
-    ykchalresp      => sub { $ENV{YKCHALRESP} || 'ykchalresp' },
-    ykinfo          => sub { $ENV{YKINFO} || 'ykinfo' },
-);
-while (my ($subname, $default) = each %ATTRS) {
-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    *{$subname} = sub {
-        my $self = shift;
-        $self->{$subname} = shift if @_;
-        $self->{$subname} //= (ref $default eq 'CODE') ? $default->($self) : $default;
-    };
-}
-
-my %INFO = (
-    serial      => undef,
-    version     => undef,
-    touch_level => undef,
-    vendor_id   => undef,
-    product_id  => undef,
-);
-while (my ($subname, $default) = each %INFO) {
-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    *{$subname} = sub {
-        my $self = shift;
-        $self->{$subname} = shift if @_;
-        defined $self->{$subname} or $self->_set_yubikey_info;
-        $self->{$subname} // $default;
-    };
-}
+has device          => 0;
+has slot            => 1;
+has timeout         => 10;
+has pre_challenge   => undef;
+has post_challenge  => undef;
+has ykchalresp      => sub { $ENV{YKCHALRESP} || 'ykchalresp' };
+has ykinfo          => sub { $ENV{YKINFO}     || 'ykinfo' };

 
 =method serial
 
 
 =method serial
 


@@ -275,6 +248,14 @@ Get the "touch level" value for the device associated with this key (or C<undef>
 
 Get the vendor ID or product ID for the device associated with this key (or C<undef>).
 
 
 Get the vendor ID or product ID for the device associated with this key (or C<undef>).
 

+=cut
+
+has serial      => sub { $_[0]->_set_yubikey_info; $_[0]->{serial} };
+has version     => sub { $_[0]->_set_yubikey_info; $_[0]->{version} };
+has touch_level => sub { $_[0]->_set_yubikey_info; $_[0]->{touch_level} };
+has vendor_id   => sub { $_[0]->_set_yubikey_info; $_[0]->{vendor_id} };
+has product_id  => sub { $_[0]->_set_yubikey_info; $_[0]->{product_id} };
+

 =method name
 
     $name = $key->name;
 =method name
 
     $name = $key->name;

diff --git a/lib/File/KDBX/Loader.pm b/lib/File/KDBX/Loader.pm
index ff44832c6d92b985394083500e68a569c65d246d..6d289be0f091e94973de72a0bfedb9d3e9cbbbe4 100644 (file)
--- a/lib/File/KDBX/Loader.pm
+++ b/lib/File/KDBX/Loader.pm
@@ -6,7 +6,7 @@ use strict;
 
 use File::KDBX::Constants qw(:magic :header :version);
 use File::KDBX::Error;
 
 use File::KDBX::Constants qw(:magic :header :version);
 use File::KDBX::Error;

-use File::KDBX::Util qw(:io);
+use File::KDBX::Util qw(:class :io);

 use File::KDBX;
 use IO::Handle;
 use Module::Load ();
 use File::KDBX;
 use IO::Handle;
 use Module::Load ();


@@ -223,10 +223,6 @@ Possible formats:
 * C<XML>
 * C<Raw>
 
 * C<XML>
 * C<Raw>
 

-=cut
-
-sub format { $_[0]->{format} }
-

 =attr inner_format
 
 Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible
 =attr inner_format
 
 Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible


@@ -238,9 +234,10 @@ formats:
 
 =cut
 
 
 =cut
 

-sub inner_format { $_[0]->{inner_format} // 'XML' }
+has format          => undef, is => 'ro';
+has inner_format    => 'XML', is => 'ro';

 
 

-=attr min_version
+=method min_version

 
     $min_version = File::KDBX::Loader->min_version;
 
 
     $min_version = File::KDBX::Loader->min_version;
 

diff --git a/lib/File/KDBX/Loader/KDB.pm b/lib/File/KDBX/Loader/KDB.pm
index 1f0cb3d881457a0df3b999b37cd41de77e437de5..e204365266ae658b860ce5f4425243d7dadc0cf3 100644 (file)
--- a/lib/File/KDBX/Loader/KDB.pm
+++ b/lib/File/KDBX/Loader/KDB.pm
@@ -7,7 +7,7 @@ use strict;
 use Encode qw(encode);
 use File::KDBX::Constants qw(:header :cipher :random_stream :icon);
 use File::KDBX::Error;
 use Encode qw(encode);
 use File::KDBX::Constants qw(:header :cipher :random_stream :icon);
 use File::KDBX::Error;

-use File::KDBX::Util qw(:empty :io :uuid load_optional);
+use File::KDBX::Util qw(:class :empty :io :uuid load_optional);

 use File::KDBX;
 use Ref::Util qw(is_arrayref is_hashref);
 use Scalar::Util qw(looks_like_number);
 use File::KDBX;
 use Ref::Util qw(is_arrayref is_hashref);
 use Scalar::Util qw(looks_like_number);


@@ -15,7 +15,7 @@ use Time::Piece;
 use boolean;
 use namespace::clean;
 
 use boolean;
 use namespace::clean;
 

-use parent 'File::KDBX::Loader';
+extends 'File::KDBX::Loader';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

diff --git a/lib/File/KDBX/Loader/Raw.pm b/lib/File/KDBX/Loader/Raw.pm
index 58e920dd7f6129245b01090e11dac37cc588fb8e..7eeaaee500b25aa41f8d3932238313fd76f753e9 100644 (file)
--- a/lib/File/KDBX/Loader/Raw.pm
+++ b/lib/File/KDBX/Loader/Raw.pm
@@ -4,7 +4,9 @@ package File::KDBX::Loader::Raw;
 use warnings;
 use strict;
 
 use warnings;
 use strict;
 

-use parent 'File::KDBX::Loader';
+use File::KDBX::Util qw(:class);
+
+extends 'File::KDBX::Loader';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

diff --git a/lib/File/KDBX/Loader/V3.pm b/lib/File/KDBX/Loader/V3.pm
index 687215a00caff562637ffd507e23c4e752ca084b..4b89fe97792f2c23617e7a7483a80f11d90818c6 100644 (file)
--- a/lib/File/KDBX/Loader/V3.pm
+++ b/lib/File/KDBX/Loader/V3.pm
@@ -22,10 +22,10 @@ use File::KDBX::Constants qw(:header :compression :kdf);
 use File::KDBX::Error;
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HashBlock;
 use File::KDBX::Error;
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HashBlock;

-use File::KDBX::Util qw(:io :load assert_64bit erase_scoped);
+use File::KDBX::Util qw(:class :io :load assert_64bit erase_scoped);

 use namespace::clean;
 
 use namespace::clean;
 

-use parent 'File::KDBX::Loader';
+extends 'File::KDBX::Loader';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 


@@ -42,7 +42,7 @@ sub _read_header {
         $buf .= $val;
     }
 
         $buf .= $val;
     }
 

-    $type = KDBX_HEADER($type);
+    $type = kdbx_header($type);

     if ($type == HEADER_END) {
         # done
     }
     if ($type == HEADER_END) {
         # done
     }

diff --git a/lib/File/KDBX/Loader/V4.pm b/lib/File/KDBX/Loader/V4.pm
index 2180d28df8d37c9b11ed301cc83becc47fe856ea..87e88262588654b74fe0fad80946405306f74bb5 100644 (file)
--- a/lib/File/KDBX/Loader/V4.pm
+++ b/lib/File/KDBX/Loader/V4.pm
@@ -22,13 +22,13 @@ use Crypt::Mac::HMAC qw(hmac);
 use Encode qw(decode);
 use File::KDBX::Constants qw(:header :inner_header :variant_map :compression);
 use File::KDBX::Error;
 use Encode qw(decode);
 use File::KDBX::Constants qw(:header :inner_header :variant_map :compression);
 use File::KDBX::Error;

-use File::KDBX::Util qw(:io :load assert_64bit erase_scoped);
+use File::KDBX::Util qw(:class :io :load assert_64bit erase_scoped);

 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HmacBlock;
 use boolean;
 use namespace::clean;
 
 use File::KDBX::IO::Crypt;
 use File::KDBX::IO::HmacBlock;
 use boolean;
 use namespace::clean;
 

-use parent 'File::KDBX::Loader';
+extends 'File::KDBX::Loader';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 


@@ -45,7 +45,7 @@ sub _read_header {
         $buf .= $val;
     }
 
         $buf .= $val;
     }
 

-    $type = KDBX_HEADER($type);
+    $type = kdbx_header($type);

     if ($type == HEADER_END) {
         # done
     }
     if ($type == HEADER_END) {
         # done
     }


@@ -236,7 +236,7 @@ sub _read_inner_header {
         read_all $fh, $val, $size or throw 'Expected inner header value', type => $type, size => $size;
     }
 
         read_all $fh, $val, $size or throw 'Expected inner header value', type => $type, size => $size;
     }
 

-    my $dualtype = KDBX_INNER_HEADER($type);
+    my $dualtype = kdbx_inner_header($type);

 
     if (!defined $dualtype) {
         alert "Ignoring unknown inner header type ($type)", type => $type, size => $size, value => $val;
 
     if (!defined $dualtype) {
         alert "Ignoring unknown inner header type ($type)", type => $type, size => $size, value => $val;

diff --git a/lib/File/KDBX/Loader/XML.pm b/lib/File/KDBX/Loader/XML.pm
index 806b261664b99605aab6d04d22d1910d2dce9737..a607405de14464450dd035c039c37b85a3dd60c6 100644 (file)
--- a/lib/File/KDBX/Loader/XML.pm
+++ b/lib/File/KDBX/Loader/XML.pm
@@ -9,22 +9,19 @@ use Encode qw(decode);
 use File::KDBX::Constants qw(:version :time);
 use File::KDBX::Error;
 use File::KDBX::Safe;
 use File::KDBX::Constants qw(:version :time);
 use File::KDBX::Error;
 use File::KDBX::Safe;

-use File::KDBX::Util qw(:text assert_64bit gunzip erase_scoped);
+use File::KDBX::Util qw(:class :text assert_64bit gunzip erase_scoped);

 use Scalar::Util qw(looks_like_number);
 use Time::Piece;
 use XML::LibXML::Reader;
 use boolean;
 use namespace::clean;
 
 use Scalar::Util qw(looks_like_number);
 use Time::Piece;
 use XML::LibXML::Reader;
 use boolean;
 use namespace::clean;
 

-use parent 'File::KDBX::Loader';
+extends 'File::KDBX::Loader';

 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 

-sub _reader { $_[0]->{_reader} }
-
-sub _binaries { $_[0]->{binaries} //= {} }
-
-sub _safe { $_[0]->{safe} //= File::KDBX::Safe->new(cipher => $_[0]->kdbx->random_stream) }
+has '_reader',  is => 'ro';
+has '_safe',    is => 'ro', default => sub { File::KDBX::Safe->new(cipher => $_[0]->kdbx->random_stream) };

 
 sub _read {
     my $self = shift;
 
 sub _read {
     my $self = shift;


@@ -39,7 +36,7 @@ sub _read_inner_body {
 
     my $reader = $self->{_reader} = XML::LibXML::Reader->new(IO => $fh);
 
 
     my $reader = $self->{_reader} = XML::LibXML::Reader->new(IO => $fh);
 

-    delete $self->{safe};
+    delete $self->{_safe};

     my $root_done;
 
     my $pattern = XML::LibXML::Pattern->new('/KeePassFile/Meta|/KeePassFile/Root');
     my $root_done;
 
     my $pattern = XML::LibXML::Pattern->new('/KeePassFile/Meta|/KeePassFile/Root');


@@ -63,7 +60,7 @@ sub _read_inner_body {
         throw 'Failed to parse KeePass XML';
     }
 
         throw 'Failed to parse KeePass XML';
     }
 

-    $self->kdbx->_safe($self->_safe) if $self->{safe};
+    $self->kdbx->_safe($self->_safe) if $self->{_safe};

 
     $self->_resolve_binary_refs;
 }
 
     $self->_resolve_binary_refs;
 }

diff --git a/lib/File/KDBX/Object.pm b/lib/File/KDBX/Object.pm
index afede78ae0894c4a1e5677f5592490510d9dab4d..0d53dd91e4885345d8099fa5dad276fdd392ca67 100644 (file)
--- a/lib/File/KDBX/Object.pm
+++ b/lib/File/KDBX/Object.pm
@@ -721,7 +721,7 @@ object or an object not part of the object tree of a database can be added to a
 * L<File::KDBX::Group/add_group>
 * L<File::KDBX::Entry/add_historical_entry>
 
 * L<File::KDBX::Group/add_group>
 * L<File::KDBX::Entry/add_historical_entry>
 

-It is possible to copy or move objects between databases, but you B<DO NOT> include the same object in more
+It is possible to copy or move objects between databases, but B<DO NOT> include the same object in more

 than one database at once or there could some strange aliasing effects (i.e. changes in one database might
 effect another in unexpected ways). This could lead to difficult-to-debug problems. It is similarly not safe
 or valid to add the same object multiple times to the same database. For example:
 than one database at once or there could some strange aliasing effects (i.e. changes in one database might
 effect another in unexpected ways). This could lead to difficult-to-debug problems. It is similarly not safe
 or valid to add the same object multiple times to the same database. For example:

diff --git a/lib/File/KDBX/Transaction.pm b/lib/File/KDBX/Transaction.pm
index 0ed48b2141e8db8b904c1c6f94bf3d4a05f99076..218494dd3db8b7897f5659a7ab368afb57b9218f 100644 (file)
--- a/lib/File/KDBX/Transaction.pm
+++ b/lib/File/KDBX/Transaction.pm
@@ -5,6 +5,7 @@ use warnings;
 use strict;
 
 use Devel::GlobalDestruction;
 use strict;
 
 use Devel::GlobalDestruction;

+use File::KDBX::Util qw(:class);

 use namespace::clean;
 
 our $VERSION = '999.999'; # VERSION
 use namespace::clean;
 
 our $VERSION = '999.999'; # VERSION


@@ -32,7 +33,7 @@ Get the object being transacted on.
 
 =cut
 
 
 =cut
 

-sub object { $_[0]->{object} }
+has 'object', is => 'ro';

 
 =method commit
 
 
 =method commit
 

diff --git a/lib/File/KDBX/Util.pm b/lib/File/KDBX/Util.pm
index 3355d41fa1d3454c119a14dbd98d900abef70083..9fe9a9eb318faf99efe195d2928b875b79ef4185 100644 (file)
--- a/lib/File/KDBX/Util.pm
+++ b/lib/File/KDBX/Util.pm
@@ -12,14 +12,18 @@ use File::KDBX::Error;
 use List::Util 1.33 qw(any all);
 use Module::Load;
 use Ref::Util qw(is_arrayref is_coderef is_hashref is_ref is_refref is_scalarref);
 use List::Util 1.33 qw(any all);
 use Module::Load;
 use Ref::Util qw(is_arrayref is_coderef is_hashref is_ref is_refref is_scalarref);

-use Scalar::Util qw(blessed readonly);
+use Scalar::Util qw(blessed looks_like_number readonly);
+use Time::Piece;
+use boolean;

 use namespace::clean -except => 'import';
 
 our $VERSION = '999.999'; # VERSION
 
 our %EXPORT_TAGS = (
     assert      => [qw(assert_64bit)],
 use namespace::clean -except => 'import';
 
 our $VERSION = '999.999'; # VERSION
 
 our %EXPORT_TAGS = (
     assert      => [qw(assert_64bit)],

+    class       => [qw(extends has)],

     clone       => [qw(clone clone_nomagic)],
     clone       => [qw(clone clone_nomagic)],

+    coercion    => [qw(to_bool to_number to_string to_time to_tristate to_uuid)],

     crypt       => [qw(pad_pkcs7)],
     debug       => [qw(dumper)],
     fork        => [qw(can_fork)],
     crypt       => [qw(pad_pkcs7)],
     debug       => [qw(dumper)],
     fork        => [qw(can_fork)],


@@ -359,6 +363,89 @@ sub erase_scoped {
     return Scope::Guard->new(sub { erase(@args) });
 }
 
     return Scope::Guard->new(sub { erase(@args) });
 }
 

+=func extends
+
+    extends $class;
+
+Set up the current module to inheret from another module.
+
+=cut
+
+sub extends {
+    my $parent  = shift;
+    my $caller  = caller;
+    load $parent;
+    no strict 'refs'; ## no critic (ProhibitNoStrict)
+    @{"${caller}::ISA"} = $parent;
+}
+
+=func has
+
+    has $name => %options;
+
+Create an attribute getter/setter. Possible options:
+
+=for :list
+* C<is> - Either "rw" (default) or "ro"
+* C<default> - Default value
+* C<coerce> - Coercive function
+
+=cut
+
+sub has {
+    my $name = shift;
+    my %args = @_ % 2 == 1 ? (default => shift, @_) : @_;
+
+    my $d = $args{default};
+    my $default = is_arrayref($d) ? sub { [%$d] } : is_hashref($d) ? sub { +{%$d} } : $d;
+    my $coerce  = $args{coerce};
+    my $is      = $args{is} || 'rw';
+
+    my $has_default = is_coderef $default;
+    my $has_coerce  = is_coderef $coerce;
+
+    my $caller = caller;
+    no strict 'refs'; ## no critic (ProhibitNoStrict)
+    if (my $store = $args{store}) {
+        *{"${caller}::${name}"} = $is eq 'ro' && $has_default ? sub {
+            $_[0]->$store->{$name} //= scalar $default->($_[0]);
+        } : $is eq 'ro' ? sub {
+            $_[0]->$store->{$name} //= $default;
+        } : $has_default && $has_coerce ? sub {
+            $#_ ? $_[0]->$store->{$name} = scalar $coerce->($_[1])
+                : $_[0]->$store->{$name} //= scalar $default->($_[0]);
+        } : $has_default ? sub {
+            $#_ ? $_[0]->$store->{$name} = $_[1]
+                : $_[0]->$store->{$name} //= scalar $default->($_[0]);
+        } : $has_coerce ? sub {
+            $#_ ? $_[0]->$store->{$name} = scalar $coerce->($_[1])
+                : $_[0]->$store->{$name} //= $default;
+        } : sub {
+            $#_ ? $_[0]->$store->{$name} = $_[1]
+                : $_[0]->$store->{$name} //= $default;
+        };
+    }
+    else {
+        *{"${caller}::${name}"} = $is eq 'ro' && $has_default ? sub {
+            $_[0]->{$name} //= scalar $default->($_[0]);
+        } : $is eq 'ro' ? sub {
+            $_[0]->{$name} //= $default;
+        } : $has_default && $has_coerce ? sub {
+            $#_ ? $_[0]->{$name} = scalar $coerce->($_[1])
+                : $_[0]->{$name} //= scalar $default->($_[0]);
+        } : $has_default ? sub {
+            $#_ ? $_[0]->{$name} = $_[1]
+                : $_[0]->{$name} //= scalar $default->($_[0]);
+        } : $has_coerce ? sub {
+            $#_ ? $_[0]->{$name} = scalar $coerce->($_[1])
+                : $_[0]->{$name} //= $default;
+        } : sub {
+            $#_ ? $_[0]->{$name} = $_[1]
+                : ($_[0]->{$name} //= $default);
+        };
+    }
+}
+

 =func format_uuid
 
     $string_uuid = format_uuid($raw_uuid);
 =func format_uuid
 
     $string_uuid = format_uuid($raw_uuid);


@@ -637,6 +724,10 @@ sub search {
     return \@match;
 }
 
     return \@match;
 }
 

+=for Pod::Coverage search_limited
+
+=cut
+

 sub search_limited {
     my $list    = shift;
     my $query   = shift;
 sub search_limited {
     my $list    = shift;
     my $query   = shift;


@@ -764,6 +855,39 @@ sub split_url {
     return ($scheme, $auth, $host, $port, $path, $query, $hash, $username, $password);
 }
 
     return ($scheme, $auth, $host, $port, $path, $query, $hash, $username, $password);
 }
 

+=func to_bool
+
+=func to_number
+
+=func to_string
+
+=func to_time
+
+=func to_tristate
+
+=func to_uuid
+
+Various typecasting / coercive functions.
+
+=cut
+
+sub to_bool   { $_[0] // return; boolean($_[0]) }
+sub to_number { $_[0] // return; 0+$_[0] }
+sub to_string { $_[0] // return; "$_[0]" }
+sub to_time   {
+    $_[0] // return;
+    return gmtime($_[0]) if looks_like_number($_[0]);
+    return Time::Piece->strptime($_[0], '%Y-%m-%d %H:%M:%S') if !blessed $_[0];
+    return $_[0];
+}
+sub to_tristate { $_[0] // return; boolean($_[0]) }
+sub to_uuid {
+    my $str = to_string(@_) // return;
+    return sprintf('%016s', $str) if length($str) < 16;
+    return substr($str, 0, 16) if 16 < length($str);
+    return $str;
+}
+

 =func trim
 
     $string = trim($string);
 =func trim
 
     $string = trim($string);