use File::KDBX::Error;
use File::KDBX::Safe;
use File::KDBX::Util qw(:empty erase generate_uuid search 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 Scalar::Util qw(blessed refaddr);
+use Scalar::Util qw(blessed);
use Time::Piece;
use boolean;
use namespace::clean;
our $VERSION = '999.999'; # VERSION
our $WARNINGS = 1;
-my %SAFE;
-my %KEYS;
+fieldhashes \my (%SAFE, %KEYS);
=method new
return $self;
}
-sub DESTROY { !in_global_destruction and $_[0]->reset }
+sub DESTROY { local ($., $@, $!, $^E, $?); !in_global_destruction and $_[0]->reset }
=method init
erase $self->inner_headers->{+INNER_HEADER_INNER_RANDOM_STREAM_KEY};
erase $self->{raw};
%$self = ();
- delete $SAFE{refaddr($self)};
$self->_remove_safe;
return $self;
}
my $copy = {%$self};
- return '', $copy, $KEYS{refaddr($self)} // (), $SAFE{refaddr($self)} // ();
+ return '', $copy, $KEYS{$self} // (), $SAFE{$self} // ();
}
sub STORABLE_thaw {
my $safe = shift;
@$self{keys %$clone} = values %$clone;
- $KEYS{refaddr($self)} = $key;
- $SAFE{refaddr($self)} = $safe;
+ $KEYS{$self} = $key;
+ $SAFE{$self} = $safe;
for my $object (@{$self->all_groups}, @{$self->all_entries(history => 1)}) {
$object->kdbx($self);
sub _safe {
my $self = shift;
- $SAFE{refaddr($self)} = shift if @_;
- $SAFE{refaddr($self)};
+ $SAFE{$self} = shift if @_;
+ $SAFE{$self};
}
-sub _remove_safe { delete $SAFE{refaddr($_[0])} }
+sub _remove_safe { delete $SAFE{$_[0]} }
sub lock {
my $self = shift;
sub key {
my $self = shift;
- $KEYS{refaddr($self)} = File::KDBX::Key->new(@_) if @_;
- $KEYS{refaddr($self)};
+ $KEYS{$self} = File::KDBX::Key->new(@_) if @_;
+ $KEYS{$self};
}
=method composite_key
use File::KDBX::Constants qw(:history :icon);
use File::KDBX::Error;
use File::KDBX::Util qw(:function :uri generate_uuid load_optional);
+use Hash::Util::FieldHash;
use List::Util qw(sum0);
-use Ref::Util qw(is_plain_hashref is_ref);
-use Scalar::Util qw(looks_like_number refaddr);
+use Ref::Util qw(is_plain_hashref);
+use Scalar::Util qw(looks_like_number);
use Storable qw(dclone);
use Time::Piece;
use boolean;
for my $entry (@{$self->history}) {
$entry->{uuid} = $uuid;
}
- # if (defined $old_uuid and my $kdbx = $KDBX{refaddr($self)}) {
+ # if (defined $old_uuid and my $kdbx = $KDBX{$self}) {
# $kdbx->_update_entry_uuid($old_uuid, $uuid, $self);
# }
}
}
return if !defined $File::KDBX::PLACEHOLDERS{$placeholder_key};
- my $local_key = join('/', refaddr($self), $placeholder_key);
+ my $local_key = join('/', Hash::Util::FieldHash::id($self), $placeholder_key);
local $PLACEHOLDERS{$local_key} = my $handler = $PLACEHOLDERS{$local_key} // do {
my $handler = $File::KDBX::PLACEHOLDERS{$placeholder_key} or next;
memoize recurse_limit($handler, $PLACEHOLDER_MAX_DEPTH, sub {
use File::KDBX::Constants qw(:icon);
use File::KDBX::Error;
use File::KDBX::Util qw(generate_uuid);
+use Hash::Util::FieldHash;
use List::Util qw(sum0);
use Ref::Util qw(is_ref);
-use Scalar::Util qw(blessed refaddr);
+use Scalar::Util qw(blessed);
use Time::Piece;
use boolean;
use namespace::clean;
my %args = @_ % 2 == 1 ? (uuid => shift, @_) : @_;
my $old_uuid = $self->{uuid};
my $uuid = $self->{uuid} = delete $args{uuid} // generate_uuid;
- # if (defined $old_uuid and my $kdbx = $KDBX{refaddr($self)}) {
+ # if (defined $old_uuid and my $kdbx = $KDBX{$self}) {
# $kdbx->_update_group_uuid($old_uuid, $uuid, $self);
# }
}
sub is_root {
my $self = shift;
my $kdbx = eval { $self->kdbx } or return;
- return refaddr($kdbx->root) == refaddr($self);
+ return Hash::Util::FieldHash::id($kdbx->root) == Hash::Util::FieldHash::id($self);
}
=method path
sub DESTROY {
return if in_global_destruction;
+ local ($., $@, $!, $^E, $?);
my $self = shift;
$self->close;
}
use File::KDBX::Error;
use File::KDBX::Safe;
use File::KDBX::Util qw(erase);
+use Hash::Util::FieldHash qw(fieldhashes);
use Module::Load;
use Ref::Util qw(is_arrayref is_coderef is_hashref is_ref is_scalarref);
-use Scalar::Util qw(blessed openhandle refaddr);
+use Scalar::Util qw(blessed openhandle);
use namespace::clean;
our $VERSION = '999.999'; # VERSION
-my %SAFE;
+fieldhashes \my %SAFE;
=method new
return $self;
}
-sub DESTROY { !in_global_destruction and do { $_[0]->_clear_raw_key; erase \$_[0]->{primitive} } }
+sub DESTROY {
+ local ($., $@, $!, $^E, $?);
+ !in_global_destruction and do { $_[0]->_clear_raw_key; eval { erase \$_[0]->{primitive} } }
+}
=method init
=cut
-sub is_hidden { !!$SAFE{refaddr($_[0])} }
+sub is_hidden { !!$SAFE{$_[0]} }
-sub _safe { $SAFE{refaddr($_[0])} }
-sub _new_safe { $SAFE{refaddr($_[0])} = File::KDBX::Safe->new }
+sub _safe { $SAFE{$_[0]} }
+sub _new_safe { $SAFE{$_[0]} = File::KDBX::Safe->new }
1;
__END__
use Devel::GlobalDestruction;
use File::KDBX::Error;
use File::KDBX::Util qw(:uuid);
+use Hash::Util::FieldHash qw(fieldhashes);
use Ref::Util qw(is_arrayref is_plain_hashref is_ref);
-use Scalar::Util qw(blessed refaddr weaken);
+use Scalar::Util qw(blessed weaken);
use namespace::clean;
our $VERSION = '999.999'; # VERSION
-my %KDBX;
-my %PARENT;
+fieldhashes \my (%KDBX, %PARENT);
=method new
return $self;
}
-sub DESTROY {
- return if in_global_destruction;
- my $self = shift;
- delete $KDBX{refaddr($self)};
- delete $PARENT{refaddr($self)};
-}
-
=method wrap
$object = File::KDBX::Object->wrap($object);
delete $copy->{groups} if !$CLONE{groups};
delete $copy->{history} if !$CLONE{history};
- return refaddr($self) || '', $copy;
+ return ($cloning ? Hash::Util::FieldHash::id($self) : ''), $copy;
}
sub STORABLE_thaw {
my $self = shift;
my $cloning = shift;
my $addr = shift;
- my $clone = shift;
+ my $copy = shift;
- @$self{keys %$clone} = values %$clone;
+ @$self{keys %$copy} = values %$copy;
- my $kdbx = $KDBX{$addr};
- $self->kdbx($kdbx) if $kdbx;
+ if ($cloning) {
+ my $kdbx = $KDBX{$addr};
+ $self->kdbx($kdbx) if $kdbx;
+ }
if (defined $self->{uuid}) {
if (($CLONE{reference_password} || $CLONE{reference_username}) && $self->can('strings')) {
local $CLONE{history} = 1;
local $CLONE{reference_password} = 0;
local $CLONE{reference_username} = 0;
- bless Storable::dclone({%$clone}), 'File::KDBX::Entry';
+ bless Storable::dclone({%$copy}), 'File::KDBX::Entry';
};
my $txn = $self->begin_work($clone_obj);
if ($CLONE{reference_password}) {
sub kdbx {
my $self = shift;
$self = $self->new if !ref $self;
- my $addr = refaddr($self);
if (@_) {
- $KDBX{$addr} = shift;
- if (defined $KDBX{$addr}) {
- weaken $KDBX{$addr};
+ if (my $kdbx = shift) {
+ $KDBX{$self} = $kdbx;
+ weaken $KDBX{$self};
}
else {
- delete $KDBX{$addr};
+ delete $KDBX{$self};
}
}
- $KDBX{$addr} or throw 'Object is disassociated from a KDBX database', object => $self;
+ $KDBX{$self} or throw 'Object is disassociated from a KDBX database', object => $self;
}
=method id
sub group {
my $self = shift;
- my $addr = refaddr($self);
- if (my $group = $PARENT{$addr}) {
+ my $addr = Hash::Util::FieldHash::id($self);
+ if (my $group = $PARENT{$self}) {
my $method = $self->_parent_container;
for my $object (@{$group->$method}) {
- return $group if $addr == refaddr($object);
+ return $group if $addr == Hash::Util::FieldHash::id($object);
}
- delete $PARENT{$addr};
+ delete $PARENT{$self};
}
# always get lineage from root to leaf because the other way requires parent, so it would be recursive
my $lineage = $self->kdbx->_trace_lineage($self) or return;
my $group = pop @$lineage or return;
- $PARENT{$addr} = $group; weaken $PARENT{$addr};
+ $PARENT{$self} = $group; weaken $PARENT{$self};
return $group;
}
sub _set_group {
my $self = shift;
if (my $parent = shift) {
- $PARENT{refaddr($self)} = $parent;
+ $PARENT{$self} = $parent;
+ weaken $PARENT{$self};
}
else {
- delete $PARENT{refaddr($self)};
+ delete $PARENT{$self};
}
return $self;
}
my $self = shift;
my $base = shift;
- my $base_addr = $base ? refaddr($base) : 0;
+ my $base_addr = $base ? Hash::Util::FieldHash::id($base) : 0;
# try leaf to root
my @path;
my $o = $self;
while ($o = $o->parent) {
unshift @path, $o;
- last if $base_addr == refaddr($o);
+ last if $base_addr == Hash::Util::FieldHash::id($o);
}
- return \@path if @path && ($base_addr == refaddr($path[0]) || $path[0]->is_root);
+ return \@path if @path && ($base_addr == Hash::Util::FieldHash::id($path[0]) || $path[0]->is_root);
# try root to leaf
return $self->kdbx->_trace_lineage($self, $base);
my $self = shift;
my $group = shift;
require File::KDBX::Group;
- return File::KDBX::Group->wrap($group, $KDBX{refaddr($self)});
+ return File::KDBX::Group->wrap($group, $KDBX{$self});
}
sub _wrap_entry {
my $self = shift;
my $entry = shift;
require File::KDBX::Entry;
- return File::KDBX::Entry->wrap($entry, $KDBX{refaddr($self)});
+ return File::KDBX::Entry->wrap($entry, $KDBX{$self});
}
sub TO_JSON { +{%{$_[0]}} }
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 is_ref);
-use Scalar::Util qw(blessed isdual looks_like_number readonly refaddr);
+use Ref::Util qw(is_arrayref is_coderef is_hashref is_ref is_refref is_scalarref);
+use Scalar::Util qw(blessed readonly);
use namespace::clean -except => 'import';
our $VERSION = '999.999'; # VERSION