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   1625 use warnings;
  2         4  
  2         87  
5 2     2   10 use strict;
  2         4  
  2         145  
6              
7 2     2   12 use File::KDBX::Loader::KDB;
  2         3  
  2         77  
8              
9 2     2   10 use parent 'Tie::Array';
  2         4  
  2         29  
10              
11             our $VERSION = '0.901'; # VERSION
12              
13             sub TIEARRAY {
14 173     173   309 my $class = shift;
15 173         387 my $self = bless [@_], $class;
16 173 50       393 splice(@$self, 1, 0, 'entries') if @$self == 2;
17 173         387 return $self;
18             }
19              
20             sub FETCH {
21 48     48   398 my ($self, $index) = @_;
22 48         86 my ($thing, $method, $k) = @$self;
23 48 50       114 my $entry = $thing->$method->[$index] or return;
24 48         691 return $k->_tie({}, 'Entry', $k->kdbx->_wrap_entry($entry));
25             }
26              
27             sub FETCHSIZE {
28 217     217   385 my ($self) = @_;
29 217         349 my ($thing, $method) = @$self;
30 217         288 return scalar @{$thing->$method};
  217         530  
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__