File Coverage

blib/lib/Error/Pure/HTTP/AllError.pm
Criterion Covered Total %
statement 33 37 89.1
branch 5 6 83.3
condition 1 3 33.3
subroutine 9 9 100.0
pod 1 1 100.0
total 49 56 87.5


line stmt bran cond sub pod time code
1             package Error::Pure::HTTP::AllError;
2              
3             # Pragmas.
4 4     4   25197 use base qw(Exporter);
  4         5  
  4         332  
5 4     4   18 use strict;
  4         5  
  4         99  
6 4     4   16 use warnings;
  4         14  
  4         168  
7              
8             # Modules.
9 4     4   1934 use Error::Pure::Utils qw(err_helper);
  4         16465  
  4         83  
10 4     4   2214 use Error::Pure::Output::Text qw(err_bt_pretty);
  4         3285  
  4         69  
11 4     4   2182 use List::MoreUtils qw(none);
  4         3699  
  4         243  
12 4     4   19 use Readonly;
  4         5  
  4         1259  
13              
14             # Constants.
15             Readonly::Array our @EXPORT_OK => qw(err);
16             Readonly::Scalar my $EVAL => 'eval {...}';
17              
18             # Version.
19             our $VERSION = 0.13;
20              
21             # Ignore die signal.
22             $SIG{__DIE__} = 'IGNORE';
23              
24             # Process error.
25             sub err {
26 5     5 1 1561 my @msg = @_;
27              
28             # Get errors structure.
29 5         15 my @errors = err_helper(@msg);
30              
31             # Finalize in main on last err.
32 5         672 my $stack_ar = $errors[-1]->{'stack'};
33 5 50 33     27 if ($stack_ar->[-1]->{'class'} eq 'main'
34 10 100   10   38 && none { $_ eq $EVAL || $_ =~ m/^eval '/ms }
35 10         28 map { $_->{'sub'} } @{$stack_ar}) {
  5         8  
36              
37 0         0 print "Content-type: text/plain\n\n";
38 0         0 print scalar err_bt_pretty(@errors);
39 0         0 return;
40              
41             # Die for eval.
42             } else {
43 5         8 my $e = $errors[-1]->{'msg'}->[0];
44 5 100       7 if (! defined $e) {
45 1         2 $e = 'undef';
46             } else {
47 4         6 chomp $e;
48             }
49 5         23 die "$e\n";
50             }
51              
52 0           return;
53             }
54              
55             1;
56              
57             __END__