File Coverage

blib/lib/Error/Pure/HTTP/JSON/Advance.pm
Criterion Covered Total %
statement 33 40 82.5
branch 5 6 83.3
condition 1 3 33.3
subroutine 9 9 100.0
pod 1 1 100.0
total 49 59 83.0


line stmt bran cond sub pod time code
1             package Error::Pure::HTTP::JSON::Advance;
2              
3             # Pragmas.
4 4     4   25960 use base qw(Exporter);
  4         6  
  4         340  
5 4     4   17 use strict;
  4         4  
  4         89  
6 4     4   15 use warnings;
  4         8  
  4         106  
7              
8             # Modules.
9 4     4   1984 use Error::Pure::Output::JSON qw(err_json);
  4         49722  
  4         92  
10 4     4   2284 use Error::Pure::Utils qw(err_helper);
  4         5030  
  4         66  
11 4     4   2176 use List::MoreUtils qw(none);
  4         3548  
  4         256  
12 4     4   22 use Readonly;
  4         5  
  4         1212  
13              
14             # Constants.
15             Readonly::Array our @EXPORT_OK => qw(err);
16             Readonly::Scalar my $EVAL => 'eval {...}';
17              
18             # Version.
19             our $VERSION = 0.04;
20              
21             # Global variables.
22             our %ERR_PARAMETERS;
23              
24             # Ignore die signal.
25             $SIG{__DIE__} = 'IGNORE';
26              
27             # Process error.
28             sub err {
29 5     5 1 1072 my @msg = @_;
30              
31             # Get errors structure.
32 5         15 my @errors = err_helper(@msg);
33              
34             # Finalize in main on last err.
35 5         659 my $stack_ar = $errors[-1]->{'stack'};
36 5 50 33     25 if ($stack_ar->[-1]->{'class'} eq 'main'
37 10 100   10   38 && none { $_ eq $EVAL || $_ =~ /^eval '/ms }
38 10         27 map { $_->{'sub'} } @{$stack_ar}) {
  5         8  
39              
40             # Construct error structure.
41 0         0 my $err_hr = {
42             'error-pure' => \@errors,
43             };
44 0         0 foreach my $key (keys %ERR_PARAMETERS) {
45 0         0 $err_hr->{$key} = $ERR_PARAMETERS{$key};
46             }
47              
48             # Print out.
49 0         0 print "Content-type: application/json\n\n";
50 0         0 print err_json($err_hr);
51 0         0 return;
52              
53             # Die for eval.
54             } else {
55 5         6 my $e = $errors[-1]->{'msg'}->[0];
56 5 100       9 if (! defined $e) {
57 1         2 $e = 'undef';
58             } else {
59 4         6 chomp $e;
60             }
61 5         21 die "$e\n";
62             }
63              
64 0           return;
65             }
66              
67             1;
68              
69             __END__