view release on metacpan or  search on metacpan

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

package File::KDBX::Dumper;
# ABSTRACT: Write KDBX files

use warnings;
use strict;

use Crypt::Digest qw(digest_data);
use File::KDBX::Constants qw(:magic :header :version :random_stream);
use File::KDBX::Error;
use File::KDBX::Util qw(:class);
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 $version = $self->kdbx->version;

    my $subclass;

    if (defined $format) {
        $subclass = $format;
    }
    elsif (!defined $version) {
        $subclass = 'XML';
    }
    elsif ($self->kdbx->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',
        );
        if ($major == KDBX_VERSION_2_0) {
            alert sprintf("Upgrading KDBX version %x to version %x\n", $version, KDBX_VERSION_3_1);
            $self->kdbx->version(KDBX_VERSION_3_1);
        }
        $subclass = $subclasses{$major}
            or throw sprintf('Unsupported KDBX file version: %x', $version), version => $version;
    }
    else {
        throw sprintf('Unknown file version: %s', $version), version => $version;
    }

    load "File::KDBX::Dumper::$subclass";
    bless $self, "File::KDBX::Dumper::$subclass";
}