File Coverage

blib/lib/HashDataRole/Source/Array.pm
Criterion Covered Total %
statement 42 51 82.3
branch 13 22 59.0
condition n/a
subroutine 12 14 85.7
pod 0 11 0.0
total 67 98 68.3


line stmt bran cond sub pod time code
1             package HashDataRole::Source::Array;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2021-05-21'; # DATE
5             our $DIST = 'HashDataRoles-Standard'; # DIST
6             our $VERSION = '0.001'; # VERSION
7              
8 1     1   821 use 5.010001;
  1         4  
9 1     1   7 use Role::Tiny;
  1         2  
  1         7  
10 1     1   213 use Role::Tiny::With;
  1         3  
  1         712  
11             with 'HashDataRole::Spec::Basic';
12             with 'Role::TinyCommons::Collection::GetItemByPos'; # bonus
13              
14             sub new {
15 1     1 0 116 my ($class, %args) = @_;
16              
17 1 50       5 my $ary = delete $args{array} or die "Please specify 'array' argument";
18              
19 1 50       6 die "Unknown argument(s): ". join(", ", sort keys %args)
20             if keys %args;
21              
22             # create a hash from an array for quick lookup by key. we also check for
23             # duplicates here.
24 1         3 my $hash = {};
25 1         4 for my $elem (@$ary) {
26 3 50       9 die "Duplicate key '$elem->[0]'" if exists $hash->{$elem->[0]};
27 3         8 $hash->{$elem->[0]} = $elem;
28             }
29              
30             bless {
31 1         8 array => $ary,
32             _hash => $hash,
33             pos => 0,
34             }, $class;
35             }
36              
37             sub get_next_item {
38 5     5 0 62 my $self = shift;
39 5 100       10 die "StopIteration" unless $self->{pos} < @{ $self->{array} };
  5         24  
40 4         28 $self->{array}->[ $self->{pos}++ ];
41             }
42              
43             sub has_next_item {
44 2     2 0 9 my $self = shift;
45 2         4 $self->{pos} < @{ $self->{array} };
  2         14  
46             }
47              
48             sub reset_iterator {
49 2     2 0 9 my $self = shift;
50 2         10 $self->{pos} = 0;
51             }
52              
53             sub get_iterator_pos {
54 0     0 0 0 my $self = shift;
55 0         0 $self->{pos};
56             }
57              
58             sub get_item_count {
59 1     1 0 2 my $self = shift;
60 1         3 scalar @{ $self->{array} };
  1         8  
61             }
62              
63             sub get_item_at_pos {
64 2     2 0 39 my ($self, $pos) = @_;
65 2 50       6 if ($pos < 0) {
66 0 0       0 die "Out of range" unless -$pos <= @{ $self->{array} };
  0         0  
67             } else {
68 2 100       5 die "Out of range" unless $pos < @{ $self->{array} };
  2         17  
69             }
70 1         6 $self->{array}->[ $pos ];
71             }
72              
73             sub has_item_at_pos {
74 2     2 0 6 my ($self, $pos) = @_;
75 2 50       9 if ($pos < 0) {
76 0 0       0 return -$pos <= @{ $self->{array} } ? 1:0;
  0         0  
77             } else {
78 2 100       4 return $pos < @{ $self->{array} } ? 1:0;
  2         12  
79             }
80             }
81              
82             sub get_item_at_key {
83 2     2 0 47 my ($self, $key) = @_;
84 2 100       19 die "No such key '$key'" unless exists $self->{_hash}{$key};
85 1         5 $self->{_hash}{$key}[1];
86             }
87              
88             sub has_item_at_key {
89 2     2 0 7 my ($self, $key) = @_;
90 2         13 exists $self->{_hash}{$key};
91             }
92              
93             sub get_all_keys {
94 0     0 0   my ($self, $key) = @_;
95             # to be more deterministic
96 0           sort keys %{$self->{_hash}};
  0            
97             }
98              
99             1;
100             # ABSTRACT: Get hash data from a Perl array
101              
102             __END__