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   513 use 5.010;
  1         6  
4 1     1   491 use locale;
  1         594  
  1         5  
5 1     1   40 use strict;
  1         2  
  1         21  
6 1     1   417 use syntax 'each_on_array'; # to support perl < 5.12
  1         24430  
  1         3  
7 1     1   3615 use warnings;
  1         2  
  1         28  
8             #use Log::Any '$log';
9              
10 1     1   451 use Data::Unixish::Util qw(%common_args);
  1         3  
  1         293  
11              
12             our $VERSION = '1.571'; # 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 25 my %args = @_;
50 2         5 my ($in, $out) = ($args{in}, $args{out});
51              
52 2         7 _chain_begin(\%args);
53 2         8 local ($., $_);
54 2         11 while (($., $_) = each @$in) {
55 4         20 push @$out, _chain_item($_, \%args);
56             }
57              
58 2         12 [200, "OK"];
59             }
60              
61             sub _chain_begin {
62 1     1   8 no strict 'refs';
  1         2  
  1         460  
63              
64 4     4   15 my $args = shift;
65 4         8 my $ff = [];
66 4         7 for my $f (@{ $args->{functions} }) {
  4         11  
67 2         3 my ($fn, $args);
68 2 50       7 if (ref($f) eq 'ARRAY') {
69 0         0 $fn = $f->[0];;
70 0         0 $args = $f->[1];
71             } else {
72 2         5 $fn = $f;
73 2         3 $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         5 my $mod = "Data::Unixish::$fn";
80 2 50       142 unless (eval "require $mod") {
81 0         0 die "Can't load dux function $fn: $@";
82             }
83 2         9 my $fnleaf = $fn; $fnleaf =~ s/.+:://;
  2         5  
84 2 50       4 if (defined &{"$mod\::_${fnleaf}_begin"}) {
  2         15  
85 0         0 my $begin = \&{"$mod\::_${fnleaf}_begin"};
  0         0  
86 0         0 $begin->($args);
87             }
88 2         4 push @$ff, [$mod, $fn, $fnleaf, \&{"$mod\::_${fnleaf}_item"}, $args];
  2         11  
89             }
90             # abuse to store state
91 4         12 $args->{-functions} = $ff;
92             }
93              
94             sub _chain_item {
95 8     8   15 my ($item, $args) = @_;
96 8         15 local $_ = $item;
97 8         10 for my $f (@{ $args->{-functions} }) {
  8         17  
98 4         12 $item = $f->[3]->($item, $f->[4]);
99             }
100 8         27 $item;
101             }
102              
103             sub _chain_end {
104 1     1   7 no strict 'refs';
  1         3  
  1         170  
105              
106 2     2   10 my $args = shift;
107 2         5 for my $f (@{ $args->{-functions} }) {
  2         6  
108 1         3 my $mod = $f->[0];
109 1         3 my $fnleaf = $f->[2];
110 1         1 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__