File Coverage

blib/lib/Data/Unixish/map.pm
Criterion Covered Total %
statement 31 33 93.9
branch 3 6 50.0
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 44 49 89.8


line stmt bran cond sub pod time code
1             package Data::Unixish::map;
2              
3 1     1   487 use 5.010;
  1         6  
4 1     1   451 use locale;
  1         592  
  1         6  
5 1     1   38 use strict;
  1         1  
  1         23  
6 1     1   377 use syntax 'each_on_array'; # to support perl < 5.12
  1         23210  
  1         5  
7 1     1   3411 use warnings;
  1         3  
  1         29  
8             #use Log::Any '$log';
9              
10 1     1   450 use Data::Unixish::Util qw(%common_args);
  1         3  
  1         415  
11              
12             our $VERSION = '1.570'; # VERSION
13              
14             our %SPEC;
15              
16             $SPEC{map} = {
17             v => 1.1,
18             summary => 'Perl map',
19             description => <<'_',
20              
21             Process each item through a callback.
22              
23             _
24             args => {
25             %common_args,
26             callback => {
27             summary => 'The callback coderef to use',
28             schema => ['any*' => of => ['code*', 'str*']],
29             req => 1,
30             pos => 0,
31             },
32             },
33             tags => [qw/perl unsafe itemfunc/],
34             };
35             sub map {
36 4     4 1 12 my %args = @_;
37 4         9 my ($in, $out) = ($args{in}, $args{out});
38              
39 4         20 _map_begin(\%args);
40 3         11 local ($., $_);
41 3         20 while (($., $_) = each @$in) {
42 12         62 push @$out, $args{callback}->();
43             }
44              
45 3         24 [200, "OK"];
46             }
47              
48             sub _map_begin {
49 6     6   11 my $args = shift;
50              
51 6 100       26 if (ref($args->{callback}) ne 'CODE') {
52 1 50       4 if ($args->{-cmdline}) {
53 0         0 $args->{callback} = eval "no strict; no warnings; sub { $args->{callback} }";
54 0 0       0 die "invalid Perl code for map: $@" if $@;
55             } else {
56 1         8 die "Please supply coderef for 'callback'";
57             }
58             }
59             }
60              
61             sub _map_item {
62 8     8   13 my ($item, $args) = @_;
63 8         12 local $_ = $item;
64 8         15 $args->{callback}->();
65             }
66              
67             1;
68             # ABSTRACT: Perl map
69              
70             __END__