File Coverage

blib/lib/Data/Unixish/Apply.pm
Criterion Covered Total %
statement 51 53 96.2
branch 12 20 60.0
condition 1 2 50.0
subroutine 8 8 100.0
pod 1 1 100.0
total 73 84 86.9


line stmt bran cond sub pod time code
1             package Data::Unixish::Apply;
2              
3             our $DATE = '2019-10-26'; # DATE
4             our $VERSION = '1.572'; # VERSION
5              
6 1     1   593 use 5.010;
  1         10  
7 1     1   5 use strict;
  1         2  
  1         19  
8 1     1   5 use warnings;
  1         2  
  1         26  
9             #use Log::Any '$log';
10              
11 1     1   493 use Data::Unixish::Util qw(%common_args filter_args);
  1         2  
  1         114  
12 1     1   508 use Module::Load;
  1         1176  
  1         6  
13 1     1   596 use Package::Util::Lite qw(package_exists);
  1         466  
  1         378  
14              
15             our %SPEC;
16              
17             $SPEC{apply} = {
18             v => 1.1,
19             summary => 'Apply one or more dux functions',
20             args => {
21             in => {
22             schema => ['any'], # XXX stream
23             req => 1,
24             },
25             functions => {
26             summary => 'Function(s) to apply',
27             schema => ['any*', of => [
28             'str*',
29             ['array*', of => ['any' => of => [['str*'], ['array*']]]],
30             ]],
31             req => 1,
32             description => <<'_',
33              
34             A list of functions to apply. Each element is either a string (function name),
35             or a 2-element array (function names + arguments hashref). If you do not want to
36             specify arguments to a function, you can use a string.
37              
38             Example:
39              
40             [
41             'sort', # no arguments (all default)
42             'date', # no arguments (all default)
43             ['head', {items=>5}], # specify arguments
44             ]
45              
46             _
47             },
48              
49             },
50             };
51             sub apply {
52 2     2 1 111 my %args = @_;
53 2 50       9 my $in0 = $args{in} or return [400, "Please specify in"];
54 2 50       7 my $ff0 = $args{functions} or return [400, "Please specify functions"];
55 2 50       10 $ff0 = [$ff0] unless ref($ff0) eq 'ARRAY';
56              
57             # special case
58 2 50       6 unless (@$ff0) {
59 0         0 return [200, "No processing done", $in0];
60             }
61              
62 2         4 my @ff;
63 2         4 my ($in, $out);
64 2         11 for my $i (0..@$ff0-1) {
65 3         6 my $f = $ff0->[$i];
66             #$log->tracef("Applying dux function %s ...", $f);
67 3         6 my ($fn0, $fargs);
68 3 100       11 if (ref($f) eq 'ARRAY') {
69 1         3 $fn0 = $f->[0];
70 1   50     6 $fargs = filter_args($f->[1]) // {};
71             } else {
72 2         4 $fn0 = $f;
73 2         4 $fargs = {};
74             }
75              
76 3 100       10 if ($i == 0) {
77 2         4 $in = $in0;
78             } else {
79 1         2 $in = $out;
80             }
81 3         49 $out = [];
82              
83             # XXX load all functions before applying, like in Unix pipes
84 3         11 my $pkg = "Data::Unixish::$fn0";
85 3 50       14 unless (package_exists($pkg)) {
86 3 50       65 eval { load $pkg; 1 } or
  3         16  
  3         51  
87             return [500,
88             "Can't load package for dux function $fn0: $@"];
89             }
90              
91 3         9 my $fnl = $fn0; $fnl =~ s/.+:://;
  3         10  
92 3         11 my $fn = "Data::Unixish::$fn0\::$fnl";
93 3 50       18 return [500, "Subroutine &$fn not defined"] unless defined &$fn;
94              
95 1     1   9 no strict 'refs';
  1         2  
  1         146  
96 3         18 my $res = $fn->(%$fargs, in=>$in, out=>$out);
97 3 50       20 unless ($res->[0] == 200) {
98 0         0 return [500, "Function $fn0 did not return success: ".
99             "$res->[0] - $res->[1]"];
100             }
101             }
102              
103 2         28 [200, "OK", $out];
104             }
105              
106             1;
107             # ABSTRACT: Apply one or more dux functions
108              
109             __END__