view release on metacpan or  search on metacpan

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

package File::KDBX::Loader;
# ABSTRACT: Load KDBX files

use warnings;
use strict;

use File::KDBX::Constants qw(:magic :header :version);
use File::KDBX::Error;
use File::KDBX::Util qw(:class :io);
use File::KDBX;
use IO::Handle;
use Module::Load ();
use Ref::Util qw(is_ref is_scalarref);
use Scalar::Util qw(looks_like_number openhandle);
use namespace::clean;

our $VERSION = '0.906'; # VERSION


sub new {
    my $class = shift;
    my $self = bless {}, $class;
    $self->init(@_);
}


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

    @$self{keys %args} = values %args;

    return $self;
}

sub _rebless {
    my $self    = shift;
    my $format  = shift // $self->format;

    my $sig2    = $self->kdbx->sig2;
    my $version = $self->kdbx->version;

    my $subclass;

    if (defined $format) {
        $subclass = $format;
    }
    elsif (defined $sig2 && $sig2 == KDBX_SIG2_1) {
        $subclass = 'KDB';
    }
    elsif (looks_like_number($version)) {
        my $major = $version & KDBX_VERSION_MAJOR_MASK;
        my %subclasses = (
            KDBX_VERSION_2_0() => 'V3',
            KDBX_VERSION_3_0() => 'V3',
            KDBX_VERSION_4_0() => 'V4',
        );
        $subclass = $subclasses{$major}
            or throw sprintf('Unsupported KDBX file version: %x', $version), version => $version;
    }
    else {
        throw sprintf('Unknown file version: %s', $version), version => $version;
    }

    Module::Load::load "File::KDBX::Loader::$subclass";
    bless $self, "File::KDBX::Loader::$subclass";
}


sub reset {
    my $self = shift;
    %$self = ();
    return $self;