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   526 use 5.010;
  1         7  
4 1     1   450 use locale;
  1         664  
  1         5  
5 1     1   38 use strict;
  1         3  
  1         22  
6 1     1   416 use syntax 'each_on_array'; # to support perl < 5.12
  1         24288  
  1         5  
7 1     1   3586 use warnings;
  1         3  
  1         30  
8             #use Log::Any '$log';
9              
10 1     1   454 use Data::Unixish::Util qw(%common_args);
  1         3  
  1         419  
11              
12             our $VERSION = '1.571'; # 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 14 my %args = @_;
37 4         9 my ($in, $out) = ($args{in}, $args{out});
38              
39 4         11 _map_begin(\%args);
40 3         10 local ($., $_);
41 3         13 while (($., $_) = each @$in) {
42 12         60 push @$out, $args{callback}->();
43             }
44              
45 3         24 [200, "OK"];
46             }
47              
48             sub _map_begin {
49 6     6   8 my $args = shift;
50              
51 6 100       24 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   14 my ($item, $args) = @_;
63 8         13 local $_ = $item;
64 8         12 $args->{callback}->();
65             }
66              
67             1;
68             # ABSTRACT: Perl map
69              
70             __END__