File Coverage

blib/lib/Error/Pure/HTTP/JSON.pm
Criterion Covered Total %
statement 32 37 86.4
branch 4 6 66.6
condition 1 3 33.3
subroutine 9 9 100.0
pod 1 1 100.0
total 47 56 83.9


line stmt bran cond sub pod time code
1             package Error::Pure::HTTP::JSON;
2              
3 3     3   143461 use base qw(Exporter);
  3         7  
  3         537  
4 3     3   21 use strict;
  3         7  
  3         97  
5 3     3   14 use warnings;
  3         9  
  3         207  
6              
7 3     3   1876 use Error::Pure::Output::JSON qw(err_json);
  3         62041  
  3         74  
8 3     3   1913 use Error::Pure::Utils qw(err_helper);
  3         5417  
  3         68  
9 3     3   357 use List::Util 1.33 qw(none);
  3         72  
  3         357  
10 3     3   18 use Readonly;
  3         6  
  3         1163  
11              
12             # Constants.
13             Readonly::Array our @EXPORT_OK => qw(err);
14             Readonly::Scalar my $EVAL => 'eval {...}';
15              
16             our $VERSION = 0.06;
17              
18             # Ignore die signal.
19             $SIG{__DIE__} = 'IGNORE';
20              
21             # Process error.
22             sub err {
23 5     5 1 284656 my @msg = @_;
24              
25             # Get errors structure.
26 5         14 my @errors = err_helper(@msg);
27              
28             # Finalize in main on last err.
29 5         679 my $stack_ar = $errors[-1]->{'stack'};
30 5 50 33     26 if ($stack_ar->[-1]->{'class'} eq 'main'
31 10 100   10   31 && none { $_ eq $EVAL || $_ =~ /^eval '/ms }
32 10         25 map { $_->{'sub'} } @{$stack_ar}) {
  5         10  
33              
34 0         0 print "Content-type: application/json\n\n";
35 0         0 print err_json(\@errors);
36 0         0 return;
37              
38             # Die for eval.
39             } else {
40 5         8 my $e = $errors[-1]->{'msg'}->[0];
41 5 50       9 if (! defined $e) {
42 0         0 $e = 'undef';
43             } else {
44 5         6 chomp $e;
45             }
46 5         35 die "$e\n";
47             }
48              
49 0           return;
50             }
51              
52             1;
53              
54             __END__