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