File Coverage

blib/lib/File/KDBX/Key/ChallengeResponse.pm

Criterion	Covered	Total	%
statement	22	29	75.8
branch	2	8	25.0
condition	0	4	0.0
subroutine	7	8	87.5
pod	3	3	100.0
total	34	52	65.3

package File::KDBX::Key::ChallengeResponse;
# ABSTRACT: A challenge-response key

use warnings;
use strict;

use File::KDBX::Error;
use File::KDBX::Util qw(:class);
use namespace::clean;

extends 'File::KDBX::Key';

our $VERSION = '0.904'; # VERSION

sub init {
    my $self = shift;
    my $primitive = shift or throw 'Missing key primitive';

    $self->{responder} = $primitive;

    return $self->hide;
}


sub raw_key {
    my $self = shift;
    if (@_) {
        my $challenge = shift // '';
        # Don't challenge if we already have the response.
        return $self->SUPER::raw_key if $challenge eq ($self->{challenge} // '');
        $self->_set_raw_key($self->challenge($challenge, @_));
        $self->{challenge} = $challenge;
    }
    $self->SUPER::raw_key;
}


sub challenge {
    my $self = shift;

    my $responder = $self->{responder} or throw 'Cannot issue challenge without a responder';
    return $responder->(@_);
}

1;

__END__