Dogcows Code - chaz/p5-File-KDBX/blob - t/iterator.t

   1 #!/usr/bin/env perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use lib 't/lib';
   7 use TestCommon;
   8
   9 use File::KDBX::Iterator;
  10 use File::KDBX::Entry;
  11 use File::KDBX::Util qw(:load);
  12 use Iterator::Simple qw(:all);
  13 use Test::More;
  14
  15 subtest 'Basic' => sub {
  16     my $it = File::KDBX::Iterator->new(1..10);
  17
  18     is $it->(), 1, 'Get next item (1)';
  19     is $it->(), 2, 'Get next item (2)';
  20     $it->unget(-5);
  21     is $it->(), -5, 'Unget';
  22     is $it->peek, 3, 'Peek at next';
  23     is $it->(), 3, 'Get next item (3)';
  24     is $it->count, 7, 'Get current size';
  25
  26     my $limited = $it->limit(3);
  27     is $limited->count, 3, 'Get current size';
  28     my $enum = ienumerate $limited;
  29     is_deeply $enum->to_array, [[0, 4], [1, 5], [2, 6]], 'Use Iterator::Simple functions';
  30
  31     is $it->(), 7, 'Original iterator is drained by composing iterator';
  32
  33     is $it->next(sub { $_ == 9 }), 9, 'Find next matching item';
  34     is $it->next, 10, 'Item got skipped while finding next match';
  35     is $it->peek, undef, 'No more items (peek)';
  36     is $it->next, undef, 'No more items (next)';
  37
  38     $it->(qw{10 20 30});
  39     is_deeply [$it->each], [qw{10 20 30}], 'Fill buffer and get each item (list)';
  40     is $it->(), undef, 'Empty';
  41
  42     $it->(my $buffer = [qw{a b c}]);
  43     my @each;
  44     $it->each(sub { push @each, $_ });
  45     is_deeply \@each, [qw{a b c}], 'Fill buffer and get each item (function)';
  46     is_deeply $buffer, [], 'Buffer is empty';
  47 };
  48
  49 subtest 'Sorting' => sub {
  50     my $new_it = sub {
  51         File::KDBX::Iterator->new(
  52             File::KDBX::Entry->new(label => 'foo', icon_id => 1),
  53             File::KDBX::Entry->new(label => 'bar', icon_id => 5),
  54             File::KDBX::Entry->new(label => 'BaZ', icon_id => 3),
  55             File::KDBX::Entry->new(label => 'qux', icon_id => 2),
  56             File::KDBX::Entry->new(label => 'Muf', icon_id => 4),
  57         );
  58     };
  59
  60     my @sort = (label => collate => 0);
  61
  62     my $it = $new_it->();
  63     is_deeply $it->sort_by(@sort)->map(sub { $_->label })->to_array,
  64         [qw{BaZ Muf bar foo qux}], 'Sort text ascending';
  65
  66     $it = $new_it->();
  67     is_deeply $it->sort_by(@sort, case => 0)->map(sub { $_->label })->to_array,
  68         [qw{bar BaZ foo Muf qux}], 'Sort text ascending, ignore-case';
  69
  70     $it = $new_it->();
  71     is_deeply $it->sort_by(@sort, ascending => 0)->map(sub { $_->label })->to_array,
  72         [qw{qux foo bar Muf BaZ}], 'Sort text descending';
  73
  74     $it = $new_it->();
  75     is_deeply $it->sort_by(@sort, ascending => 0, case => 0)->map(sub { $_->label })->to_array,
  76         [qw{qux Muf foo BaZ bar}], 'Sort text descending, ignore-case';
  77
  78     SKIP: {
  79         plan skip_all => 'Unicode::Collate required to test collation sorting'
  80             if !try_load_optional('Unicode::Collate');
  81
  82         # FIXME I'm missing something....
  83         # $it = $new_it->();
  84         # is_deeply $it->sort_by('label')->map(sub { $_->label })->to_array,
  85         #     [qw{BaZ Muf bar foo qux}], 'Sort text ascending using Unicode::Collate';
  86
  87         $it = $new_it->();
  88         is_deeply $it->sort_by('label', case => 0)->map(sub { $_->label })->to_array,
  89             [qw{bar BaZ foo Muf qux}], 'Sort text ascending, ignore-case using Unicode::Collate';
  90     }
  91
  92     $it = $new_it->();
  93     is_deeply $it->nsort_by('icon_id')->map(sub { $_->label })->to_array,
  94         [qw{foo qux BaZ Muf bar}], 'Sort text numerically, ascending';
  95
  96     $it = $new_it->();
  97     is_deeply $it->nsort_by('icon_id', ascending => 0)->map(sub { $_->label })->to_array,
  98         [qw{bar Muf BaZ qux foo}], 'Sort text numerically, descending';
  99 };
 100
 101 done_testing;