File Coverage

blib/lib/Data/Unixish/split.pm
Criterion Covered Total %
statement 30 33 90.9
branch 3 10 30.0
condition 2 4 50.0
subroutine 8 8 100.0
pod 1 1 100.0
total 44 56 78.5


line stmt bran cond sub pod time code
1             package Data::Unixish::split;
2              
3             our $DATE = '2019-10-26'; # DATE
4             our $DIST = 'Data-Unixish'; # DIST
5             our $VERSION = '1.571'; # VERSION
6              
7 1     1   566 use 5.010001;
  1         6  
8 1     1   5 use strict;
  1         2  
  1         23  
9 1     1   419 use syntax 'each_on_array'; # to support perl < 5.12
  1         23738  
  1         5  
10 1     1   3535 use warnings;
  1         2  
  1         29  
11             #use Log::Any '$log';
12              
13 1     1   454 use Data::Unixish::Util qw(%common_args);
  1         3  
  1         435  
14              
15             our %SPEC;
16              
17             sub _pattern_to_re {
18 3     3   5 my $args = shift;
19              
20 3         14 my $re;
21 3 50       6 my $pattern = $args->{pattern}; defined $pattern or die "Please specify pattern";
  3         9  
22 3 50       7 if ($args->{fixed_string}) {
23 3 50       23 $re = $args->{ignore_case} ? qr/\Q$pattern/i : qr/\Q$pattern/;
24             } else {
25 0 0       0 eval { $re = $args->{ignore_case} ? qr/$pattern/i : qr/$pattern/ };
  0         0  
26 0 0       0 die "Invalid pattern: $@" if $@;
27             }
28              
29 3         7 $re;
30             }
31              
32             $SPEC{split} = {
33             v => 1.1,
34             summary => 'Split string into array',
35             description => <<'_',
36              
37             _
38             args => {
39             %common_args,
40             pattern => {
41             summary => 'Pattern or string',
42             schema => 'str*',
43             req => 1,
44             pos => 0,
45             },
46             fixed_string => {
47             summary => 'Interpret pattern as fixed string instead of regular expression',
48             schema => 'true*',
49             cmdline_aliases => {F=>{}},
50             },
51             ignore_case => {
52             summary => 'Whether to ignore case',
53             schema => 'bool*',
54             cmdline_aliases => {i=>{}},
55             },
56             limit => {
57             schema => 'uint*',
58             default => 0,
59             pos => 1,
60             },
61             },
62             tags => [qw/text itemfunc/],
63             };
64             sub split {
65 1     1 1 5 my %args = @_;
66 1         2 my ($in, $out) = ($args{in}, $args{out});
67              
68             # we don't call _split_item() to optimize
69 1         3 my $re = _pattern_to_re(\%args);
70 1         15 while (my ($index, $item) = each @$in) {
71 2   50     20 push @$out, [CORE::split($re, $item, $args{limit}//0)];
72             }
73              
74 1         5 [200, "OK"];
75             }
76              
77             sub _split_item {
78 2     2   4 my ($item, $args) = @_;
79              
80 2         5 my $re = _pattern_to_re($args);
81 2   50     18 [CORE::split($re, $item, $args->{limit}//0)];
82             }
83              
84             1;
85             # ABSTRACT: Split string into array
86              
87             __END__