File Coverage

blib/lib/File/KeePass/KDBX/Tie/GroupList.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::GroupList;
2             # ABSTRACT: Database group list
3              
4 2     2   1190 use warnings;
  2         5  
  2         65  
5 2     2   9 use strict;
  2         4  
  2         50  
6              
7 2     2   10 use File::KDBX::Loader::KDB;
  2         4  
  2         53  
8              
9 2     2   8 use parent 'Tie::Array';
  2         4  
  2         12  
10              
11             our $VERSION = '0.901'; # VERSION
12              
13             sub TIEARRAY {
14 293     293   533 my $class = shift;
15 293         658 my $self = bless [@_], $class;
16 293 50       1025 splice(@$self, 1, 0, '_kpx_groups') if @$self == 2;
17 293         738 return $self;
18             }
19              
20             sub FETCH {
21 240     240   515 my ($self, $index) = @_;
22 240         2770 my ($thing, $method, $k) = @$self;
23 240 50       587 my $group = $thing->$method->[$index] or return;
24 240         55905 return $k->_tie({}, 'Group', $k->kdbx->_wrap_group($group));
25             }
26              
27             sub FETCHSIZE {
28 616     616   1182 my ($self) = @_;
29 616         1103 my ($thing, $method) = @$self;
30 616         737 return scalar @{$thing->$method};
  616         1651  
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 $group_info = File::KDBX::Loader::KDB::_convert_keepass_to_kdbx_group($value);
38 0           %$value = ();
39 0           return $k->_tie($value, 'Group', $thing->$method->[$index] = $k->kdbx->_wrap_group($group_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__