File Coverage

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