Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/Iterator.pm

   1 package File::KDBX::Iterator;
   2 # PACKAGE: KDBX database iterator
   3
   4 use warnings;
   5 use strict;
   6
   7 use File::KDBX::Error;
   8 use File::KDBX::Util qw(:class :load :search);
   9 use Iterator::Simple;
  10 use Ref::Util qw(is_arrayref is_coderef is_scalarref);
  11 use namespace::clean;
  12
  13 extends 'Iterator::Simple::Iterator';
  14
  15 our $VERSION = '999.999'; # VERSION
  16
  17 =method new
  18
  19     \&iterator = File::KDBX::Iterator->new(\&iterator);
  20
  21 Blesses an iterator to augment it with buffering plus some useful utility methods.
  22
  23 =cut
  24
  25 sub new {
  26     my $class = shift;
  27     my $code  = is_coderef($_[0]) ? shift : sub { undef };
  28
  29     my $items = @_ == 1 && is_arrayref($_[0]) ? $_[0] : \@_;
  30     return $class->SUPER::new(sub {
  31         if (@_) {   # put back
  32             if (@_ == 1 && is_arrayref($_[0])) {
  33                 $items = $_[0];
  34             }
  35             else {
  36                 unshift @$items, @_;
  37             }
  38             return;
  39         }
  40         else {
  41             my $next = shift @$items;
  42             return $next if defined $next;
  43             return $code->();
  44         }
  45     });
  46 }
  47
  48 =method next
  49
  50     $item = $iterator->next;
  51     # OR equivalently
  52     $item = $iterator->();
  53
  54     $item = $iterator->next(\&query);
  55     $item = $iterator->next([\'simple expression', @fields]);
  56
  57 Get the next item or C<undef> if there are no more items. If a query is passed, get the next matching item,
  58 discarding any items before the matching item that do not match. Example:
  59
  60     my $item = $iterator->next(sub { $_->label =~ /Gym/ });
  61
  62 =cut
  63
  64 sub _create_query {
  65     my $self = shift;
  66     my $code = shift;
  67
  68     if (is_coderef($code) || overload::Method($code, '&{}')) {
  69         return $code;
  70     }
  71     elsif (is_scalarref($code)) {
  72         return simple_expression_query($$code, @_);
  73     }
  74     else {
  75         return query($code, @_);
  76     }
  77 }
  78
  79 sub next {
  80     my $self = shift;
  81     my $code = shift or return $self->();
  82
  83     $code = $self->_create_query($code, @_);
  84
  85     while (defined (local $_ = $self->())) {
  86         return $_ if $code->($_);
  87     }
  88     return;
  89 }
  90
  91 =method peek
  92
  93     $item = $iterator->peek;
  94
  95 Peek at the next item. Returns C<undef> if the iterator is empty. This allows you to access the next item
  96 without draining it from the iterator. The same item will be returned the next time L</next> is called.
  97
  98 =cut
  99
 100 sub peek {
 101     my $self = shift;
 102
 103     my $next = $self->();
 104     $self->($next) if defined $next;
 105     return $next;
 106 }
 107
 108 =method unget
 109
 110     $iterator->unget(\@items);
 111     $iterator->unget(...);
 112     # OR equivalently
 113     $iterator->(\@items);
 114     $iterator->(...);
 115
 116 Replace the buffer or unshift one or more items to the current buffer.
 117
 118 See L</Buffer>.
 119
 120 =cut
 121
 122 sub unget {
 123     my $self = shift;   # Must shift in a statement before calling.
 124     $self->(@_);
 125 }
 126
 127 =method each
 128
 129     @items = $iterator->each;
 130
 131     $iterator->each(sub($item, $num) { ... });
 132
 133 Get the rest of the items. There are two forms: Without arguments, C<each> returns a list of the rest of the
 134 items. Or pass a coderef to be called once per item, in order. The item is passed as the first argument to the
 135 given subroutine and is also available as C<$_>.
 136
 137 =cut
 138
 139 sub each {
 140     my $self = shift;
 141     my $cb = shift or return @{$self->to_array};
 142
 143     my $count = 0;
 144     $cb->($_, $count++) while defined (local $_ = $self->());
 145     return $self;
 146 }
 147
 148 =method limit
 149
 150     \&iterator = $iterator->limit($count);
 151
 152 Get a new iterator draining from an existing iterator but providing only a limited number of items.
 153
 154 =cut
 155
 156 sub limit { shift->head(@_) }
 157
 158 =method grep
 159
 160     \&iterator = $iterator->grep(\&query);
 161     \&iterator = $iterator->grep([\'simple expression', @fields]);
 162
 163 Get a new iterator draining from an existing iterator but providing only items that pass a test or are matched
 164 by a query.
 165
 166 =cut
 167
 168 sub grep {
 169     my $self = shift;
 170     my $code = shift;
 171
 172     $code = $self->_create_query($code, @_);
 173
 174     ref($self)->new(sub {
 175         while (defined (local $_ = $self->())) {
 176             return $_ if $code->($_);
 177         }
 178         return;
 179     });
 180 }
 181
 182 =method map
 183
 184     \&iterator = $iterator->map(\&code);
 185
 186 Get a new iterator draining from an existing iterator but providing modified items.
 187
 188 =cut
 189
 190 sub map {
 191     my $self = shift;
 192     my $code = shift;
 193
 194     ref($self)->new(sub {
 195         local $_ = $self->();
 196         return if !defined $_;
 197         return $code->();
 198     });
 199 }
 200
 201 =method filter
 202
 203     \&iterator = $iterator->filter(\&query);
 204     \&iterator = $iterator->filter([\'simple expression', @fields]);
 205
 206 See L<Iterator::Simple/"ifilter $iterable, sub{ CODE }">.
 207
 208 =cut
 209
 210 sub filter {
 211     my $self = shift;
 212     my $code = shift;
 213     return $self->SUPER::filter($self->_create_query($code, @_));
 214 }
 215
 216 =method sort_by
 217
 218 =method order_by
 219
 220     \&iterator = $iterator->sort_by($field, %options);
 221     \&iterator = $iterator->sort_by(\&get_value, %options);
 222
 223 Get a new iterator draining from an existing iterator but providing items sorted by an object field. Sorting
 224 is done using L<Unicode::Collate> (if available) or C<cmp> to sort alphanumerically. The C<\&get_value>
 225 subroutine is called once for each item and should return a string value. Options:
 226
 227 =for :list
 228 * C<ascending> - Order ascending if true, descending otherwise (default: true)
 229 * C<case> - If true, take case into account, otherwise ignore case (default: true)
 230 * C<collate> - If true, use B<Unicode::Collate> (if available), otherwise use perl built-ins (default: true)
 231 * Any B<Unicode::Collate> option is also supported.
 232
 233 C<sort_by> and C<order_by> are aliases.
 234
 235 B<NOTE:> This method drains the iterator completely but adds items back onto the buffer, so the iterator is
 236 still usable afterward. Nevertheless, you mustn't call this on an infinite iterator or it will run until
 237 available memory is depleted.
 238
 239 =cut
 240
 241 sub sort_by  { shift->order_by(@_)  }
 242 sub nsort_by { shift->norder_by(@_) }
 243
 244 sub order_by {
 245     my $self    = shift;
 246     my $field   = shift;
 247     my %args    = @_;
 248
 249     my $ascending = delete $args{ascending} // !delete $args{descending} // 1;
 250     my $case = delete $args{case} // !delete $args{no_case} // 1;
 251     my $collate = (delete $args{collate} // !delete $args{no_collate} // 1)
 252         && try_load_optional('Unicode::Collate');
 253
 254     if ($collate && !$case) {
 255         $case = 1;
 256         # use a proper Unicode::Collate level to ignore case
 257         $args{level} //= 2;
 258     }
 259     $args{upper_before_lower} //= 1;
 260
 261     my $value = $field;
 262     $value = $case ? sub { $_[0]->$field // '' } : sub { uc($_[0]->$field) // '' } if !is_coderef($value);
 263     my @all = CORE::map { [$_, $value->($_)] } @{$self->to_array};
 264
 265     if ($collate) {
 266         my $c = Unicode::Collate->new(%args);
 267         if ($ascending) {
 268             @all = CORE::map { $_->[0] } CORE::sort { $c->cmp($a->[1], $b->[1]) } @all;
 269         } else {
 270             @all = CORE::map { $_->[0] } CORE::sort { $c->cmp($b->[1], $a->[1]) } @all;
 271         }
 272     } else {
 273         if ($ascending) {
 274             @all = CORE::map { $_->[0] } CORE::sort { $a->[1] cmp $b->[1] } @all;
 275         } else {
 276             @all = CORE::map { $_->[0] } CORE::sort { $b->[1] cmp $a->[1] } @all;
 277         }
 278     }
 279
 280     $self->(\@all);
 281     return $self;
 282 }
 283
 284 =method nsort_by
 285
 286 =method norder_by
 287
 288     \&iterator = $iterator->nsort_by($field, %options);
 289     \&iterator = $iterator->nsort_by(\&get_value, %options);
 290
 291 Get a new iterator draining from an existing iterator but providing items sorted by an object field. Sorting
 292 is done numerically using C<< <=> >>. The C<\&get_value> subroutine is called once for each item and should
 293 return a numerical value. Options:
 294
 295 =for :list
 296 * C<ascending> - Order ascending if true, descending otherwise (default: true)
 297
 298 C<nsort_by> and C<norder_by> are aliases.
 299
 300 B<NOTE:> This method drains the iterator completely but adds items back onto the buffer, so the iterator is
 301 still usable afterward. Nevertheless, you mustn't call this on an infinite iterator or it will run until
 302 available memory is depleted.
 303
 304 =cut
 305
 306 sub norder_by {
 307     my $self    = shift;
 308     my $field   = shift;
 309     my %args    = @_;
 310
 311     my $ascending = $args{ascending} // !$args{descending} // 1;
 312
 313     my $value = $field;
 314     $value = sub { $_[0]->$field // 0 } if !is_coderef($value);
 315     my @all = CORE::map { [$_, $value->($_)] } @{$self->to_array};
 316
 317     if ($ascending) {
 318         @all = CORE::map { $_->[0] } CORE::sort { $a->[1] <=> $b->[1] } @all;
 319     } else {
 320         @all = CORE::map { $_->[0] } CORE::sort { $b->[1] <=> $a->[1] } @all;
 321     }
 322
 323     $self->(\@all);
 324     return $self;
 325 }
 326
 327 =method to_array
 328
 329     \@array = $iterator->to_array;
 330
 331 Get the rest of the items from an iterator as an arrayref.
 332
 333 B<NOTE:> This method drains the iterator completely, leaving the iterator empty. You mustn't call this on an
 334 infinite iterator or it will run until available memory is depleted.
 335
 336 =cut
 337
 338 sub to_array {
 339     my $self = shift;
 340
 341     my @all;
 342     push @all, $_ while defined (local $_ = $self->());
 343     return \@all;
 344 }
 345
 346 =method count
 347
 348 =method size
 349
 350     $size = $iterator->count;
 351
 352 Count the rest of the items from an iterator.
 353
 354 B<NOTE:> This method drains the iterator completely but adds items back onto the buffer, so the iterator is
 355 still usable afterward. Nevertheless, you mustn't call this on an infinite iterator or it will run until
 356 available memory is depleted.
 357
 358 =cut
 359
 360 sub size {
 361     my $self = shift;
 362
 363     my $items = $self->to_array;
 364     $self->($items);
 365     return scalar @$items;
 366 }
 367
 368 sub count { shift->size }
 369
 370 sub TO_JSON { $_[0]->to_array }
 371
 372 1;
 373 __END__
 374
 375 =for Pod::Coverage TO_JSON
 376
 377 =head1 SYNOPSIS
 378
 379     $kdbx->entries
 380         ->grep(sub { $_->title =~ /bank/i })
 381         ->sort_by('title')
 382         ->limit(5)
 383         ->each(sub {
 384             say $_->title;
 385         });
 386
 387 =head1 DESCRIPTION
 388
 389 A buffered iterator compatible with and expanding upon L<Iterator::Simple>, this provides an easy way to
 390 navigate a L<File::KDBX> database.
 391
 392 =head2 Buffer
 393
 394 This iterator is buffered, meaning it can drain from an iterator subroutine under the hood, storing items
 395 temporarily to be accessed later. This allows features like L</peek> and L</sort> which might be useful in the
 396 context of KDBX databases which are normally pretty small so draining an iterator isn't cost-prohibitive.
 397
 398 The way this works is that if you call an iterator without arguments, it acts like a normal iterator. If you
 399 call it with arguments, however, the arguments are added to the buffer. When called without arguments, the
 400 buffer is drained before the iterator function is. Using L</unget> is equivalent to calling the iterator with
 401 arguments, and as L</next> is equivalent to calling the iterator without arguments.
 402
 403 =cut