File Coverage

blib/lib/Evo/Lib/PP.pm
Criterion Covered Total %
statement 54 63 85.7
branch 19 28 67.8
condition 6 9 66.6
subroutine 11 12 91.6
pod 0 4 0.0
total 90 116 77.5


line stmt bran cond sub pod time code
1             package Evo::Lib::PP;
2 19     19   9014 use Evo '-Export *; Carp croak';
  19         47  
  19         109  
3              
4             sub eval_want : Export {
5 19     19 0 2210 my ($want, $fn) = (shift, pop);
6 19 100       64 if (!defined $want) {
    100          
7 5 100       12 eval { $fn->(@_); 1 } or return;
  5         19  
  2         12  
8 2     1   10 return sub { };
9             }
10             elsif (!$want) {
11 10         18 my $res;
12 10 100       21 eval { $res = $fn->(@_); 1 } or return;
  10         31  
  8         62  
13 8     12   47 return sub {$res};
  12         354  
14             }
15             else {
16 4         9 my @res;
17 4 100       7 eval { @res = $fn->(@_); 1 } or return;
  4         11  
  3         23  
18 3     3   16 return sub {@res};
  3         293  
19             }
20 19     19   160 }
  19         46  
  19         139  
21              
22             sub try : prototype(&$;$) : Export {
23 0     0 0 0 my ($try, $catch, $fin) = @_;
24 0         0 my $call = eval_want wantarray, $try;
25 0 0 0     0 $call = eval_want wantarray, my $e = $@, $catch if !$call && $catch;
26 0 0       0 if ($call) { # in normal way we are here, so separate this branch to avoid copying $@ before fin
27 0 0       0 $fin->() if $fin;
28 0         0 return $call->();
29             }
30 0         0 $e = $@;
31 0 0       0 $fin->() if $fin;
32 0         0 die $e;
33 19     19   4873 }
  19         51  
  19         79  
34              
35             sub uniq : Export {
36 2     2 0 509 my %seen;
37 2         5 return grep { !$seen{$_}++ } @_;
  8         29  
38 19     19   2944 }
  19         49  
  19         90  
39              
40 17 50   17 0 241 sub strict_opts ($hash, @other) : Export {
  17         34  
  17         53  
  17         29  
41 17 100 100     281 croak 'Usage strict_opts($hash, qw(key1 key2))'
      100        
42             . 'or strict_opts($hash, ["key1", "key2"], $level)'
43             if !@other || (ref $other[0]) && @other > 2;
44 15         33 my ($level, @keys);
45 15 100       41 if (ref $other[0]) {
46 14         55 @keys = (shift @other)->@*;
47 14 100       46 $level = @other ? shift(@other) : 1;
48             }
49             else {
50 1         3 @keys = @other;
51 1         2 $level = 1;
52             }
53              
54 15         48 my %opts = %$hash;
55 15         39 my @opts = map { delete $opts{$_} } @keys;
  30         82  
56 15 100       53 if (my @remaining = keys %opts) {
57 2         3 local $Carp::CarpLevel = $level;
58 2         221 croak "Unknown options: ", join ',', @remaining;
59             }
60 13         55 @opts;
61 19     19   6199 }
  19         53  
  19         82  
62              
63              
64             1;
65              
66             __END__