File Coverage

blib/lib/File/KDBX/Iterator.pm
Criterion Covered Total %
statement 133 138 96.3
branch 35 42 83.3
condition 22 37 59.4
subroutine 31 32 96.8
pod 16 17 94.1
total 237 266 89.1


line stmt bran cond sub pod time code
1             package File::KDBX::Iterator;
2             # ABSTRACT: KDBX database iterator
3              
4 10     10   94552 use warnings;
  10         19  
  10         279  
5 10     10   47 use strict;
  10         16  
  10         186  
6              
7 10     10   42 use File::KDBX::Error;
  10         65  
  10         504  
8 10     10   81 use File::KDBX::Util qw(:class :load :search);
  10         22  
  10         1339  
9 10     10   4123 use Iterator::Simple;
  10         24935  
  10         372  
10 10     10   3887 use Module::Loaded;
  10         5454  
  10         512  
11 10     10   62 use Ref::Util qw(is_arrayref is_coderef is_ref is_scalarref);
  10         25  
  10         425  
12 10     10   61 use namespace::clean;
  10         19  
  10         65  
13              
14 10     10   3684 BEGIN { mark_as_loaded('Iterator::Simple::Iterator') }
15             extends 'Iterator::Simple::Iterator';
16              
17             our $VERSION = '0.905'; # VERSION
18              
19              
20             sub new {
21 818     818 1 2672 my $class = shift;
22 818 100   20   1480 my $code = is_coderef($_[0]) ? shift : sub { undef };
  20         48  
23              
24 818 50 33     1798 my $items = @_ == 1 && is_arrayref($_[0]) ? $_[0] : \@_;
25             return $class->SUPER::new(sub {
26 1983 100   1983   3300 if (@_) { # put back
27 25 100 100     112 if (@_ == 1 && is_arrayref($_[0])) {
28 22         46 $items = $_[0];
29             }
30             else {
31 3         8 unshift @$items, @_;
32             }
33 25         35 return;
34             }
35             else {
36 1958         2269 my $next = shift @$items;
37 1958 100       2862 return $next if defined $next;
38 1859         2760 return $code->();
39             }
40 818         3026 });
41             }
42              
43              
44             sub next {
45 1167     1167 1 3614 my $self = shift;
46 1167 100       2065 my $code = shift or return $self->();
47              
48 329         797 $code = query_any($code, @_);
49              
50 329         812 while (defined (local $_ = $self->())) {
51 331 100       685 return $_ if $code->($_);
52             }
53 311         754 return;
54             }
55              
56              
57             sub peek {
58 2     2 1 5 my $self = shift;
59              
60 2         34 my $next = $self->();
61 2 100       10 $self->($next) if defined $next;
62 2         9 return $next;
63             }
64              
65              
66             sub unget {
67 1     1 1 3 my $self = shift; # Must shift in a statement before calling.
68 1         3 $self->(@_);
69             }
70              
71              
72             sub each {
73 27     27 1 197 my $self = shift;
74 27 100       55 my $cb = shift or return @{$self->to_array};
  4         63  
75              
76 23 50       46 if (is_coderef($cb)) {
    0          
77 23         31 my $count = 0;
78 23         39 $cb->($_, $count++, @_) while defined (local $_ = $self->());
79             }
80             elsif (!is_ref($cb)) {
81 0         0 $_->$cb(@_) while defined (local $_ = $self->());
82             }
83 23         240 return $self;
84             }
85              
86              
87 2     2 1 16 sub where { shift->grep(@_) }
88              
89             sub grep {
90 30     30 1 198 my $self = shift;
91 30         90 my $code = query_any(@_);
92              
93             ref($self)->new(sub {
94 35     35   68 while (defined (local $_ = $self->())) {
95 54 100       116 return $_ if $code->($_);
96             }
97 7         22 return;
98 30         123 });
99             }
100              
101              
102             sub map {
103 21     21 1 162 my $self = shift;
104 21         32 my $code = shift;
105              
106             ref($self)->new(sub {
107 112     112   170 local $_ = $self->();
108 112 100       207 return if !defined $_;
109 93         170 return $code->();
110 21         84 });
111             }
112              
113              
114             sub order_by {
115 5     5 1 10 my $self = shift;
116 5         9 my $field = shift;
117 5         17 my %args = @_;
118              
119 5   66     36 my $ascending = delete $args{ascending} // !delete $args{descending} // 1;
      50        
120 5   66     19 my $case = delete $args{case} // !delete $args{no_case} // 1;
      50        
121 5   66     36 my $collate = (delete $args{collate} // !delete $args{no_collate} // 1)
122             && try_load_optional('Unicode::Collate');
123              
124 5 100 66     17 if ($collate && !$case) {
125 1         3 $case = 1;
126             # use a proper Unicode::Collate level to ignore case
127 1   50     5 $args{level} //= 2;
128             }
129 5   50     32 $args{upper_before_lower} //= 1;
130              
131 5         8 my $value = $field;
132 5 100 50 15   27 $value = $case ? sub { $_[0]->$field // '' } : sub { uc($_[0]->$field) // '' } if !is_coderef($value);
  15 50 50     46  
  10         29  
133 5         11 my @all = CORE::map { [$_, $value->($_)] } @{$self->to_array};
  25         63  
  5         18  
134              
135 5 100       16 if ($collate) {
136 1         7 my $c = Unicode::Collate->new(%args);
137 1 50       41687 if ($ascending) {
138 1         8 @all = CORE::map { $_->[0] } CORE::sort { $c->cmp($a->[1], $b->[1]) } @all;
  5         755  
  9         1941  
139             } else {
140 0         0 @all = CORE::map { $_->[0] } CORE::sort { $c->cmp($b->[1], $a->[1]) } @all;
  0         0  
  0         0  
141             }
142             } else {
143 4 100       10 if ($ascending) {
144 2         13 @all = CORE::map { $_->[0] } CORE::sort { $a->[1] cmp $b->[1] } @all;
  10         16  
  16         27  
145             } else {
146 2         14 @all = CORE::map { $_->[0] } CORE::sort { $b->[1] cmp $a->[1] } @all;
  10         17  
  16         36  
147             }
148             }
149              
150 5         19 $self->(\@all);
151 5         51 return $self;
152             }
153              
154              
155 5     5 1 99 sub sort_by { shift->order_by(@_) }
156              
157              
158             sub norder_by {
159 2     2 1 4 my $self = shift;
160 2         4 my $field = shift;
161 2         5 my %args = @_;
162              
163 2   66     13 my $ascending = $args{ascending} // !$args{descending} // 1;
      50        
164              
165 2         4 my $value = $field;
166 2 50 50 10   11 $value = sub { $_[0]->$field // 0 } if !is_coderef($value);
  10         22  
167 2         4 my @all = CORE::map { [$_, $value->($_)] } @{$self->to_array};
  10         16  
  2         7  
168              
169 2 100       6 if ($ascending) {
170 1         8 @all = CORE::map { $_->[0] } CORE::sort { $a->[1] <=> $b->[1] } @all;
  5         10  
  9         13  
171             } else {
172 1         7 @all = CORE::map { $_->[0] } CORE::sort { $b->[1] <=> $a->[1] } @all;
  5         8  
  7         12  
173             }
174              
175 2         6 $self->(\@all);
176 2         17 return $self;
177             }
178              
179              
180 2     2 1 45 sub nsort_by { shift->norder_by(@_) }
181              
182              
183 1     1 1 10 sub limit { shift->head(@_) }
184              
185              
186             sub to_array {
187 45     45 1 163 my $self = shift;
188              
189 45         60 my @all;
190 45         90 push @all, $_ while defined (local $_ = $self->());
191 45         223 return \@all;
192             }
193              
194              
195             sub count {
196 14     14 1 48 my $self = shift;
197              
198 14         31 my $items = $self->to_array;
199 14         31 $self->($items);
200 14         64 return scalar @$items;
201             }
202              
203              
204 10     10 1 69 sub size { shift->count }
205              
206             ##############################################################################
207              
208 0     0 0   sub TO_JSON { $_[0]->to_array }
209              
210             1;
211              
212             __END__