line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IntRange::Iter; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY |
4
|
|
|
|
|
|
|
our $DATE = '2021-07-17'; # DATE |
5
|
|
|
|
|
|
|
our $DIST = 'IntRange-Iter'; # DIST |
6
|
|
|
|
|
|
|
our $VERSION = '0.004'; # VERSION |
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
62145
|
use strict; |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
26
|
|
9
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
23
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
4
|
use Exporter qw(import); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
591
|
|
12
|
|
|
|
|
|
|
our @EXPORT_OK = qw(intrange_iter); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# allow_dash |
15
|
|
|
|
|
|
|
our $re1a = qr/\A(?: |
16
|
|
|
|
|
|
|
(?:(?:-?[0-9]+)(?:\s*-\s*(?:-?[0-9]+))?) |
17
|
|
|
|
|
|
|
( |
18
|
|
|
|
|
|
|
\s*,\s* |
19
|
|
|
|
|
|
|
(?:(?:-?[0-9]+)(?:\s*-\s*(?:-?[0-9]+))?) |
20
|
|
|
|
|
|
|
)* |
21
|
|
|
|
|
|
|
)\z/x; |
22
|
|
|
|
|
|
|
our $re1b = qr/\A |
23
|
|
|
|
|
|
|
(?:\s*,\s*)?(?: |
24
|
|
|
|
|
|
|
(-?[0-9]+)\s*-\s*(-?[0-9]+) | (-?[0-9]+) |
25
|
|
|
|
|
|
|
) |
26
|
|
|
|
|
|
|
/x; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# allow_dotdot |
29
|
|
|
|
|
|
|
our $re2a = qr/\A(?: |
30
|
|
|
|
|
|
|
(?:(?:-?[0-9]+)(?:\s*\.\.\s*(?:-?[0-9]+))?) |
31
|
|
|
|
|
|
|
( |
32
|
|
|
|
|
|
|
\s*,\s* |
33
|
|
|
|
|
|
|
(?:(?:-?[0-9]+)(?:\s*\.\.\s*(?:-?[0-9]+))?) |
34
|
|
|
|
|
|
|
)* |
35
|
|
|
|
|
|
|
)\z/x; |
36
|
|
|
|
|
|
|
our $re2b = qr/\A |
37
|
|
|
|
|
|
|
(?:\s*,\s*)?(?: |
38
|
|
|
|
|
|
|
(-?[0-9]+)\s*\.\.\s*(-?[0-9]+) | (-?[0-9]+) |
39
|
|
|
|
|
|
|
) |
40
|
|
|
|
|
|
|
/x; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# allow_dash + allow dotdot |
43
|
|
|
|
|
|
|
our $re3a = qr/\A(?: |
44
|
|
|
|
|
|
|
(?:(?:-?[0-9]+)(?:\s*(?:-|\.\.)\s*(?:-?[0-9]+))?) |
45
|
|
|
|
|
|
|
( |
46
|
|
|
|
|
|
|
\s*,\s* |
47
|
|
|
|
|
|
|
(?:(?:-?[0-9]+)(?:\s*(?:-|\.\.)\s*(?:-?[0-9]+))?) |
48
|
|
|
|
|
|
|
)* |
49
|
|
|
|
|
|
|
)\z/x; |
50
|
|
|
|
|
|
|
our $re3b = qr/\A |
51
|
|
|
|
|
|
|
(?:\s*,\s*)?(?: |
52
|
|
|
|
|
|
|
(-?[0-9]+)\s*(?:-|\.\.)\s*(-?[0-9]+) | (-?[0-9]+) |
53
|
|
|
|
|
|
|
) |
54
|
|
|
|
|
|
|
/x; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub intrange_iter { |
57
|
13
|
100
|
|
13
|
1
|
6286
|
my $opts = ref($_[0]) eq 'HASH' ? shift : {}; |
58
|
13
|
|
|
|
|
20
|
my $intrange = shift; |
59
|
|
|
|
|
|
|
|
60
|
13
|
|
100
|
|
|
41
|
my $allow_dash = $opts->{allow_dash} // 1; |
61
|
13
|
|
100
|
|
|
29
|
my $allow_dotdot = $opts->{allow_dotdot} // 0; |
62
|
13
|
50
|
66
|
|
|
26
|
unless ($allow_dash || $allow_dotdot) { die "At least must enable allow_dash or allow_dotdot" } |
|
0
|
|
|
|
|
0
|
|
63
|
|
|
|
|
|
|
|
64
|
13
|
|
|
|
|
17
|
my ($re_a, $re_b); |
65
|
13
|
100
|
100
|
|
|
37
|
if ($allow_dash && $allow_dotdot) { ($re_a, $re_b) = ($re3a, $re3b) } |
|
3
|
100
|
|
|
|
5
|
|
|
|
50
|
|
|
|
|
|
66
|
8
|
|
|
|
|
14
|
elsif ($allow_dash) { ($re_a, $re_b) = ($re1a, $re1b) } |
67
|
2
|
|
|
|
|
3
|
elsif ($allow_dotdot) { ($re_a, $re_b) = ($re2a, $re2b) } |
68
|
|
|
|
|
|
|
|
69
|
13
|
100
|
|
|
|
104
|
unless ($intrange =~ $re_a) { |
70
|
4
|
|
|
|
|
34
|
die "Invalid syntax for intrange, please use a (1), a-b (1-3), or sequence of a-b (1,5-10,15)"; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
9
|
|
|
|
|
18
|
my @subranges; |
74
|
9
|
|
|
|
|
47
|
while ($intrange =~ s/$re_b//) { |
75
|
14
|
100
|
|
|
|
78
|
push @subranges, defined($1) ? [$1, $2] : $3; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
#use DD; dd \@subranges; |
78
|
9
|
|
|
|
|
13
|
my $cur_subrange = 0; |
79
|
9
|
|
|
|
|
11
|
my ($m, $n); |
80
|
|
|
|
|
|
|
return sub { |
81
|
50
|
100
|
|
50
|
|
172
|
RESTART: |
82
|
|
|
|
|
|
|
return undef if $cur_subrange > $#subranges; |
83
|
41
|
100
|
|
|
|
62
|
if (ref $subranges[$cur_subrange] eq 'ARRAY') { |
84
|
36
|
100
|
|
|
|
52
|
unless (defined $m) { |
85
|
9
|
|
|
|
|
9
|
($m, $n) = (@{ $subranges[$cur_subrange] }); |
|
9
|
|
|
|
|
18
|
|
86
|
|
|
|
|
|
|
} |
87
|
36
|
100
|
|
|
|
50
|
if ($m > $n) { |
88
|
9
|
|
|
|
|
10
|
$cur_subrange++; |
89
|
9
|
|
|
|
|
11
|
undef $m; undef $n; |
|
9
|
|
|
|
|
10
|
|
90
|
9
|
|
|
|
|
31
|
goto RESTART; |
91
|
|
|
|
|
|
|
} else { |
92
|
27
|
|
|
|
|
43
|
return $m++; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
} else { |
95
|
5
|
|
|
|
|
11
|
return $subranges[$cur_subrange++]; |
96
|
|
|
|
|
|
|
} |
97
|
9
|
|
|
|
|
50
|
}; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
1; |
101
|
|
|
|
|
|
|
# ABSTRACT: Generate a coderef iterator from an int range specification (e.g. '1,5-10,20') |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
__END__ |