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