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

   1 package File::KDBX::Iterator;
   2 # ABSTRACT: 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_ref 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 unmatching items before the matching item. Example:
  61
  62     my $item = $iterator->next(sub { $_->label =~ /Gym/ });
  63
  64 =cut
  65
  66 sub next {
  67     my $self = shift;
  68     my $code = shift or return $self->();
  69
  70     $code = query_any($code, @_);
  71
  72     while (defined (local $_ = $self->())) {
  73         return $_ if $code->($_);
  74     }
  75     return;
  76 }
  77
  78 =method peek
  79
  80     $item = $iterator->peek;
  81
  82 Peek at the next item. Returns C<undef> if the iterator is empty. This allows you to access the next item
  83 without draining it from the iterator. The same item will be returned the next time L</next> is called.
  84
  85 =cut
  86
  87 sub peek {
  88     my $self = shift;
  89
  90     my $next = $self->();
  91     $self->($next) if defined $next;
  92     return $next;
  93 }
  94
  95 =method unget
  96
  97     $iterator->unget(\@items);
  98     $iterator->unget(...);
  99     # OR equivalently
 100     $iterator->(\@items);
 101     $iterator->(...);
 102
 103 Replace the buffer or unshift one or more items to the current buffer.
 104
 105 See L</Buffer>.
 106
 107 =cut
 108
 109 sub unget {
 110     my $self = shift;   # Must shift in a statement before calling.
 111     $self->(@_);
 112 }
 113
 114 =method each
 115
 116     @items = $iterator->each;
 117
 118     $iterator->each(sub($item, $num, @args) { ... }, @args);
 119
 120     $iterator->each($method_name, ...);
 121
 122 Get or act on the rest of the items. There are three forms:
 123
 124 =for :list
 125 1. Without arguments, C<each> returns a list of the rest of the items.
 126 2. Pass a coderef to be called once per item, in order. Arguments to the coderef are the item itself (also
 127    C<$_>), its index number and then any extra arguments that were passed to C<each> after the coderef.
 128 3. Pass a string that is the name of a method to be called on each object, in order. Any extra arguments
 129    passed to C<each> after the method name are passed through to each method call. This form requires each
 130    item be an object that C<can> the given method.
 131
 132 B<NOTE:> This method drains the iterator completely, leaving it empty. See L</CAVEATS>.
 133
 134 =cut
 135
 136 sub each {
 137     my $self = shift;
 138     my $cb = shift or return @{$self->to_array};
 139
 140     if (is_coderef($cb)) {
 141         my $count = 0;
 142         $cb->($_, $count++, @_) while defined (local $_ = $self->());
 143     }
 144     elsif (!is_ref($cb)) {
 145         $_->$cb(@_) while defined (local $_ = $self->());
 146     }
 147     return $self;
 148 }
 149
 150 =method grep
 151
 152 =method where
 153
 154     \&iterator = $iterator->grep(\&query);
 155     \&iterator = $iterator->grep([\'simple expression', @fields]);
 156
 157 Get a new iterator draining from an existing iterator but providing only items that pass a test or are matched
 158 by a query.
 159
 160 =cut
 161
 162 sub where { shift->grep(@_) }
 163
 164 sub grep {
 165     my $self = shift;
 166     my $code = query_any(@_);
 167
 168     ref($self)->new(sub {
 169         while (defined (local $_ = $self->())) {
 170             return $_ if $code->($_);
 171         }
 172         return;
 173     });
 174 }
 175
 176 =method map
 177
 178     \&iterator = $iterator->map(\&code);
 179
 180 Get a new iterator draining from an existing iterator but providing modified items.
 181
 182 =cut
 183
 184 sub map {
 185     my $self = shift;
 186     my $code = shift;
 187
 188     ref($self)->new(sub {
 189         local $_ = $self->();
 190         return if !defined $_;
 191         return $code->();
 192     });
 193 }
 194
 195 =method order_by
 196
 197     \&iterator = $iterator->sort_by($field, %options);
 198     \&iterator = $iterator->sort_by(\&get_value, %options);
 199
 200 Get a new iterator draining from an existing iterator but providing items sorted by an object field. Sorting
 201 is done using L<Unicode::Collate> (if available) or C<cmp> to sort alphanumerically. The C<\&get_value>
 202 subroutine is called once for each item and should return a string value. Options:
 203
 204 =for :list
 205 * C<ascending> - Order ascending if true, descending otherwise (default: true)
 206 * C<case> - If true, take case into account, otherwise ignore case (default: true)
 207 * C<collate> - If true, use B<Unicode::Collate> (if available), otherwise use perl built-ins (default: true)
 208 * Any B<Unicode::Collate> option is also supported.
 209
 210 C<sort_by> and C<order_by> are aliases.
 211
 212 B<NOTE:> This method drains the iterator completely and places the sorted items onto the buffer. See
 213 L</CAVEATS>.
 214
 215 =cut
 216
 217 sub order_by {
 218     my $self    = shift;
 219     my $field   = shift;
 220     my %args    = @_;
 221
 222     my $ascending = delete $args{ascending} // !delete $args{descending} // 1;
 223     my $case = delete $args{case} // !delete $args{no_case} // 1;
 224     my $collate = (delete $args{collate} // !delete $args{no_collate} // 1)
 225         && try_load_optional('Unicode::Collate');
 226
 227     if ($collate && !$case) {
 228         $case = 1;
 229         # use a proper Unicode::Collate level to ignore case
 230         $args{level} //= 2;
 231     }
 232     $args{upper_before_lower} //= 1;
 233
 234     my $value = $field;
 235     $value = $case ? sub { $_[0]->$field // '' } : sub { uc($_[0]->$field) // '' } if !is_coderef($value);
 236     my @all = CORE::map { [$_, $value->($_)] } @{$self->to_array};
 237
 238     if ($collate) {
 239         my $c = Unicode::Collate->new(%args);
 240         if ($ascending) {
 241             @all = CORE::map { $_->[0] } CORE::sort { $c->cmp($a->[1], $b->[1]) } @all;
 242         } else {
 243             @all = CORE::map { $_->[0] } CORE::sort { $c->cmp($b->[1], $a->[1]) } @all;
 244         }
 245     } else {
 246         if ($ascending) {
 247             @all = CORE::map { $_->[0] } CORE::sort { $a->[1] cmp $b->[1] } @all;
 248         } else {
 249             @all = CORE::map { $_->[0] } CORE::sort { $b->[1] cmp $a->[1] } @all;
 250         }
 251     }
 252
 253     $self->(\@all);
 254     return $self;
 255 }
 256
 257 =method sort_by
 258
 259 Alias for L</order_by>.
 260
 261 =cut
 262
 263 sub sort_by { shift->order_by(@_)  }
 264
 265 =method norder_by
 266
 267     \&iterator = $iterator->nsort_by($field, %options);
 268     \&iterator = $iterator->nsort_by(\&get_value, %options);
 269
 270 Get a new iterator draining from an existing iterator but providing items sorted by an object field. Sorting
 271 is done numerically using C<< <=> >>. The C<\&get_value> subroutine or C<$field> accessor is called once for
 272 each item and should return a numerical value. Options:
 273
 274 =for :list
 275 * C<ascending> - Order ascending if true, descending otherwise (default: true)
 276
 277 C<nsort_by> and C<norder_by> are aliases.
 278
 279 B<NOTE:> This method drains the iterator completely and places the sorted items onto the buffer. See
 280 L</CAVEATS>.
 281
 282 =cut
 283
 284 sub norder_by {
 285     my $self    = shift;
 286     my $field   = shift;
 287     my %args    = @_;
 288
 289     my $ascending = $args{ascending} // !$args{descending} // 1;
 290
 291     my $value = $field;
 292     $value = sub { $_[0]->$field // 0 } if !is_coderef($value);
 293     my @all = CORE::map { [$_, $value->($_)] } @{$self->to_array};
 294
 295     if ($ascending) {
 296         @all = CORE::map { $_->[0] } CORE::sort { $a->[1] <=> $b->[1] } @all;
 297     } else {
 298         @all = CORE::map { $_->[0] } CORE::sort { $b->[1] <=> $a->[1] } @all;
 299     }
 300
 301     $self->(\@all);
 302     return $self;
 303 }
 304
 305 =method nsort_by
 306
 307 Alias for L</norder_by>.
 308
 309 =cut
 310
 311 sub nsort_by { shift->norder_by(@_) }
 312
 313 =method limit
 314
 315     \&iterator = $iterator->limit($count);
 316
 317 Get a new iterator draining from an existing iterator but providing only a limited number of items.
 318
 319 C<limit> as an alias for L<Iterator::Simple/"$iterator->head($count)">.
 320
 321 =cut
 322
 323 sub limit { shift->head(@_) }
 324
 325 =method to_array
 326
 327     \@array = $iterator->to_array;
 328
 329 Get the rest of the items from an iterator as an arrayref.
 330
 331 B<NOTE:> This method drains the iterator completely, leaving it empty. See L</CAVEATS>.
 332
 333 =cut
 334
 335 sub to_array {
 336     my $self = shift;
 337
 338     my @all;
 339     push @all, $_ while defined (local $_ = $self->());
 340     return \@all;
 341 }
 342
 343 =method count
 344
 345     $size = $iterator->count;
 346
 347 Count the rest of the items from an iterator.
 348
 349 B<NOTE:> This method drains the iterator completely but restores it to its pre-drained state. See L</CAVEATS>.
 350
 351 =cut
 352
 353 sub count {
 354     my $self = shift;
 355
 356     my $items = $self->to_array;
 357     $self->($items);
 358     return scalar @$items;
 359 }
 360
 361 =method size
 362
 363 Alias for L</count>.
 364
 365 =cut
 366
 367 sub size { shift->count }
 368
 369 ##############################################################################
 370
 371 sub TO_JSON { $_[0]->to_array }
 372
 373 1;
 374 __END__
 375
 376 =for Pod::Coverage TO_JSON
 377
 378 =head1 SYNOPSIS
 379
 380     my $kdbx = File::KDBX->load('database.kdbx', 'masterpw');
 381
 382     $kdbx->entries
 383         ->where(sub { $_->title =~ /bank/i })
 384         ->order_by('title')
 385         ->limit(5)
 386         ->each(sub {
 387             say $_->title;
 388         });
 389
 390 =head1 DESCRIPTION
 391
 392 A buffered iterator compatible with and expanding upon L<Iterator::Simple>, this provides an easy way to
 393 navigate a L<File::KDBX> database. The documentation for B<Iterator::Simple> documents functions and methods
 394 supported but this iterator that are not documented here, so consider that additional reading.
 395
 396 =head2 Buffer
 397
 398 This iterator is buffered, meaning it can drain from an iterator subroutine under the hood, storing items
 399 temporarily to be accessed later. This allows features like L</peek> and L</sort> which might be useful in the
 400 context of KDBX databases which are normally pretty small so draining an iterator isn't cost-prohibitive.
 401
 402 The way this works is that if you call an iterator without arguments, it acts like a normal iterator. If you
 403 call it with arguments, however, the arguments are added to the buffer. When called without arguments, the
 404 buffer is drained before the iterator function is. Using L</unget> is equivalent to calling the iterator with
 405 arguments, and as L</next> is equivalent to calling the iterator without arguments.
 406
 407 =head1 CAVEATS
 408
 409 Some methods attempt to drain the iterator completely before returning. For obvious reasons, this won't work
 410 for infinite iterators because your computer doesn't have infinite memory. This isn't a practical issue with
 411 B<File::KDBX> lists which are always finite -- unless you do something weird like force a child group to be
 412 its own ancestor -- but I'm noting it here as a potential issue if you use this iterator class for other
 413 things (which you probably shouldn't do).
 414
 415 =cut