File Coverage

blib/lib/File/KeePass/KDBX/Tie/EntryList.pm
Criterion Covered Total %
statement 24 40 60.0
branch 2 6 33.3
condition n/a
subroutine 7 11 63.6
pod n/a
total 33 57 57.8


line stmt bran cond sub pod time code
1             package File::KeePass::KDBX::Tie::EntryList;
2             # ABSTRACT: Database entry list
3              
4 2     2   1015 use warnings;
  2         4  
  2         66  
5 2     2   11 use strict;
  2         3  
  2         34  
6              
7 2     2   10 use File::KDBX::Loader::KDB;
  2         2  
  2         43  
8              
9 2     2   17 use parent 'Tie::Array';
  2         4  
  2         25  
10              
11             our $VERSION = '0.902'; # VERSION
12              
13             sub TIEARRAY {
14 171     171   295 my $class = shift;
15 171         363 my $self = bless [@_], $class;
16 171 50       338 splice(@$self, 1, 0, 'entries') if @$self == 2;
17 171         385 return $self;
18             }
19              
20             sub FETCH {
21 48     48   377 my ($self, $index) = @_;
22 48         95 my ($thing, $method, $k) = @$self;
23 48 50       98 my $entry = $thing->$method->[$index] or return;
24 48         616 return $k->_tie({}, 'Entry', $k->kdbx->_wrap_entry($entry));
25             }
26              
27             sub FETCHSIZE {
28 217     217   405 my ($self) = @_;
29 217         354 my ($thing, $method) = @$self;
30 217         255 return scalar @{$thing->$method};
  217         535  
31             }
32              
33             sub STORE {
34 0     0     my ($self, $index, $value) = @_;
35 0 0         return if !$value;
36 0           my ($thing, $method, $k) = @$self;
37 0           my $entry_info = File::KDBX::Loader::KDB::_convert_keepass_to_kdbx_entry($value);
38 0           %$value = ();
39 0           return $k->_tie($value, 'Entry', $thing->$method->[$index] = $k->kdbx->_wrap_entry($entry_info));
40             }
41              
42             sub STORESIZE {
43 0     0     my ($self, $count) = @_;
44 0           my ($thing, $method) = @$self;
45 0           splice @{$thing->$method}, $count;
  0            
46             }
47              
48             sub EXISTS {
49 0     0     my ($self, $index) = @_;
50 0           my ($thing, $method) = @$self;
51 0           return exists $thing->$method->[$index];
52             }
53              
54             sub DELETE {
55 0     0     my ($self, $index) = @_;
56 0           my ($thing, $method) = @$self;
57 0           delete $thing->$method->[$index];
58             }
59              
60             1;
61              
62             __END__