File Coverage

blib/lib/File/KeePass/KDBX/Tie/AssociationList.pm
Criterion Covered Total %
statement 19 35 54.2
branch 2 4 50.0
condition n/a
subroutine 6 10 60.0
pod n/a
total 27 49 55.1


line stmt bran cond sub pod time code
1             package File::KeePass::KDBX::Tie::AssociationList;
2             # ABSTRACT: Auto-type window association list
3              
4 2     2   1046 use warnings;
  2         4  
  2         63  
5 2     2   11 use strict;
  2         3  
  2         53  
6              
7 2     2   10 use parent 'Tie::Array';
  2         4  
  2         11  
8              
9             our $VERSION = '0.900'; # VERSION
10              
11             sub TIEARRAY {
12 7     7   18 my $class = shift;
13 7         28 return bless [@_], $class;
14             }
15              
16             sub FETCH {
17 20     20   3183 my ($self, $index) = @_;
18 20         39 my ($entry, $k) = @$self;
19 20 50       52 my $association = $entry->auto_type->{associations}[$index] or return;
20 20         196 return $k->_tie({}, 'Association', $association);
21             }
22              
23             sub FETCHSIZE {
24 15     15   7237 my ($self) = @_;
25 15         39 my ($entry) = @$self;
26 15 50       20 return scalar @{$entry->auto_type->{associations} || []};
  15         51  
27             }
28              
29             sub STORE {
30 0     0     my ($self, $index, $value) = @_;
31 0           my ($entry, $k) = @$self;
32 0           my %info = %$value;
33 0           %$value = ();
34             my $association = $entry->auto_type->{associations}[$index] = {
35             window => $info{window},
36             keystroke_sequence => $info{keys},
37 0           };
38 0           return $k->_tie($value, 'Association', $association);
39             }
40              
41             sub STORESIZE {
42 0     0     my ($self, $count) = @_;
43 0           my ($entry) = @$self;
44 0           splice @{$entry->auto_type->{associations}}, $count;
  0            
45             }
46              
47             sub EXISTS {
48 0     0     my ($self, $index) = @_;
49 0           my ($entry) = @$self;
50 0           return exists $entry->auto_type->{associations}[$index];
51             }
52              
53             sub DELETE {
54 0     0     my ($self, $index) = @_;
55 0           my ($entry) = @$self;
56 0           delete $entry->auto_type->{associations}[$index];
57             }
58              
59             1;
60              
61             __END__