File Coverage

blib/lib/Error/Pure/HTTP/AllError.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::AllError;
2              
3 3     3   150665 use base qw(Exporter);
  3         7  
  3         447  
4 3     3   19 use strict;
  3         42  
  3         87  
5 3     3   17 use warnings;
  3         7  
  3         184  
6              
7 3     3   1691 use Error::Pure::Utils qw(err_helper);
  3         23429  
  3         80  
8 3     3   2125 use Error::Pure::Output::Text qw(err_bt_pretty);
  3         5438  
  3         68  
9 3     3   3202 use List::MoreUtils qw(none);
  3         78762  
  3         29  
10 3     3   5067 use Readonly;
  3         8  
  3         1498  
11              
12             # Constants.
13             Readonly::Array our @EXPORT_OK => qw(err);
14             Readonly::Scalar my $EVAL => 'eval {...}';
15              
16             # Version.
17             our $VERSION = 0.16;
18              
19             # Ignore die signal.
20             $SIG{__DIE__} = 'IGNORE';
21              
22             # Process error.
23             sub err {
24 5     5 1 419074 my @msg = @_;
25              
26             # Get errors structure.
27 5         24 my @errors = err_helper(@msg);
28              
29             # Finalize in main on last err.
30 5         1220 my $stack_ar = $errors[-1]->{'stack'};
31 5 50 33     43 if ($stack_ar->[-1]->{'class'} eq 'main'
32 10 100   10   59 && none { $_ eq $EVAL || $_ =~ m/^eval '/ms }
33 10         54 map { $_->{'sub'} } @{$stack_ar}) {
  5         17  
34              
35 0         0 print "Content-type: text/plain\n\n";
36 0         0 print scalar err_bt_pretty(@errors);
37 0         0 return;
38              
39             # Die for eval.
40             } else {
41 5         11 my $e = $errors[-1]->{'msg'}->[0];
42 5 50       12 if (! defined $e) {
43 0         0 $e = 'undef';
44             } else {
45 5         12 chomp $e;
46             }
47 5         51 die "$e\n";
48             }
49              
50 0           return;
51             }
52              
53             1;
54              
55             __END__