File Coverage

blib/lib/Error/Pure/Die.pm
Criterion Covered Total %
statement 26 30 86.6
branch 3 4 75.0
condition 1 3 33.3
subroutine 8 8 100.0
pod 1 1 100.0
total 39 46 84.7


line stmt bran cond sub pod time code
1             package Error::Pure::Die;
2              
3 5     5   79398 use base qw(Exporter);
  5         41  
  5         649  
4 5     5   35 use strict;
  5         9  
  5         119  
5 5     5   27 use warnings;
  5         6  
  5         175  
6              
7 5     5   1722 use Error::Pure::Utils qw(err_helper);
  5         23  
  5         113  
8 5     5   491 use List::Util qw(none);
  5         11  
  5         630  
9 5     5   36 use Readonly;
  5         8  
  5         3359  
10              
11             our $VERSION = 0.30;
12              
13             Readonly::Array our @EXPORT_OK => qw(err);
14             Readonly::Scalar my $EVAL => 'eval {...}';
15             Readonly::Scalar my $EMPTY_STR => q{};
16              
17             # Process error.
18             sub err {
19 14     14 1 2772 my @msg = @_;
20              
21             # Get errors structure.
22 14         47 my @errors = err_helper(@msg);
23              
24             # Finalize in main on last err.
25 14         31 my $stack_ar = $errors[-1]->{'stack'};
26 14 50 33     76 if ($stack_ar->[-1]->{'class'} eq 'main'
27 28 100   28   125 && none { $_ eq $EVAL || $_ =~ /^eval '/ms }
28 28         95 map { $_->{'sub'} } @{$stack_ar}) {
  14         43  
29              
30 0         0 my $die = (join $EMPTY_STR, @{$errors[-1]->{'msg'}}).
  0         0  
31             " at $stack_ar->[0]->{'prog'} line ".
32             "$stack_ar->[0]->{'line'}.";
33 0         0 die "$die\n";
34              
35             # Die for eval.
36             } else {
37 14         133 die "$errors[-1]->{'msg'}->[0]\n";
38             }
39              
40 0           return;
41             }
42              
43             1;
44              
45             __END__