File Coverage

blib/lib/Data/Unixish/count.pm
Criterion Covered Total %
statement 40 43 93.0
branch 3 10 30.0
condition n/a
subroutine 10 10 100.0
pod 1 1 100.0
total 54 64 84.3


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