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