File Coverage

blib/lib/Data/Unixish/chain.pm
Criterion Covered Total %
statement 62 72 86.1
branch 5 10 50.0
condition n/a
subroutine 12 12 100.0
pod 1 1 100.0
total 80 95 84.2


line stmt bran cond sub pod time code
1             package Data::Unixish::chain;
2              
3 1     1   428 use 5.010;
  1         6  
4 1     1   386 use locale;
  1         497  
  1         4  
5 1     1   33 use strict;
  1         1  
  1         18  
6 1     1   332 use syntax 'each_on_array'; # to support perl < 5.12
  1         19802  
  1         4  
7 1     1   3733 use warnings;
  1         2  
  1         27  
8             #use Log::Any '$log';
9              
10 1     1   394 use Data::Unixish::Util qw(%common_args);
  1         2  
  1         281  
11              
12             our $VERSION = '1.570'; # VERSION
13              
14             our %SPEC;
15              
16             $SPEC{chain} = {
17             v => 1.1,
18             summary => 'Chain several dux functions together',
19             description => <<'_',
20              
21             Currently works for itemfunc only.
22              
23             See also the function, which is related.
24              
25             _
26             args => {
27             %common_args,
28             functions => {
29             summary => 'The functions to chain',
30             schema => ['array*' => of => ['any*', of => [
31             'str*',
32             ['array*', min_len=>1, elems=>['str*','hash*']],
33             ]]],
34             description => <<'_',
35              
36             Each element must either be function name (like `date`) or a 2-element array
37             containing the function name and its arguments (like `[bool, {style: dot}]`).
38              
39             _
40             req => 1,
41             pos => 0,
42             greedy => 1,
43             cmdline_aliases => {f => {}},
44             },
45             },
46             tags => [qw/itemfunc func/],
47             };
48             sub chain {
49 2     2 1 18 my %args = @_;
50 2         7 my ($in, $out) = ($args{in}, $args{out});
51              
52 2         8 _chain_begin(\%args);
53 2         9 local ($., $_);
54 2         12 while (($., $_) = each @$in) {
55 4         13 push @$out, _chain_item($_, \%args);
56             }
57              
58 2         12 [200, "OK"];
59             }
60              
61             sub _chain_begin {
62 1     1   7 no strict 'refs';
  1         2  
  1         464  
63              
64 4     4   9 my $args = shift;
65 4         6 my $ff = [];
66 4         11 for my $f (@{ $args->{functions} }) {
  4         10  
67 2         4 my ($fn, $args);
68 2 50       8 if (ref($f) eq 'ARRAY') {
69 0         0 $fn = $f->[0];;
70 0         0 $args = $f->[1];
71             } else {
72 2         3 $fn = $f;
73 2         5 $args = {};
74             }
75 2 50       14 unless ($fn =~
76             /\A[A-Za-z_][A-Za-z0-9_]*(::[A-Za-z_][A-Za-z0-9_]*)*\z/) {
77 0         0 die "Invalid function name $fn, please use letter+alphanums only";
78             }
79 2         6 my $mod = "Data::Unixish::$fn";
80 2 50       132 unless (eval "require $mod") {
81 0         0 die "Can't load dux function $fn: $@";
82             }
83 2         8 my $fnleaf = $fn; $fnleaf =~ s/.+:://;
  2         5  
84 2 50       3 if (defined &{"$mod\::_${fnleaf}_begin"}) {
  2         31  
85 0         0 my $begin = \&{"$mod\::_${fnleaf}_begin"};
  0         0  
86 0         0 $begin->($args);
87             }
88 2         5 push @$ff, [$mod, $fn, $fnleaf, \&{"$mod\::_${fnleaf}_item"}, $args];
  2         10  
89             }
90             # abuse to store state
91 4         14 $args->{-functions} = $ff;
92             }
93              
94             sub _chain_item {
95 8     8   20 my ($item, $args) = @_;
96 8         14 local $_ = $item;
97 8         10 for my $f (@{ $args->{-functions} }) {
  8         14  
98 4         11 $item = $f->[3]->($item, $f->[4]);
99             }
100 8         25 $item;
101             }
102              
103             sub _chain_end {
104 1     1   7 no strict 'refs';
  1         2  
  1         143  
105              
106 2     2   4 my $args = shift;
107 2         4 for my $f (@{ $args->{-functions} }) {
  2         12  
108 1         3 my $mod = $f->[0];
109 1         2 my $fnleaf = $f->[2];
110 1         3 my $args = $f->[4];
111 1 50       2 if (defined &{"$mod\::_${fnleaf}_end"}) {
  1         8  
112 0           my $end = \&{"$mod\::_${fnleaf}_end"};
  0            
113 0           $end->($args);
114             }
115             }
116             }
117              
118             1;
119             # ABSTRACT: Chain several dux functions together
120              
121             __END__