]> Dogcows Code - chaz/p5-File-KDBX/blobdiff - lib/File/KDBX/Entry.pm
projects / chaz / p5-File-KDBX / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Add function for creating class attributes
[chaz/p5-File-KDBX] / lib / File / KDBX / Entry.pm
diff --git a/lib/File/KDBX/Entry.pm b/lib/File/KDBX/Entry.pm
index c124b94203adf169a84aeec91374b2a6ad4e6324..fc744fd8c3c00c3c9e47deadc9f8a7d71db05a17 100644 (file)
--- a/lib/File/KDBX/Entry.pm
+++ b/lib/File/KDBX/Entry.pm
@@ -4,22 +4,22 @@ 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 Hash::Util::FieldHash;
-use List::Util qw(sum0);
-use Ref::Util qw(is_plain_hashref);
+use List::Util qw(first sum0);
+use Ref::Util qw(is_coderef is_plain_hashref);
 use Scalar::Util qw(looks_like_number);
 use Storable qw(dclone);
 use Time::Piece;
 use boolean;
 use namespace::clean;
 
 use Scalar::Util qw(looks_like_number);
 use Storable qw(dclone);
 use Time::Piece;
 use boolean;
 use namespace::clean;
 
-use parent 'File::KDBX::Object';
+extends 'File::KDBX::Object';
 
 our $VERSION = '999.999'; # VERSION
 
 
 our $VERSION = '999.999'; # VERSION
 
@@ -132,7 +132,7 @@ Boolean value indicating whether or not an entry is expired.
 
 =attr usage_count
 
 
 =attr usage_count
 
-The number of times an entry has been used, which typically means how many times the C<Password> string has
+The number of times an entry has been used, which typically means how many times the B<Password> string has
 been accessed.
 
 =attr location_changed
 been accessed.
 
 =attr location_changed
@@ -141,23 +141,23 @@ Date and time when the entry was last moved to a different group.
 
 =attr notes
 
 
 =attr notes
 
-Alias for the C<Notes> string value.
+Alias for the B<Notes> string value.
 
 =attr password
 
 
 =attr password
 
-Alias for the C<Password> string value.
+Alias for the B<Password> string value.
 
 =attr title
 
 
 =attr title
 
-Alias for the C<Title> string value.
+Alias for the B<Title> string value.
 
 =attr url
 
 
 =attr url
 
-Alias for the C<URL> string value.
+Alias for the B<URL> string value.
 
 =attr username
 
 
 =attr username
 
-Aliases for the C<UserName> string value.
+Aliases for the B<UserName> string value.
 
 =cut
 
 
 =cut
 
@@ -170,38 +170,37 @@ sub uuid {
         for my $entry (@{$self->history}) {
             $entry->{uuid} = $uuid;
         }
         for my $entry (@{$self->history}) {
             $entry->{uuid} = $uuid;
         }
-        # if (defined $old_uuid and my $kdbx = $KDBX{$self}) {
-        #     $kdbx->_update_entry_uuid($old_uuid, $uuid, $self);
-        # }
+        $self->_signal('uuid.changed', $uuid, $old_uuid) if defined $old_uuid && $self->is_current;
     }
     $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                 => 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 { gmtime },
-    creation_time           => sub { gmtime },
-    last_access_time        => sub { gmtime },
-    expiry_time             => sub { gmtime },
-    expires                 => false,
-    usage_count             => 0,
-    location_changed        => sub { gmtime },
+    last_modification_time  => [sub { gmtime }, coerce => \&to_time],
+    creation_time           => [sub { gmtime }, coerce => \&to_time],
+    last_access_time        => [sub { gmtime }, coerce => \&to_time],
+    expiry_time             => [sub { gmtime }, coerce => \&to_time],
+    expires                 => [false,          coerce => \&to_bool],
+    usage_count             => [0,              coerce => \&to_number],
+    location_changed        => [sub { gmtime }, coerce => \&to_time],
 );
 my %ATTRS_STRINGS = (
     title                   => 'Title',
 );
 my %ATTRS_STRINGS = (
     title                   => 'Title',
@@ -211,22 +210,13 @@ my %ATTRS_STRINGS = (
     notes                   => 'Notes',
 );
 
     notes                   => 'Notes',
 );
 
+has icon_id => ICON_PASSWORD, coerce => sub { icon($_[0]) };
+
 while (my ($attr, $default) = each %ATTRS) {
 while (my ($attr, $default) = each %ATTRS) {
-    no strict 'refs'; ## no critic (ProhibitNoStrict)
-    *{$attr} = sub {
-        my $self = shift;
-        $self->{$attr} = shift if @_;
-        $self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
-    };
+    has $attr => @$default;
 }
 while (my ($attr, $default) = each %ATTRS_TIMES) {
 }
 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)
@@ -798,25 +788,83 @@ sub prune_history {
     }
 }
 
     }
 }
 
-sub add_history {
+=method add_historical_entry
+
+    $entry->add_historical_entry($entry);
+
+Add an entry to the history.
+
+=cut
+
+sub add_historical_entry {
     my $self = shift;
     delete $_->{history} for @_;
     push @{$self->{history} //= []}, map { $self->_wrap_entry($_) } @_;
 }
 
     my $self = shift;
     delete $_->{history} for @_;
     push @{$self->{history} //= []}, map { $self->_wrap_entry($_) } @_;
 }
 
+=method current_entry
+
+    $current_entry = $entry->current_entry;
+
+Get an entry's current entry. If the entry itself is current (not historical), itself is returned.
+
+=cut
+
+sub current_entry {
+    my $self    = shift;
+    my $group   = $self->parent;
+
+    if ($group) {
+        my $id = $self->uuid;
+        my $entry = first { $id eq $_->uuid } @{$group->entries};
+        return $entry if $entry;
+    }
+
+    return $self;
+}
+
+=method is_current
+
+    $bool = $entry->is_current;
+
+Get whether or not an entry is considered current (i.e. not historical). An entry is current if it is directly
+in the parent group's entry list.
+
+=cut
+
+sub is_current {
+    my $self    = shift;
+    my $current = $self->current_entry;
+    return Hash::Util::FieldHash::id($self) == Hash::Util::FieldHash::id($current);
+}
+
+=method is_historical
+
+    $bool = $entry->is_historical;
+
+Get whether or not an entry is considered historical (i.e. not current).
+
+This is just the inverse of L</is_current>.
+
+=cut
+
+sub is_historical { !$_[0]->is_current }
+
 ##############################################################################
 
 ##############################################################################
 
-sub begin_work {
+sub _signal {
     my $self = shift;
     my $self = shift;
-    require File::KDBX::Transaction;
-    return File::KDBX::Transaction->new($self, @_);
+    my $type = shift;
+    return $self->SUPER::_signal("entry.$type", @_);
 }
 
 sub _commit {
     my $self = shift;
 }
 
 sub _commit {
     my $self = shift;
-    my $txn  = shift;
-    $self->add_history($txn->original);
-    $self->last_modification_time(gmtime);
+    my $orig = shift;
+    $self->add_historical_entry($orig);
+    my $time = gmtime;
+    $self->last_modification_time($time);
+    $self->last_access_time($time);
 }
 
 sub label { shift->expanded_title(@_) }
 }
 
 sub label { shift->expanded_title(@_) }
@@ -831,11 +879,11 @@ called "files" or "attachments"). Every string and binary has a key or name. The
 that every entry has:
 
 =for :list
 that every entry has:
 
 =for :list
-* C<Title>
-* C<UserName>
-* C<Password>
-* C<URL>
-* C<Notes>
+* B<Title>
+* B<UserName>
+* B<Password>
+* B<URL>
+* B<Notes>
 
 Beyond this, you can store any number of other strings and any number of binaries that you can use for
 whatever purpose you want.
 
 Beyond this, you can store any number of other strings and any number of binaries that you can use for
 whatever purpose you want.
@@ -844,12 +892,14 @@ There is also some metadata associated with an entry. Each entry in a database i
 a UUID. An entry can also have an icon associated with it, and there are various timestamps. Take a look at
 the attributes to see what's available.
 
 a UUID. An entry can also have an icon associated with it, and there are various timestamps. Take a look at
 the attributes to see what's available.
 
+A B<File::KDBX::Entry> is a subclass of L<File::KDBX::Object>.
+
 =head2 Placeholders
 
 Entry string and auto-type key sequences can have placeholders or template tags that can be replaced by other
 values. Placeholders can appear like C<{PLACEHOLDER}>. For example, a B<URL> string might have a value of
 C<http://example.com?user={USERNAME}>. C<{USERNAME}> is a placeholder for the value of the B<UserName> string
 =head2 Placeholders
 
 Entry string and auto-type key sequences can have placeholders or template tags that can be replaced by other
 values. Placeholders can appear like C<{PLACEHOLDER}>. For example, a B<URL> string might have a value of
 C<http://example.com?user={USERNAME}>. C<{USERNAME}> is a placeholder for the value of the B<UserName> string
-of the same entry. If the C<UserName> string had a value of "batman", the B<URL> string would expand to
+of the same entry. If the B<UserName> string had a value of "batman", the B<URL> string would expand to
 C<http://example.com?user=batman>.
 
 Some placeholders take an argument, where the argument follows the tag after a colon but before the closing
 C<http://example.com?user=batman>.
 
 Some placeholders take an argument, where the argument follows the tag after a colon but before the closing
@@ -962,7 +1012,7 @@ C<{NUMPAD4}>, C<{NUMPAD5}>, C<{NUMPAD6}>, C<{NUMPAD7}>, C<{NUMPAD8}>, C<{NUMPAD9
 * ☒ C<{CLIPBOARD}>
 * ☒ C<{CMD:/CommandLine/Options/}>
 * ☑ C<{C:Comment}> - Comments are simply replaced by nothing
 * ☒ C<{CLIPBOARD}>
 * ☒ C<{CMD:/CommandLine/Options/}>
 * ☑ C<{C:Comment}> - Comments are simply replaced by nothing
-* ☑ C<{ENV:} and C<%ENV%> - Environment variables
+* ☑ C<{ENV:}> and C<%ENV%> - Environment variables
 * ☒ C<{GROUP_SEL_NOTES}>
 * ☒ C<{GROUP_SEL_PATH}>
 * ☒ C<{GROUP_SEL}>
 * ☒ C<{GROUP_SEL_NOTES}>
 * ☒ C<{GROUP_SEL_PATH}>
 * ☒ C<{GROUP_SEL}>
@@ -996,7 +1046,7 @@ strings or auto-complete key sequences.
 
 If the name of the placeholder ends in a colon, then it is expected to receive an argument. During expansion,
 everything after the colon and before the end of the placeholder is passed to your placeholder handler
 
 If the name of the placeholder ends in a colon, then it is expected to receive an argument. During expansion,
 everything after the colon and before the end of the placeholder is passed to your placeholder handler
-subroutine. So if the placeholder is C<{MY_PLACEHOLDER:whatever}>, C<$arg> will have the value C<whatever>.
+subroutine. So if the placeholder is C<{MY_PLACEHOLDER:whatever}>, C<$arg> will have the value B<whatever>.
 
 An argument is required for placeholders than take one. I.e. The placeholder handler won't be called if there
 is no argument. If you want a placeholder to support an optional argument, you'll need to set the placeholder
 
 An argument is required for placeholders than take one. I.e. The placeholder handler won't be called if there
 is no argument. If you want a placeholder to support an optional argument, you'll need to set the placeholder
Unnamed repository; edit this file 'description' to name the repository.
This page took 0.030527 seconds and 4 git commands to generate.