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