X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=lib%2FFile%2FKDBX%2FEntry.pm;h=fc744fd8c3c00c3c9e47deadc9f8a7d71db05a17;hb=37b09e0f2832514b33de4499a83f22d5ffe7c0a3;hp=c124b94203adf169a84aeec91374b2a6ad4e6324;hpb=81604125cc023132207802b4ae0ab4cea12c17fd;p=chaz%2Fp5-File-KDBX diff --git a/lib/File/KDBX/Entry.pm b/lib/File/KDBX/Entry.pm index c124b94..fc744fd 100644 --- 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 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 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(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 parent 'File::KDBX::Object'; +extends 'File::KDBX::Object'; our $VERSION = '999.999'; # VERSION @@ -132,7 +132,7 @@ Boolean value indicating whether or not an entry is expired. =attr usage_count -The number of times an entry has been used, which typically means how many times the C string has +The number of times an entry has been used, which typically means how many times the B string has been accessed. =attr location_changed @@ -141,23 +141,23 @@ Date and time when the entry was last moved to a different group. =attr notes -Alias for the C string value. +Alias for the B string value. =attr password -Alias for the C string value. +Alias for the B string value. =attr title -Alias for the C string value. +Alias for the B<Title> string value. =attr url -Alias for the C<URL> string value. +Alias for the B<URL> string value. =attr username -Aliases for the C<UserName> string value. +Aliases for the B<UserName> string value. =cut @@ -170,38 +170,37 @@ sub 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}; } -my @ATTRS = qw(uuid custom_data history); +my @ATTRS = qw(uuid custom_data history icon_id); 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 = ( - 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', @@ -211,22 +210,13 @@ my %ATTRS_STRINGS = ( notes => 'Notes', ); +has icon_id => ICON_PASSWORD, coerce => sub { icon($_[0]) }; + while (my ($attr, $default) = each %ATTRS) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = sub { - my $self = shift; - $self->{$attr} = shift if @_; - $self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default; - }; + has $attr => @$default; } while (my ($attr, $default) = each %ATTRS_TIMES) { - no strict 'refs'; ## no critic (ProhibitNoStrict) - *{$attr} = sub { - my $self = shift; - $self->{times} //= {}; - $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) @@ -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($_) } @_; } +=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; - require File::KDBX::Transaction; - return File::KDBX::Transaction->new($self, @_); + my $type = shift; + return $self->SUPER::_signal("entry.$type", @_); } 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(@_) } @@ -831,11 +879,11 @@ called "files" or "attachments"). Every string and binary has a key or name. The 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. @@ -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 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 -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 @@ -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<{ENV:} and C<%ENV%> - Environment variables +* ☑ C<{ENV:}> and C<%ENV%> - Environment variables * ☒ 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 -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