File Coverage

blib/lib/NumSeq/Iter.pm
Criterion Covered Total %
statement 76 83 91.5
branch 42 56 75.0
condition 23 24 95.8
subroutine 7 8 87.5
pod 2 2 100.0
total 150 173 86.7


line stmt bran cond sub pod time code
1             package NumSeq::Iter;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2021-07-17'; # DATE
5             our $DIST = 'NumSeq-Iter'; # DIST
6             our $VERSION = '0.002'; # VERSION
7              
8 1     1   74716 use 5.010001;
  1         12  
9 1     1   5 use strict;
  1         2  
  1         20  
10 1     1   4 use warnings;
  1         2  
  1         40  
11              
12 1     1   6 use Exporter qw(import);
  1         9  
  1         843  
13             our @EXPORT_OK = qw(numseq_iter numseq_parse);
14              
15             my $re_num = qr/(?:[+-]?[0-9]+(?:\.[0-9]+)?)/;
16              
17             sub _numseq_parse_or_iter {
18 27     27   46 my $which = shift;
19 27 50       72 my $opts = ref($_[0]) eq 'HASH' ? shift : {};
20 27         43 my $numseq = shift;
21              
22 27         40 my @nums;
23 27         275 while ($numseq =~ s/\A(\s*,\s*)?($re_num)//) {
24 66 100 100     256 die "Number sequence must not start with comma" if $1 && !@nums;
25 65         365 push @nums, $2;
26             }
27 26 100       82 die "Please specify one or more number in number sequence: '$numseq'" unless @nums;
28              
29 24         36 my $has_ellipsis = 0;
30 24 100       90 if ($numseq =~ s/\A\s*,\s*\.\.\.//) {
31 19 100       50 die "Please specify at least three number in number sequence before ellipsis" unless @nums >= 3;
32 18         27 $has_ellipsis++;
33             }
34              
35 23         30 my $last_num;
36 23 100       138 if ($numseq =~ s/\A\s*,\s*($re_num|[+-]?Inf)//) {
37 12         27 $last_num = $1;
38             }
39 23 100       84 die "Extraneous token in number sequence: $numseq, please only use 'a,b,c, ...' or 'a,b,c,...,z'" if length $numseq;
40              
41 19         28 my ($is_arithmetic, $is_geometric, $inc);
42             CHECK_SEQ_TYPE: {
43 19 100       39 last unless $has_ellipsis;
  19         38  
44              
45             CHECK_ARITHMETIC: {
46 16         19 my $inc0;
  16         21  
47 16         44 for (1..$#nums) {
48 32 100       78 if ($_ == 1) { $inc0 = $nums[1] - $nums[0] }
  16 100       34  
49             elsif ($inc0 != ($nums[$_] - $nums[$_-1])) {
50 7         16 last CHECK_ARITHMETIC;
51             }
52             }
53 9         18 $is_arithmetic++;
54 9         11 $inc = $inc0;
55 9         18 last CHECK_SEQ_TYPE;
56             }
57              
58             CHECK_GEOMETRIC: {
59 7 50       10 last if $nums[0] == 0;
  7         15  
60 7         9 my $inc0;
61 7         15 for (1..$#nums) {
62 14 100       21 if ($_ == 1) { $inc0 = $nums[1] / $nums[0] }
  7         15  
63             else {
64 7 50       16 last CHECK_GEOMETRIC if $nums[$_-1] == 0;
65 7 100       17 if ($inc0 != ($nums[$_] / $nums[$_-1])) {
66 1         4 last CHECK_GEOMETRIC;
67             }
68             }
69             }
70 6         12 $is_geometric++;
71 6         9 $inc = $inc0;
72 6         11 last CHECK_SEQ_TYPE;
73             }
74              
75 1         12 die "Can't determine the pattern from number sequence: ".join(", ", @nums);
76             }
77              
78 18 50       38 if ($which eq 'parse') {
79             return {
80 0 0       0 numbers => \@nums,
    0          
    0          
81             has_ellipsis => $has_ellipsis,
82             ($has_ellipsis ? (last_number => $last_num) : ()),
83             type => $is_arithmetic ? 'arithmetic' : ($is_geometric ? 'geometric' : 'itemized'),
84             inc => $inc,
85             };
86             }
87              
88 18         22 my $i = 0;
89 18         26 my $cur;
90             my $ends;
91             return sub {
92 99 50   99   403 return undef if $ends;
93 99 100       298 return $nums[$i++] if $i <= $#nums;
94 99 100       77 if (!$has_ellipsis) { $ends++; return undef }
  3         5  
  3         8  
95              
96 96   66     101 $cur //= $nums[-1];
97 96 100       84 if ($is_arithmetic) {
    50          
98 27         32 $cur += $inc;
99 27 100       46 if (defined $last_num) {
100 18 100 100     82 if ($inc >= 0 && $cur > $last_num || $inc < 0 && $cur < $last_num) {
      100        
      100        
101 5         10 $ends++;
102 5         10 return undef;
103             }
104             }
105 22         40 return $cur;
106             } elsif ($is_geometric) {
107 17         23 $cur *= $inc;
108 17 100       28 if (defined $last_num) {
109 11 100 100     47 if ($inc >= 1 && $cur > $last_num || $inc < 1 && $cur < $last_num) {
      100        
      100        
110 4         7 $ends++;
111 4         9 return undef;
112             }
113             }
114 13         27 return $cur;
115             }
116 18         147 };
117             }
118              
119             sub numseq_iter {
120 27     27 1 15486 _numseq_parse_or_iter('iter', @_);
121             }
122              
123             sub numseq_parse {
124 0     0 1   my $res;
125 0           eval {
126 0           $res = _numseq_parse_or_iter('parse', @_);
127             };
128 0 0         if ($@) { return [400, "Parse fail: $@"] }
  0            
129 0           [200, "OK", $res];
130             }
131              
132             1;
133             # ABSTRACT: Generate a coderef iterator from a number sequence specification (e.g. '1,3,5,...,101')
134              
135             __END__