view release on metacpan or  search on metacpan

lib/File/KDBX/Object.pm  view on Meta::CPAN

use warnings;
use strict;

use Devel::GlobalDestruction;
use File::KDBX::Constants qw(:bool);
use File::KDBX::Error;
use File::KDBX::Util qw(:uuid);
use Hash::Util::FieldHash qw(fieldhashes);
use List::Util qw(any first);
use Ref::Util qw(is_arrayref is_plain_arrayref is_plain_hashref is_ref);
use Scalar::Util qw(blessed weaken);
use namespace::clean;

our $VERSION = '0.906'; # VERSION

fieldhashes \my (%KDBX, %PARENT, %TXNS, %REFS, %SIGNALS);


sub new {
    my $class = shift;

lib/File/KDBX/Object.pm  view on Meta::CPAN

    $self->icon_id($self->{icon_id}) if defined $self->{icon_id};
}


sub kdbx {
    my $self = shift;
    $self = $self->new if !ref $self;
    if (@_) {
        if (my $kdbx = shift) {
            $KDBX{$self} = $kdbx;
            weaken $KDBX{$self};
        }
        else {
            delete $KDBX{$self};
        }
    }
    $KDBX{$self} or throw 'Object is disconnected', object => $self;
}


sub is_connected {

lib/File/KDBX/Object.pm  view on Meta::CPAN

    my $id   = Hash::Util::FieldHash::id($self);
    if (my $group = $PARENT{$self}) {
        my $method = $self->_parent_container;
        return $group if first { $id == Hash::Util::FieldHash::id($_) } @{$group->$method};
        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{$self} = $group; weaken $PARENT{$self};
    return $group;
}

sub _set_group {
    my $self = shift;
    if (my $parent = shift) {
        $PARENT{$self} = $parent;
        weaken $PARENT{$self};
    }
    else {
        delete $PARENT{$self};
    }
    return $self;
}

### Name of the parent attribute expected to contain the object
sub _parent_container { die 'Not implemented' }