File Coverage

blib/lib/Iterator/Flex/ArrayLike.pm
Criterion Covered Total %
statement 58 58 100.0
branch 13 22 59.0
condition 3 15 20.0
subroutine 15 15 100.0
pod 1 2 50.0
total 90 112 80.3


line stmt bran cond sub pod time code
1             package Iterator::Flex::ArrayLike;
2              
3             # ABSTRACT: ArrayLike Iterator Class
4              
5 2     2   316259 use v5.28;
  2         6  
6 2     2   8 use strict;
  2         4  
  2         37  
7 2     2   10 use warnings;
  2         1  
  2         89  
8 2     2   839 use experimental 'signatures';
  2         4623  
  2         9  
9              
10             our $VERSION = '0.34';
11              
12 2     2   1230 use Ref::Util;
  2         3818  
  2         101  
13 2     2   834 use Iterator::Flex::Utils ':IterAttrs', 'resolve_meth', 'throw_failure';
  2         5  
  2         404  
14 2     2   847 use namespace::clean;
  2         34004  
  2         27  
15              
16 2     2   988 use parent 'Iterator::Flex::Base';
  2         219  
  2         11  
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35              
36              
37              
38              
39              
40              
41              
42              
43              
44              
45              
46              
47              
48              
49              
50              
51              
52              
53              
54              
55              
56              
57              
58              
59              
60              
61              
62              
63              
64              
65              
66              
67              
68              
69              
70              
71              
72              
73              
74              
75              
76 7     7 1 230341 sub new ( $class, $obj, $pars = {} ) {
  7         9  
  7         9  
  7         10  
  7         9  
77              
78 7 50       19 throw_failure( parameter => q{argument must be a blessed reference} )
79             unless Ref::Util::is_blessed_ref( $obj );
80              
81 7         50 $class->SUPER::new( { object => $obj }, $pars );
82             }
83              
84 7     7 0 8 sub construct ( $class, $state ) {
  7         7  
  7         7  
  7         7  
85              
86 7 50       13 throw_failure( parameter => q{state must be a HASH reference} )
87             unless Ref::Util::is_hashref( $state );
88              
89             my ( $obj, $prev, $current, $next, $length, $at )
90 7         8 = @{$state}{qw[ object prev current next length at ]};
  7         18  
91              
92 7 50       13 throw_failure( parameter => q{state 'object' argument must be a blessed reference} )
93             unless Ref::Util::is_blessed_ref( $obj );
94              
95 7         21 $length = resolve_meth( $obj, $length, 'length', 'len' );
96              
97 7         14 $at = resolve_meth( $obj, $at, 'at', 'getitem' );
98              
99 7         16 my $len = $obj->$length;
100              
101 7 50       28 $next = 0 unless defined $next;
102              
103 7 0 0     12 throw_failure( parameter => q{illegal value for state 'prev' argument} )
      33        
104             if defined $prev && ( $prev < 0 || $prev >= $len );
105              
106 7 0 0     9 throw_failure( parameter => q{illegal value for state 'current' argument} )
      33        
107             if defined $current && ( $current < 0 || $current >= $len );
108              
109 7 50 33     23 throw_failure( parameter => q{illegal value for state 'next' argument} )
110             if $next < 0 || $next > $len;
111              
112 7         11 my $self;
113              
114             return {
115              
116             ( +_SELF ) => \$self,
117              
118             ( +RESET ) => sub {
119 2     2   3 $prev = $current = undef;
120 2         3 $next = 0;
121             },
122              
123             ( +REWIND ) => sub {
124 2     2   4 $next = 0;
125             },
126              
127             ( +PREV ) => sub {
128 31 100   31   59 return defined $prev ? $obj->$at( $prev ) : undef;
129             },
130              
131             ( +CURRENT ) => sub {
132 29 100   29   57 return defined $current ? $obj->$at( $current ) : undef;
133             },
134              
135             ( +NEXT ) => sub {
136 51 100   51   72 if ( $next == $len ) {
137             # if first time through, set current
138 21 100       48 $prev = $current
139             if !$self->is_exhausted;
140 21         38 return $current = $self->signal_exhaustion;
141             }
142 30         27 $prev = $current;
143 30         32 $current = $next++;
144              
145 30         40 return $obj->$at( $current );
146             },
147 7         84 };
148             }
149              
150              
151             __PACKAGE__->_add_roles( qw[
152             State::Registry
153             Next::ClosedSelf
154             Rewind::Closure
155             Reset::Closure
156             Prev::Closure
157             Current::Closure
158             ] );
159              
160             1;
161              
162             #
163             # This file is part of Iterator-Flex
164             #
165             # This software is Copyright (c) 2018 by Smithsonian Astrophysical Observatory.
166             #
167             # This is free software, licensed under:
168             #
169             # The GNU General Public License, Version 3, June 2007
170             #
171              
172             __END__