File Coverage

blib/lib/Data/Unixish/cond.pm
Criterion Covered Total %
statement 36 38 94.7
branch 5 8 62.5
condition 2 4 50.0
subroutine 9 9 100.0
pod 1 1 100.0
total 53 60 88.3


line stmt bran cond sub pod time code
1             package Data::Unixish::cond;
2              
3 1     1   390 use 5.010;
  1         5  
4 1     1   342 use locale;
  1         482  
  1         5  
5 1     1   30 use strict;
  1         1  
  1         17  
6 1     1   328 use syntax 'each_on_array'; # to support perl < 5.12
  1         18938  
  1         3  
7 1     1   2725 use warnings;
  1         2  
  1         27  
8             #use Log::Any '$log';
9              
10             require Data::Unixish; # for siduxs
11 1     1   345 use Data::Unixish::Util qw(%common_args);
  1         3  
  1         420  
12              
13             our $VERSION = '1.570'; # VERSION
14              
15             our %SPEC;
16              
17             $SPEC{cond} = {
18             v => 1.1,
19             summary => 'Apply dux function conditionally',
20             description => <<'_',
21              
22             This dux function takes a condition (a Perl code/expression) and one or two
23             other dux functions (A and B). Condition will be evaluated for each item (where
24             `$_` will be set to the current item). If condition evaluates to true, then A is
25             applied to the item, else B. All the dux functions must be itemfunc.
26              
27             _
28             args => {
29             %common_args,
30             if => {
31             summary => 'Perl code that specifies the condition',
32             schema => ['any*' => of => ['str*', 'code*']],
33             req => 1,
34             pos => 0,
35             },
36             then => {
37             summary => 'dux function to be applied if condition is true',
38             schema => ['any*' => of => ['str*', 'array*']], # XXX dux
39             req => 1,
40             pos => 1,
41             },
42             else => {
43             summary => 'dux function to be applied if condition is false',
44             schema => ['any*' => of => ['str*', 'array*']], # XXX dux
45             pos => 2,
46             },
47             },
48             tags => [qw/perl unsafe itemfunc/],
49             "x.app.dux.is_stream_output" => 1,
50             };
51             sub cond {
52 2     2 1 7 my %args = @_;
53 2         4 my ($in, $out) = ($args{in}, $args{out});
54              
55 2         5 _cond_begin(\%args);
56 1         3 local $.;
57 1         6 my $item;
58 1         14 while (($., $item) = each @$in) {
59 4         9 push @$out, _cond_item->($item, \%args);
60             }
61              
62 1         4 [200, "OK"];
63             }
64              
65             sub _cond_begin {
66 2     2   9 my $args = shift;
67              
68 2 100       6 if (ref($args->{if}) ne 'CODE') {
69 1 50       3 if ($args->{-cmdline}) {
70 0         0 $args->{if} = eval "no strict; no warnings; sub { $args->{if} }";
71 0 0       0 die "invalid Perl code for if: $@" if $@;
72             } else {
73 1         7 die "Please supply coderef for 'if'";
74             }
75             }
76 1   50     3 $args->{then} //= 'cat';
77 1   50     2 $args->{else} //= 'cat';
78             }
79              
80             sub _cond_item {
81 4     4   8 my ($item, $args) = @_;
82              
83 4         5 local $_ = $item;
84              
85             # XXX to be more efficient, skip siduxs and do it ourselves
86 4 100       11 if ($args->{if}->()) {
87 2         8 return Data::Unixish::siduxs($args->{then}, $item);
88             } else {
89 2         12 return Data::Unixish::siduxs($args->{else}, $item);
90             }
91             }
92              
93             1;
94             # ABSTRACT: Apply dux function conditionally
95              
96             __END__