File Coverage

blib/lib/Role/Commons/Tap.pm
Criterion Covered Total %
statement 31 39 79.4
branch 4 14 28.5
condition 1 3 33.3
subroutine 8 8 100.0
pod 1 1 100.0
total 45 65 69.2


line stmt bran cond sub pod time code
1 1     1   383 use 5.008;
  1         2  
  1         35  
2 1     1   6 use strict;
  1         2  
  1         40  
3 1     1   6 use warnings;
  1         2  
  1         48  
4              
5             package Role::Commons::Tap;
6              
7 1     1   5 use Carp qw[croak];
  1         1  
  1         54  
8              
9             BEGIN {
10 1     1   11 use Moo::Role;
  1         1  
  1         6  
11 1     1   245 $Role::Commons::Tap::AUTHORITY = 'cpan:TOBYINK';
12 1         233 $Role::Commons::Tap::VERSION = '0.104';
13             }
14              
15             our $setup_for_class = sub {
16             my ($role, $package, %args) = @_;
17             return 0;
18             };
19              
20             sub tap
21             {
22 1     1 1 3 my $self = shift;
23 1         1 my %flags;
24            
25 1         3 PARAM: while (@_)
26             {
27 1         2 my $next = shift;
28            
29 1 50 33     7 if (ref($next) eq 'CODE' or not ref $next)
30             {
31 1 50       5 my $args = ref($_[0]) eq 'ARRAY' ? shift : [];
32 1 50   1   8 my $code = ref $next ? $next : sub { $self->$next(@_) };
  1         5  
33            
34 1 50       3 if ($flags{ EVAL })
35             {
36 0         0 local $_ = $self;
37 0         0 eval { $code->(@$args) }
  0         0  
38             }
39             else
40             {
41 1         2 local $_ = $self;
42 1         2 do { $code->(@$args) }
  1         2  
43             }
44 1         7 next PARAM;
45             }
46            
47 0 0       0 if (ref($next) eq 'SCALAR')
48             {
49 0 0       0 if ($$next =~ m{^(no_?)?(.+)$}i)
50             {
51 0 0       0 $flags{ uc $2 } = $1 ? 0 : 1;
52 0         0 next PARAM;
53             }
54             }
55            
56 0         0 croak qq/Unsupported parameter to tap: $next/;
57             }
58            
59 1         4 return $self;
60             }
61              
62             1;
63              
64             __END__