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   93817 use warnings;
  10         17  
  10         278  
5 10     10   43 use strict;
  10         17  
  10         176  
6              
7 10     10   43 use File::KDBX::Error;
  10         52  
  10         419  
8 10     10   57 use File::KDBX::Util qw(:class :load :search);
  10         25  
  10         1360  
9 10     10   4082 use Iterator::Simple;
  10         26170  
  10         398  
10 10     10   4126 use Module::Loaded;
  10         5415  
  10         508  
11 10     10   59 use Ref::Util qw(is_arrayref is_coderef is_ref is_scalarref);
  10         21  
  10         425  
12 10     10   48 use namespace::clean;
  10         20  
  10         61  
13              
14 10     10   3453 BEGIN { mark_as_loaded('Iterator::Simple::Iterator') }
15             extends 'Iterator::Simple::Iterator';
16              
17             our $VERSION = '0.906'; # VERSION
18              
19              
20             sub new {
21 835     835 1 2746 my $class = shift;
22 835 100   20   1493 my $code = is_coderef($_[0]) ? shift : sub { undef };
  20         45  
23              
24 835 50 33     1866 my $items = @_ == 1 && is_arrayref($_[0]) ? $_[0] : \@_;
25             return $class->SUPER::new(sub {
26 2013 100   2013   3090 if (@_) { # put back
27 25 100 100     107 if (@_ == 1 && is_arrayref($_[0])) {
28 22         40 $items = $_[0];
29             }
30             else {
31 3         5 unshift @$items, @_;
32             }
33 25         40 return;
34             }
35             else {
36 1988         2467 my $next = shift @$items;
37 1988 100       2949 return $next if defined $next;
38 1889         2856 return $code->();
39             }
40 835         3220 });
41             }
42              
43              
44             sub next {
45 1189     1189 1 3804 my $self = shift;
46 1189 100       2095 my $code = shift or return $self->();
47              
48 337         823 $code = query_any($code, @_);
49              
50 337         884 while (defined (local $_ = $self->())) {
51 336 100       643 return $_ if $code->($_);
52             }
53 319         793 return;
54             }
55              
56              
57             sub peek {
58 2     2 1 4 my $self = shift;
59              
60 2         5 my $next = $self->();
61 2 100       8 $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 29     29 1 232 my $self = shift;
74 29 100       79 my $cb = shift or return @{$self->to_array};
  4         68  
75              
76 25 50       44 if (is_coderef($cb)) {
    0          
77 25         33 my $count = 0;
78 25         46 $cb->($_, $count++, @_) while defined (local $_ = $self->());
79             }
80             elsif (!is_ref($cb)) {
81 0         0 $_->$cb(@_) while defined (local $_ = $self->());
82             }
83 25         247 return $self;
84             }
85              
86              
87 2     2 1 20 sub where { shift->grep(@_) }
88              
89             sub grep {
90 30     30 1 188 my $self = shift;
91 30         76 my $code = query_any(@_);
92              
93             ref($self)->new(sub {
94 35     35   78 while (defined (local $_ = $self->())) {
95 54 100       110 return $_ if $code->($_);
96             }
97 7         21 return;
98 30         128 });
99             }
100              
101              
102             sub map {
103 21     21 1 137 my $self = shift;
104 21         28 my $code = shift;
105              
106             ref($self)->new(sub {
107 112     112   158 local $_ = $self->();
108 112 100       207 return if !defined $_;
109 93         168 return $code->();
110 21         78 });
111             }
112              
113              
114             sub order_by {
115 5     5 1 10 my $self = shift;
116 5         8 my $field = shift;
117 5         15 my %args = @_;
118              
119 5   66     23 my $ascending = delete $args{ascending} // !delete $args{descending} // 1;
      50        
120 5   66     21 my $case = delete $args{case} // !delete $args{no_case} // 1;
      50        
121 5   66     39 my $collate = (delete $args{collate} // !delete $args{no_collate} // 1)
122             && try_load_optional('Unicode::Collate');
123              
124 5 100 66     15 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     21 $args{upper_before_lower} //= 1;
130              
131 5         7 my $value = $field;
132 5 100 50 10   25 $value = $case ? sub { $_[0]->$field // '' } : sub { uc($_[0]->$field) // '' } if !is_coderef($value);
  15 50 50     40  
  10         27  
133 5         8 my @all = CORE::map { [$_, $value->($_)] } @{$self->to_array};
  25         44  
  5         15  
134              
135 5 100       13 if ($collate) {
136 1         8 my $c = Unicode::Collate->new(%args);
137 1 50       40763 if ($ascending) {
138 1         8 @all = CORE::map { $_->[0] } CORE::sort { $c->cmp($a->[1], $b->[1]) } @all;
  5         482  
  9         2012  
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       9 if ($ascending) {
144 2         10 @all = CORE::map { $_->[0] } CORE::sort { $a->[1] cmp $b->[1] } @all;
  10         27  
  16         25  
145             } else {
146 2         8 @all = CORE::map { $_->[0] } CORE::sort { $b->[1] cmp $a->[1] } @all;
  10         17  
  16         23  
147             }
148             }
149              
150 5         17 $self->(\@all);
151 5         47 return $self;
152             }
153              
154              
155 5     5 1 82 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         6 my %args = @_;
162              
163 2   66     11 my $ascending = $args{ascending} // !$args{descending} // 1;
      50        
164              
165 2         3 my $value = $field;
166 2 50 50 10   8 $value = sub { $_[0]->$field // 0 } if !is_coderef($value);
  10         20  
167 2         4 my @all = CORE::map { [$_, $value->($_)] } @{$self->to_array};
  10         17  
  2         5  
168              
169 2 100       7 if ($ascending) {
170 1         5 @all = CORE::map { $_->[0] } CORE::sort { $a->[1] <=> $b->[1] } @all;
  5         9  
  9         12  
171             } else {
172 1         4 @all = CORE::map { $_->[0] } CORE::sort { $b->[1] <=> $a->[1] } @all;
  5         7  
  7         12  
173             }
174              
175 2         6 $self->(\@all);
176 2         14 return $self;
177             }
178              
179              
180 2     2 1 38 sub nsort_by { shift->norder_by(@_) }
181              
182              
183 1     1 1 9 sub limit { shift->head(@_) }
184              
185              
186             sub to_array {
187 45     45 1 156 my $self = shift;
188              
189 45         56 my @all;
190 45         88 push @all, $_ while defined (local $_ = $self->());
191 45         214 return \@all;
192             }
193              
194              
195             sub count {
196 14     14 1 40 my $self = shift;
197              
198 14         35 my $items = $self->to_array;
199 14         44 $self->($items);
200 14         59 return scalar @$items;
201             }
202              
203              
204 10     10 1 70 sub size { shift->count }
205              
206             ##############################################################################
207              
208 0     0 0   sub TO_JSON { $_[0]->to_array }
209              
210             1;
211              
212             __END__