File Coverage

blib/lib/Data/Unixish/grep.pm
Criterion Covered Total %
statement 30 32 93.7
branch 8 12 66.6
condition n/a
subroutine 8 8 100.0
pod 1 1 100.0
total 47 53 88.6


line stmt bran cond sub pod time code
1             package Data::Unixish::grep;
2              
3 1     1   452 use 5.010;
  1         6  
4 1     1   362 use locale;
  1         498  
  1         4  
5 1     1   31 use strict;
  1         1  
  1         18  
6 1     1   337 use syntax 'each_on_array'; # to support perl < 5.12
  1         19470  
  1         4  
7 1     1   2839 use warnings;
  1         1  
  1         22  
8             #use Log::Any '$log';
9              
10 1     1   426 use Data::Unixish::Util qw(%common_args);
  1         2  
  1         359  
11              
12             our $VERSION = '1.572'; # VERSION
13              
14             our %SPEC;
15              
16             $SPEC{grep} = {
17             v => 1.1,
18             summary => 'Perl grep',
19             description => <<'_',
20              
21             Filter each item through a callback.
22              
23             _
24             args => {
25             %common_args,
26             callback => {
27             summary => 'The callback code or regexp to use',
28             schema => ['any*' => of => ['str*', 're*', 'code*']],
29             req => 1,
30             pos => 0,
31             },
32             },
33             tags => [qw/filtering perl unsafe/],
34             };
35             sub grep {
36 4     4 1 9 my %args = @_;
37 4         9 my ($in, $out) = ($args{in}, $args{out});
38 4 50       10 my $callback = $args{callback} or die "missing callback for grep";
39 4 100       24 if (ref($callback) eq ref(qr{})) {
    100          
40 1         2 my $re = $callback;
41 1     4   4 $callback = sub { $_ =~ $re };
  4         22  
42             } elsif (ref($callback) ne 'CODE') {
43 1 50       4 if ($args{-cmdline}) {
44 0         0 $callback = eval "no strict; no warnings; sub { $callback }";
45 0 0       0 die "invalid code for grep: $@" if $@;
46             } else {
47 1         7 die "Please supply coderef (or regex) for 'callback'";
48             }
49             }
50              
51 3         13 local ($., $_);
52 3         20 while (($., $_) = each @$in) {
53 24 100       79 push @$out, $_ if $callback->();
54             }
55              
56 3         18 [200, "OK"];
57             }
58              
59             1;
60             # ABSTRACT: Perl grep
61              
62             __END__