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


line stmt bran cond sub pod time code
1             package File::KDBX::Key::ChallengeResponse;
2             # ABSTRACT: A challenge-response key
3              
4 2     2   1030 use warnings;
  2         4  
  2         63  
5 2     2   8 use strict;
  2         4  
  2         35  
6              
7 2     2   10 use File::KDBX::Error;
  2         3  
  2         86  
8 2     2   13 use File::KDBX::Util qw(:class);
  2         3  
  2         197  
9 2     2   10 use namespace::clean;
  2         4  
  2         11  
10              
11             extends 'File::KDBX::Key';
12              
13             our $VERSION = '0.906'; # VERSION
14              
15             sub init {
16 18     18 1 41 my $self = shift;
17 18 50       50 my $primitive = shift or throw 'Missing key primitive';
18              
19 18         37 $self->{responder} = $primitive;
20              
21 18         48 return $self->hide;
22             }
23              
24              
25             sub raw_key {
26 0     0 1 0 my $self = shift;
27 0 0       0 if (@_) {
28 0   0     0 my $challenge = shift // '';
29             # Don't challenge if we already have the response.
30 0 0 0     0 return $self->SUPER::raw_key if $challenge eq ($self->{challenge} // '');
31 0         0 $self->_set_raw_key($self->challenge($challenge, @_));
32 0         0 $self->{challenge} = $challenge;
33             }
34 0         0 $self->SUPER::raw_key;
35             }
36              
37              
38             sub challenge {
39 18     18 1 27 my $self = shift;
40              
41 18 50       44 my $responder = $self->{responder} or throw 'Cannot issue challenge without a responder';
42 18         49 return $responder->(@_);
43             }
44              
45             1;
46              
47             __END__