File Coverage

blib/lib/Data/Sah/Coerce/perl/To_array/From_str/int_range_and_comma_sep.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod 0 2 0.0
total 20 22 90.9


line stmt bran cond sub pod time code
1             package Data::Sah::Coerce::perl::To_array::From_str::int_range_and_comma_sep;
2              
3             # AUTHOR
4             our $DATE = '2019-11-28'; # DATE
5             our $DIST = 'Data-Sah-CoerceBundle-To_array-From_str-int_range_and_comma_sep'; # DIST
6             our $VERSION = '0.006'; # VERSION
7              
8 1     1   1701 use 5.010001;
  1         4  
9 1     1   5 use strict;
  1         2  
  1         17  
10 1     1   5 use warnings;
  1         1  
  1         164  
11              
12             sub meta {
13             +{
14 1     1 0 12 v => 4,
15             summary => 'Coerce array of ints from comma-separated ints/int ranges',
16             might_fail => 1,
17             prio => 60, # a bit lower than normal
18             precludes => ['From_str::int_range', 'From_str::comma_sep'],
19             };
20             }
21              
22             sub coerce {
23 1     1 0 15 my %args = @_;
24              
25 1         2 my $dt = $args{data_term};
26              
27 1         2 my $res = {};
28              
29 1         3 $res->{expr_match} = "!ref($dt)";
30              
31 1         4 $res->{expr_coerce} = join(
32             "",
33             "do { ",
34             "my \$res; my \$ary = []; ",
35             "for my \$elem (split /\\s*,\\s*/, $dt) { ",
36             " my (\$int1, \$int2) = \$elem =~ /\\A\\s*([+-]?\\d+)(?:\\s*(?:-|\\.\\.)\\s*([+-]?\\d+))?\\s*\\z/; ",
37             " if (!defined \$int1) { \$res = [\"Invalid elem '\$elem': must be INT or INT1-INT2\"]; last } ",
38             " if (defined \$int2) { ",
39             " if (\$int2 - \$int1 > 1_000_000) { \$res = [\"Elem '\$elem': Range too big\"]; last } ",
40             " push \@\$ary, \$int1+0 .. \$int2+0; ",
41             " } else { push \@\$ary, \$int1 } ",
42             "}", # for
43             "\$res ||= [undef, \$ary]; ",
44             "\$res }",
45             );
46              
47 1         3 $res;
48             }
49              
50             1;
51             # ABSTRACT: Coerce array of ints from comma-separated ints/int ranges
52              
53             __END__
54              
55             =pod
56              
57             =encoding UTF-8
58              
59             =head1 NAME
60              
61             Data::Sah::Coerce::perl::To_array::From_str::int_range_and_comma_sep - Coerce array of ints from comma-separated ints/int ranges
62              
63             =head1 VERSION
64              
65             This document describes version 0.006 of Data::Sah::Coerce::perl::To_array::From_str::int_range_and_comma_sep (from Perl distribution Data-Sah-CoerceBundle-To_array-From_str-int_range_and_comma_sep), released on 2019-11-28.
66              
67             =head1 SYNOPSIS
68              
69             To use in a Sah schema:
70              
71             ["array",{"x.perl.coerce_rules"=>["From_str::int_range_and_comma_sep"]}]
72              
73             =for Pod::Coverage ^(meta|coerce)$
74              
75             =head1 HOMEPAGE
76              
77             Please visit the project's homepage at L<https://metacpan.org/release/Data-Sah-CoerceBundle-To_array-From_str-int_range_and_comma_sep>.
78              
79             =head1 SOURCE
80              
81             Source repository is at L<https://github.com/perlancar/perl-Data-Sah-CoerceBundle-To_array-From_str-int_range_and_comma_sep>.
82              
83             =head1 BUGS
84              
85             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Data-Sah-CoerceBundle-To_array-From_str-int_range_and_comma_sep>
86              
87             When submitting a bug or request, please include a test-file or a
88             patch to an existing test-file that illustrates the bug or desired
89             feature.
90              
91             =head1 AUTHOR
92              
93             perlancar <perlancar@cpan.org>
94              
95             =head1 COPYRIGHT AND LICENSE
96              
97             This software is copyright (c) 2019, 2018 by perlancar@cpan.org.
98              
99             This is free software; you can redistribute it and/or modify it under
100             the same terms as the Perl 5 programming language system itself.
101              
102             =cut