File Coverage

lib/Unexpected/TraitFor/ErrorLeader.pm
Criterion Covered Total %
statement 31 31 100.0
branch 4 4 100.0
condition 5 6 100.0
subroutine 7 7 100.0
pod 2 2 100.0
total 49 50 100.0


line stmt bran cond sub pod time code
1             package Unexpected::TraitFor::ErrorLeader;
2              
3 2     2   1634 use namespace::autoclean;
  2         7  
  2         23  
4              
5 2     2   214 use List::Util qw( first );
  2         7  
  2         187  
6 2     2   18 use Unexpected::Types qw( NonZeroPositiveInt SimpleStr );
  2         7  
  2         21  
7 2     2   4814 use Moo::Role;
  2         8  
  2         3484  
8              
9             requires qw( as_string clone frames );
10              
11             my $Ignore = [ 'Try::Tiny' ];
12              
13             # Private functions
14             my $_is_member = sub {
15             my $wanted = shift; return (first { $_ eq $wanted } @{ $_[ 0 ] }) ? 1 : 0;
16             };
17              
18             my $_build_leader = sub {
19 25     25   404 my $self = shift; my $level = $self->level; my $leader = q();
  25         126  
  25         69  
20              
21 25         743 my @frames = $self->frames; my ($line, $package);
  25         6280  
22              
23 25 100       129 $level >= scalar @frames and $level = scalar @frames - 1;
24              
25 25   100     66 do {
26             # uncoverable condition right
27 45 100 66     292 if ($frames[ $level ] and $package = $frames[ $level ]->package) {
28 38         442 $line = $frames[ $level ]->line;
29 38         268 $leader = $package; $leader =~ s{ :: }{-}gmx;
  38         163  
30 38         177 $leader .= "[${line}/${level}]: "; $level++;
  38         312  
31             }
32 7         124 else { $leader = $package = q() }
33             }
34             while ($package and $_is_member->( $package, $self->ignore ));
35              
36 25         850 return $leader;
37             };
38              
39             # Object attributes (public)
40             has 'leader' => is => 'lazy', isa => SimpleStr, builder => $_build_leader;
41              
42             has 'level' => is => 'ro', isa => NonZeroPositiveInt, default => 1;
43              
44             # Construction
45             around 'as_string' => sub {
46             my ($orig, $self, @args) = @_; my $str = $orig->( $self, @args );
47              
48             return $str ? $self->leader.$str : $str;
49             };
50              
51             before 'clone' => sub {
52             my $self = shift; $self->leader; return;
53             };
54              
55             # Public methods
56             sub ignore {
57 40     40 1 317 return $Ignore;
58             }
59              
60             sub ignore_class {
61 2     2 1 556 shift; return push @{ $Ignore }, @_;
  2         6  
  2         19  
62             }
63              
64             1;
65              
66             __END__