File Coverage

blib/lib/Error/Pure/JSON.pm
Criterion Covered Total %
statement 32 35 91.4
branch 4 6 66.6
condition 1 3 33.3
subroutine 9 9 100.0
pod 1 1 100.0
total 47 54 87.0


line stmt bran cond sub pod time code
1             package Error::Pure::JSON;
2              
3             # Pragmas.
4 4     4   37922 use base qw(Exporter);
  4         6  
  4         457  
5 4     4   98 use strict;
  4         9  
  4         142  
6 4     4   17 use warnings;
  4         8  
  4         141  
7              
8             # Modules.
9 4     4   3116 use Error::Pure::Output::JSON qw(err_json);
  4         82870  
  4         131  
10 4     4   3685 use Error::Pure::Utils qw(err_helper);
  4         7403  
  4         117  
11 4     4   4389 use List::MoreUtils qw(none);
  4         47637  
  4         42  
12 4     4   2590 use Readonly;
  4         9  
  4         1652  
13              
14             # Constants.
15             Readonly::Array our @EXPORT_OK => qw(err);
16             Readonly::Scalar my $EVAL => 'eval {...}';
17              
18             # Version.
19             our $VERSION = 0.06;
20              
21             # Ignore die signal.
22             $SIG{__DIE__} = 'IGNORE';
23              
24             # Process error.
25             sub err {
26 5     5 1 1099 my @msg = @_;
27              
28             # Get errors structure.
29 5         14 my @errors = err_helper(@msg);
30              
31             # Finalize in main on last err.
32 5         644 my $stack_ar = $errors[-1]->{'stack'};
33 5 50 33     27 if ($stack_ar->[-1]->{'class'} eq 'main'
34 10 100   10   36 && none { $_ eq $EVAL || $_ =~ /^eval '/ms }
35 10         30 map { $_->{'sub'} } @{$stack_ar}) {
  5         8  
36              
37 0         0 die err_json(\@errors)."\n";
38              
39             # Die for eval.
40             } else {
41 5         10 my $e = $errors[-1]->{'msg'}->[0];
42 5 50       8 if (! defined $e) {
43 0         0 $e = 'undef';
44             } else {
45 5         5 chomp $e;
46             }
47 5         23 die "$e\n";
48             }
49              
50 0           return;
51             }
52              
53             1;
54              
55             __END__