File Coverage

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


line stmt bran cond sub pod time code
1             package Evo::Lib::PP;
2 8     8   2820 use Evo '-Export *; Carp croak';
  8         15  
  8         38  
3              
4             sub eval_want : Export {
5 19     19 0 1768 my ($want, $fn) = (shift, pop);
6 19 100       55 if (!defined $want) {
    100          
7 5 100       10 eval { $fn->(@_); 1 } or return;
  5         18  
  2         12  
8 2     1   12 return sub { };
9             }
10             elsif (!$want) {
11 10         16 my $res;
12 10 100       18 eval { $res = $fn->(@_); 1 } or return;
  10         29  
  8         50  
13 8     12   36 return sub {$res};
  12         327  
14             }
15             else {
16 4         8 my @res;
17 4 100       9 eval { @res = $fn->(@_); 1 } or return;
  4         11  
  3         23  
18 3     3   17 return sub {@res};
  3         306  
19             }
20 8     8   50 }
  8         16  
  8         37  
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 8     8   1537 }
  8         15  
  8         29  
34              
35             sub uniq : Export {
36 2     2 0 417 my %seen;
37 2         5 return grep { !$seen{$_}++ } @_;
  8         31  
38 8     8   1033 }
  8         15  
  8         28  
39              
40 17 50   17 0 94 sub strict_opts ($hash, @other) : Export {
  17         26  
  17         41  
  17         29  
41 17 100 100     261 croak 'Usage strict_opts($hash, qw(key1 key2))'
      66        
42             . 'or strict_opts($hash, ["key1", "key2"], $level)'
43             if !@other || (ref $other[0]) && @other > 2;
44 15         27 my ($level, @keys);
45 15 100       36 if (ref $other[0]) {
46 14         32 @keys = (shift @other)->@*;
47 14 100       36 $level = @other ? shift(@other) : 1;
48             }
49             else {
50 1         2 @keys = @other;
51 1         2 $level = 1;
52             }
53              
54 15         42 my %opts = %$hash;
55 15         33 my @opts = map { delete $opts{$_} } @keys;
  30         109  
56 15 100       49 if (my @remaining = keys %opts) {
57 2         4 local $Carp::CarpLevel = $level;
58 2         250 croak "Unknown options: ", join ',', @remaining;
59             }
60 13         51 @opts;
61 8     8   2180 }
  8         18  
  8         29  
62              
63              
64             1;
65              
66             __END__